Lighter-weight GError handling.

Keep a gerror-pointer in a gio stream's cancel-info to avoid MANY
mallocs/frees and gc-cleanup de-/registrations.  Share gerror->message
code with gobject.scm's pixbuf loaders.

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index 74aeffc02d7f19bfde8833e233250958386aa4bf..2bb59658d8e1c246114cb85bb2bb8616d81720a3 100644 (file)
--- a/src/gtk/gio.scm
+++ b/src/gtk/gio.scm
@@ -99,9 +99,9 @@ USA.
 ;;; When these streams are GCed, any pending operation must be
 ;;; cancelled.  This ensures that the operation's finish callback will
 ;;; not be called and can be safely de-registered.  The cancel-info
-;;; includes the GCancellable, the finish callback ids, AND a flag to
-;;; indicate whether an operation is pending and thus whether the
-;;; GCancellable should be used.
+;;; includes the GError *ptr, GCancellable, the finish callback ids,
+;;; AND a flag to indicate whether an operation is pending and thus
+;;; whether the GCancellable should be used.
 
 ;;; The subclasses' cancel-info is separated from the <g-stream> so
 ;;; that the latter can be GCed while the -info stays with a
@@ -110,15 +110,19 @@ USA.
 (define-class (<g-input-stream> (constructor ()))
     (<g-stream>)
   (cancel-info
-   define accessor
-   initializer (lambda ()
-                (make-g-input-stream-cancel-info
-                 #f #f (make-gcancellable) #f #f))))
+   define accessor initializer
+   (lambda ()
+     (make-g-input-stream-cancel-info
+      #f #f (make-gcancellable) (make-gerror*) #f #f))))
+
+(define-integrable (make-gerror*)
+  (make-alien '(* |GError|)))
 
 (define-structure g-input-stream-cancel-info
   pending-op             ; #f, OPEN, READ, SKIP, CLOSE or ERROR.
   callback-id            ; #f or the open/close finish callback ID
   gcancellable           ; a GCancellable alien
+  gerror-pointer         ; null or malloced GError* that MAY ref. a GError
 
   ;; To avoid registering read or skip finish callbacks for every read
   ;; or skip (a LOT of registering/deregistering!), the open operation
@@ -129,9 +133,11 @@ USA.
 
 (define-method initialize-instance ((object <g-input-stream>))
   (call-next-method object)
-  (add-gc-cleanup object
-                 (make-g-input-stream-cleanup
-                  (g-input-stream-cancel-info object))))
+  (let* ((info (g-input-stream-cancel-info object))
+        (gerror* (g-input-stream-cancel-info-gerror-pointer info)))
+    (add-gc-cleanup object
+                   (make-g-input-stream-cleanup info))
+    ((ucode-primitive c-malloc 2) gerror* (C-sizeof "*"))))
 
 (define (make-g-input-stream-cleanup info)
   (named-lambda (g-input-stream-cleanup)
@@ -161,8 +167,17 @@ USA.
   (cleanup-callback-id info input callback-id)
   (cleanup-callback-id info input read-id)
   (cleanup-callback-id info input skip-id)
+  (cleanup-gerror-pointer (g-input-stream-cancel-info-gerror-pointer info))
   (gobject-unref! (g-input-stream-cancel-info-gcancellable info)))
 
+(define-integrable (cleanup-gerror-pointer gerror*)
+  (if (not (alien-null? gerror*))
+      (let ((gerror (make-alien '|GError|)))
+       (C-> gerror* "* GError" gerror)
+       (if (not (alien-null? gerror))
+           (C-call "g_error_free" gerror))
+       ((ucode-primitive c-free 1) gerror*))))
+
 (define (g-input-stream-read gstream buffer start end)
   (let* ((info (g-input-stream-cancel-info gstream))
         (callback-id (g-input-stream-cancel-info-read-id info)))
@@ -191,18 +206,17 @@ USA.
              (set-g-input-stream-cancel-info-pending-op! info #f)
              value))))))
 
-(define (make-g-input-stream-read-finish-callback queue)
+(define (make-g-input-stream-read-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-input-stream-read-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_input_stream_read_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-input-stream-read-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-input-stream-read-finish-callback "value" "queue"\n")
-       (%queue! queue value))))))
+     (let ((bytes (C-call "g_input_stream_read_finish" source result gerror*)))
+       (if (fix:= bytes -1)
+          (let ((message (gerror->message gerror*)))
+            (%trace ";g-input-stream-read-finish-callback "message" "queue"\n")
+            (%queue! queue message))
+          (begin
+            (%trace ";g-input-stream-read-finish-callback "bytes" "queue"\n")
+            (%queue! queue bytes)))))))
 
 (define-integrable (%queue! queue value)
   ;; The GIO finish callbacks use this procedure to queue a value on a
@@ -235,29 +249,30 @@ USA.
            (set-g-input-stream-cancel-info-pending-op! info #f)
            value)))))
 
-(define (make-g-input-stream-skip-finish-callback queue)
+(define (make-g-input-stream-skip-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-input-stream-skip-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_input_stream_skip_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-input-stream-skip-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-input-stream-skip-finish-callback "value" "queue"\n")
-       (%queue! queue value))))))
+     (let ((bytes (C-call "g_input_stream_skip_finish" source result gerror*)))
+       (if (fix:= bytes -1)
+          (let ((message (gerror->message gerror*)))
+            (%trace ";g-input-stream-skip-finish-callback "message" "queue"\n")
+            (%queue! queue message))
+          (begin
+            (%trace ";g-input-stream-skip-finish-callback "bytes" "queue"\n")
+            (%queue! queue bytes)))))))
 
 (define (g-input-stream-close gstream)
   (let* ((info (g-input-stream-cancel-info gstream))
         (queue (g-stream-queue gstream))
+        (gerror* (g-input-stream-cancel-info-gerror-pointer info))
         (read-id (g-input-stream-cancel-info-read-id info)))
     (if (not read-id) (error "Not open:" gstream))
     (if (g-input-stream-cancel-info-pending-op info) (error "Operation pending:" gstream))
     (let ((callback-id
           (without-interrupts          ;don't leak callback IDs
            (lambda ()
-             (let ((id (make-g-input-stream-close-finish-callback queue)))
+             (let ((id (make-g-input-stream-close-finish-callback
+                        queue gerror*)))
                (set-g-input-stream-cancel-info-pending-op! info 'CLOSE)
                (set-g-input-stream-cancel-info-callback-id! info id)
                id)))))
@@ -279,31 +294,31 @@ USA.
                 (cleanup-g-input-stream info)))
              value))))))
 
-(define (make-g-input-stream-close-finish-callback queue)
+(define (make-g-input-stream-close-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-input-stream-close-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_input_stream_close_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-input-stream-close-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-input-stream-close-finish-callback "value" "queue"\n")
-       (%queue! queue #t))))))
+     (if (fix:zero?
+         (C-call "g_input_stream_close_finish" source result gerror*))
+        (let ((message (gerror->message gerror*)))
+          (%trace ";g-input-stream-close-finish-callback "message" "queue"\n")
+          (%queue! queue message))
+        (begin
+          (%trace ";g-input-stream-close-finish-callback #t "queue"\n")
+          (%queue! queue #t))))))
 \f
 (define-class (<g-output-stream> (constructor ()))
     (<g-stream>)
   (cancel-info
-   define accessor
-   initializer (lambda ()
-                (make-g-output-stream-cancel-info
-                 #f #f (make-gcancellable) #f #f))))
+   define accessor initializer
+   (lambda ()
+     (make-g-output-stream-cancel-info
+      #f #f (make-gcancellable) (make-alien '(* |GError|)) #f #f))))
 
 (define-structure g-output-stream-cancel-info
   pending-op                ; #f, OPEN, WRITE, FLUSH, CLOSE or ERROR.
   callback-id               ; #f or the open/close finish callback ID
   gcancellable              ; a GCancellable alien
+  gerror-pointer         ; null or malloced GError* that MAY ref. a GError
 
   ;; To avoid registering write or flush finish callbacks for every
   ;; write or flush (a LOT of registering/deregistering!), the open
@@ -331,6 +346,7 @@ USA.
   (cleanup-callback-id info output callback-id)
   (cleanup-callback-id info output write-id)
   (cleanup-callback-id info output flush-id)
+  (cleanup-gerror-pointer (g-output-stream-cancel-info-gerror-pointer info))
   (gobject-unref! (g-output-stream-cancel-info-gcancellable info)))
 
 (define (g-output-stream-write gstream buffer start end)
@@ -361,18 +377,19 @@ USA.
              (set-g-input-stream-cancel-info-pending-op! info #f)
              value))))))
 
-(define (make-g-output-stream-write-finish-callback queue)
+(define (make-g-output-stream-write-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-output-stream-write-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_output_stream_write_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-output-stream-write-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-output-stream-write-finish-callback "value" "queue"\n")
-       (%queue! queue value))))))
+     (let ((bytes
+           (C-call "g_output_stream_write_finish" source result gerror*)))
+       (if (fix:= bytes -1)
+          (let ((message (gerror->message gerror*)))
+            (%trace ";g-output-stream-write-finish-callback "message
+                    " "queue"\n")
+            (%queue! queue message))
+          (begin
+            (%trace ";g-output-stream-write-finish-callback "bytes" "queue"\n")
+            (%queue! queue bytes)))))))
 
 (define (g-output-stream-flush gstream)
   (let* ((info (g-output-stream-cancel-info gstream))
@@ -397,22 +414,22 @@ USA.
            (set-g-input-stream-cancel-info-pending-op! info #f)
            (not (fix:zero? value)))))))
 
-(define (make-g-output-stream-flush-finish-callback queue)
+(define (make-g-output-stream-flush-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-output-stream-flush-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_output_stream_flush_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-output-stream-flush-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-output-stream-flush-finish-callback "value" "queue"\n")
-       (%queue! queue value))))))
+     (if (fix:zero?
+         (C-call "g_output_stream_flush_finish" source result gerror*))
+        (let ((message (gerror->message gerror*)))
+          (%trace ";g-output-stream-flush-finish-callback "message" "queue"\n")
+          (%queue! queue message))
+        (begin
+          (%trace ";g-output-stream-flush-finish-callback #t "queue"\n")
+          (%queue! queue #t))))))
 
 (define (g-output-stream-close gstream)
   (let* ((info (g-output-stream-cancel-info gstream))
         (queue (g-stream-queue gstream))
+        (gerror* (g-output-stream-cancel-info-gerror-pointer info))
         (write-id (g-output-stream-cancel-info-write-id info)))
     (if (not write-id) (error "Not open:" gstream))
     (if (g-output-stream-cancel-info-pending-op info)
@@ -420,7 +437,8 @@ USA.
     (let ((callback-id
           (without-interrupts          ;don't leak callback IDs
            (lambda ()
-             (let ((id (make-g-output-stream-close-finish-callback queue)))
+             (let ((id (make-g-output-stream-close-finish-callback
+                        queue gerror*)))
                (set-g-output-stream-cancel-info-pending-op! info 'CLOSE)
                (set-g-output-stream-cancel-info-callback-id! info id)
                id)))))
@@ -442,18 +460,17 @@ USA.
                 (cleanup-g-output-stream info)))
              value))))))
 
-(define (make-g-output-stream-close-finish-callback queue)
+(define (make-g-output-stream-close-finish-callback queue gerror*)
   (C-callback
    (named-lambda (g-output-stream-close-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_output_stream_close_finish" source result gerror))
-      (lambda (message)
-       (%trace ";g-output-stream-close-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)
-       (%trace ";g-output-stream-close-finish-callback "value" "queue"\n")
-       (%queue! queue #t))))))
+     (if (fix:zero?
+         (C-call "g_output_stream_close_finish" source result gerror*))
+        (let ((message (gerror->message gerror*)))
+          (%trace ";g-output-stream-close-finish-callback "message" "queue"\n")
+          (%queue! queue message))
+        (begin
+          (%trace ";g-output-stream-close-finish-callback #t "queue"\n")
+          (%queue! queue #t))))))
 \f
 (define-class <gfile-input-stream>
     (<g-input-stream>))
@@ -467,11 +484,12 @@ USA.
   (let* ((gstream (make-g-input-stream))
         (info (g-input-stream-cancel-info gstream))
         (queue (g-stream-queue gstream))
+        (gerror* (g-input-stream-cancel-info-gerror-pointer info))
         (callback-id
          (without-interrupts           ;don't leak callback IDs
           (lambda ()
             (let* ((alien (gobject-alien gstream))
-                   (id (make-gfile-read-finish-callback alien queue)))
+                   (id (make-gfile-read-finish-callback alien queue gerror*)))
               (set-g-input-stream-cancel-info-pending-op! info 'OPEN)
               (set-g-input-stream-cancel-info-callback-id! info id)
               id)))))
@@ -493,23 +511,22 @@ USA.
               (de-register-c-callback callback-id)
               (set-g-input-stream-cancel-info-callback-id! info #f)
               (set-g-input-stream-cancel-info-read-id!
-               info (make-g-input-stream-read-finish-callback queue))
+               info (make-g-input-stream-read-finish-callback queue gerror*))
               (set-g-input-stream-cancel-info-skip-id!
-               info (make-g-input-stream-skip-finish-callback queue))))
+               info (make-g-input-stream-skip-finish-callback queue gerror*))))
            gstream)))))
 
-(define (make-gfile-read-finish-callback alien queue)
+(define (make-gfile-read-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (gfile-read-finish-callback source result)
-     (if-gerror
-      (lambda (gerror)
-       (C-call "g_file_read_finish" alien source result gerror))
-      (lambda (message)                        ;failure
-       (%trace ";g-file-read-finish-callback "message" "queue"\n")
-       (%queue! queue message))
-      (lambda (value)                  ;success
-       (%trace ";g-file-read-finish-callback "value" "queue"\n")
-       (%queue! queue value))))))
+     (let ((bytes (C-call "g_file_read_finish" alien source result gerror*)))
+       (if (fix:= bytes -1)
+          (let ((message (gerror->message gerror*)))
+            (%trace ";g-file-read-finish-callback \""message"\" "queue"\n")
+            (%queue! queue message))
+          (begin
+            (%trace ";g-file-read-finish-callback "bytes" "queue"\n")
+            (%queue! queue bytes)))))))
 
 (define-class <gfile-output-stream>
     (<g-output-stream>))
@@ -538,13 +555,11 @@ USA.
     (else (error:wrong-type-argument flag "GFile create flag"
                                     '->GFILE-CREATE-FLAG))))
 
-(define (make-gfile-append-to-finish-callback alien queue)
+(define (make-gfile-append-to-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (gfile-append-to-finish-callback source result)
-     (g-output-stream-callback queue 'append-to
-                              (lambda (gerror)
-                                (C-call "g_file_append_to_finish"
-                                        alien source result gerror))))))
+     (C-call "g_file_append_to_finish" alien source result gerror*)
+     (g-output-stream-finish alien queue gerror* 'append-to))))
 
 (define (gfile-create gfile . flags)
   (let ((flags* (->gfile-create-flags flags)))
@@ -555,13 +570,11 @@ USA.
                          priority gcancellable callback id))
                make-gfile-create-finish-callback)))
 
-(define (make-gfile-create-finish-callback alien queue)
+(define (make-gfile-create-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (gfile-create-finish-callback source result)
-     (g-output-stream-callback queue 'create
-                              (lambda (gerror)
-                                (C-call "g_file_create_finish"
-                                        alien source result gerror))))))
+     (C-call "g_file_create_finish" alien source result gerror*)
+     (g-output-stream-finish alien queue gerror* 'create))))
 
 (define (gfile-replace gfile etag backup? . flags)
   (let ((etag (->gfile-etag etag))
@@ -582,23 +595,22 @@ USA.
        (else
         (error:wrong-type-argument etag "GFile etag" '->GFILE-ETAG))))
 
-(define (make-gfile-replace-finish-callback alien queue)
+(define (make-gfile-replace-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (gfile-replace-finish-callback source result)
-     (g-output-stream-callback queue 'replace
-                              (lambda (gerror)
-                                (C-call "g_file_replace_finish"
-                                        alien source result gerror))))))
+     (C-call "g_file_replace_finish" alien source result gerror*)
+     (g-output-stream-finish alien queue gerror* 'replace))))
 
 (define-integrable (gfile-open gfile callout make-callback)
   (let* ((gstream (make-g-output-stream))
         (info (g-output-stream-cancel-info gstream))
+        (gerror* (g-output-stream-cancel-info-gerror-pointer info))
         (queue (g-stream-queue gstream))
         (callback-id
          (without-interrupts           ;don't leak callback IDs
           (lambda ()
             (let* ((alien (gobject-alien gstream))
-                   (id (make-callback alien queue)))
+                   (id (make-callback alien queue gerror*)))
               (set-g-output-stream-cancel-info-pending-op! info 'OPEN)
               (set-g-output-stream-cancel-info-callback-id! info id)
               id)))))
@@ -619,20 +631,20 @@ USA.
               (de-register-c-callback callback-id)
               (set-g-output-stream-cancel-info-callback-id! info #f)
               (set-g-output-stream-cancel-info-write-id!
-               info (make-g-output-stream-write-finish-callback queue))
+               info (make-g-output-stream-write-finish-callback queue gerror*))
               (set-g-output-stream-cancel-info-flush-id!
-               info (make-g-output-stream-flush-finish-callback queue))))
+               info
+               (make-g-output-stream-flush-finish-callback queue gerror*))))
            gstream)))))
 
-(define-integrable (g-output-stream-callback queue op callback)
-  (if-gerror
-   callback
-   (lambda (message)                   ;failure
-     (%trace ";g-output-stream-"op"-callback "message" "queue"\n")
-     (%queue! queue message))
-   (lambda (value)                     ;success
-     (%trace ";g-output-stream-"op"-callback "value" "queue"\n")
-     (%queue! queue value))))
+(define-integrable (g-output-stream-finish alien queue gerror* op)
+  (if (alien-null? alien)
+      (let ((message (gerror->message gerror*)))
+       (%trace ";g-output-stream-"op"-callback "message" "queue"\n")
+       (%queue! queue message))
+      (begin
+       (%trace ";g-output-stream-"op"-callback "alien" "queue"\n")
+       (%queue! queue alien))))
 
 (define-integrable (external-string->alien xstr)
   (let ((alien (make-alien 'uchar)))
@@ -664,39 +676,6 @@ USA.
 (define-structure gfile-etag
   alien)
 
-(define-integrable (if-gerror callout failure success)
-  ;; Applies CALLOUT to a *GError.  If the pointer is set, tail-
-  ;; applies FAILURE to the GError message, else SUCCESS to CALLOUT's
-  ;; value.
-  (let ((gerror (make-alien '|GError|))
-       (gerror* (make-alien '(* |GError|))))
-    (let ((cleanup (make-gerror-cleanup gerror*)))
-      (add-gc-cleanup gerror cleanup)
-      ((ucode-primitive c-malloc 2) gerror* (c-sizeof "* GError"))
-      (C->= gerror* "* GError" 0)
-      (let ((value (callout gerror*)))
-       (C-> gerror* "* GError" gerror)
-       (if (alien-null? gerror)
-           (begin
-             ((ucode-primitive c-free 1) gerror*)
-             (alien-null! gerror*)
-             (punt-gc-cleanup gerror)
-             (success value))
-           (let ((message (c-peek-cstring (C-> gerror "GError message"))))
-             (cleanup)
-             (punt-gc-cleanup gerror)
-             (alien-null! gerror)
-             (failure message)))))))
-
-(define (make-gerror-cleanup gerror*)
-  (named-lambda (gerror-cleanup)
-    (if (not (alien-null? gerror*))
-       (let ((gerror (C-> gerror* "* GError")))
-         (if (not (alien-null? gerror))
-             (C-call "g_error_free" gerror))
-         ((ucode-primitive c-free 1) gerror*)
-         (alien-null! gerror*)))))
-
 (define %trace? #f)
 
 (define-syntax %trace

diff --git a/src/gtk/gobject.scm b/src/gtk/gobject.scm
index edbeb3f216b7326cd4f38d66c4d6f5e96634f639..03541dffd672c769e96134dbff47d945dcb12269 100644 (file)
--- a/src/gtk/gobject.scm
+++ b/src/gtk/gobject.scm
@@ -65,7 +65,8 @@ USA.
   (without-interrupts
    (lambda ()
      (gobject-cleanup (gobject-alien object) (gobject-signals object))
-     (set! gc-cleanups (delq! (gobject-weak-self object) gc-cleanups)))))
+     (set! gc-cleanups (delq! (gobject-weak-self object) gc-cleanups))
+     unspecific)))
 
 (define (gobject-cleanup alien signals)
   ;; Run as a gc-daemon, or with exclusive write access to ALIEN and
@@ -461,6 +462,15 @@ USA.
   (set! gquark-from-string-cache (make-string-hash-table))
   (set! gquark-to-string-cache (make-eqv-hash-table))
   unspecific)
+
+(define-integrable (gerror->message pointer)
+  (let* ((GError (C-> pointer "* GError"))
+        (message (or (and (not (alien-null? GError))
+                          (c-peek-cstring (C-> GError "GError message")))
+                     "GError pointer not set.")))
+    (C->= pointer "* GError" 0)
+    (C-call "g_error_free" GError)
+    message))
 \f
 ;;; GdkPixbufLoaders
 
@@ -540,12 +550,13 @@ USA.
        (%trace "; "loader" started in "(current-thread)"\n")
        (let ((port (pixbuf-loader-port loader))
              (alien (gobject-alien loader))
-             (GError-ptr (malloc (C-sizeof "*") '(* |GError|)))
+             (*gerror (malloc (C-sizeof "*") '(* |GError|)))
              (buff (allocate-external-string 4200)))
-         (C->= GError-ptr "* GError" 0)
+         (C->= *gerror "* GError" 0)
          (let ((buff-address (external-string-descriptor buff)))
 
            (define (note-done)
+             (free *gerror)
              (without-interrupts
               (lambda ()
                 (set-pixbuf-loader-closed?! loader #t)
@@ -556,26 +567,20 @@ USA.
                       (proc loader))))))
 
            (define (note-error)
-             (let* ((GError (C-> GError-ptr "*" (make-alien '|GError|)))
-                    (message (or (and (not (alien-null? GError))
-                                      (c-peek-cstring
-                                       (C-> GError "GError message")))
-                                 "GError not set.")))
-               (set-pixbuf-loader-error-message! loader message)
-               (C-call "g_error_free" GError)
-               (free GError-ptr)
-               (note-done)))
+             (set-pixbuf-loader-error-message! loader
+                                               (gerror->message *gerror))
+             (note-done))
 
            (let loop ()
              (let ((n (input-port/read-string! port buff)))
                (cond ((and (fix:zero? n) (eof-object? (peek-char port)))
                       (if (fix:zero? (C-call "gdk_pixbuf_loader_close"
-                                             alien GError-ptr))
+                                             alien *gerror))
                           (note-error)
                           (note-done)))
                      ((not (fix:zero?
                             (C-call "gdk_pixbuf_loader_write"
-                                    alien buff-address n GError-ptr)))
+                                    alien buff-address n *gerror)))
                       (loop))
                      (else
                       (note-error))))))))))

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index ee72b2ee92ffc283dda632a45a7f5fdd0f22b8db..0bd83275f161cf1ed9370535c8361f3239e48503 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -44,6 +44,7 @@ USA.
          add-gc-cleanup punt-gc-cleanup
          gobject-get-property gobject-set-properties
          gquark-from-string gquark-to-string
+         gerror->message
          <pixbuf-loader> make-pixbuf-loader
          load-pixbuf-from-port load-pixbuf-from-file
          pixbuf-loader-size-hook set-pixbuf-loader-size-hook!