From 7dc78c5382856f0e27b07cb75cdc5b0c62c73428 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 1 Apr 2012 11:48:55 +0300
Subject: [PATCH] fix build on SBCL

 * In DEFGLEXTFUN: use the gensym for the pointer, move the
   cache-initialization to a separate function (avoids having a separate
   anononymous resetter-function AND closure per extension), and fix apparent
   NIL / NULL-POINTER confusion.

 * Define placeholders for a few missing types.

 * Comment out a few functions with bogus void arguments.
---
 gl/bindings.lisp |   18 +++++++++++-------
 gl/funcs.lisp    |    5 +++++
 gl/types.lisp    |    7 +++++++
 3 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/gl/bindings.lisp b/gl/bindings.lisp
index a83fa3f..2336628 100644
--- a/gl/bindings.lisp
+++ b/gl/bindings.lisp
@@ -134,29 +134,33 @@
 (defun reset-gl-pointers ()
   (format t "~&;; resetting extension pointers...~%")
   (dolist (setter *gl-extension-setter-list*)
-    (funcall setter (null-pointer)))
+    (funcall setter nil))
   (setf *gl-extension-setter-list* nil))
 
 (defun find-and-register-gl-ext-function (setter foreign-name)
   (let ((pointer (gl-get-proc-address foreign-name)))
     (assert (not (null-pointer-p pointer)) ()
             "Couldn't load symbol ~A~%" foreign-name)
+    ;; FIXME: Not threadsafe!
     (push setter *gl-extension-setter-list*)
     (funcall setter (gl-get-proc-address foreign-name))))
 
+(defun ensure-gl-ext-pointer (cache)
+  (or (cdr cache)
+      (find-and-register-gl-ext-function
+       (lambda (p)
+         (setf (cdr cache) p))
+       (car cache))))
+
 ;#-(and)
 (defmacro defglextfun ((cname lname) return-type &body args)
   (alexandria:with-unique-names (pointer)
     `(progn
        (defun ,lname ,(mapcar #'car args)
-         (let* ((cache (load-time-value (cons 'pointer-cache nil)))
-                (pointer (cdr cache)))
-           (when (null-pointer-p pointer)
-             (find-and-register-gl-ext-function (lambda (p) (setf (cdr cache) p))
-                                                ,cname))
+         (let* ((,pointer (ensure-gl-ext-pointer (load-time-value (cons ,cname nil)))))
            (multiple-value-prog1
                (foreign-funcall-pointer
-                pointer
+                ,pointer
                 (:library opengl)
                 ,@(loop for arg in args
                         collect (second arg) collect (first arg))
diff --git a/gl/funcs.lisp b/gl/funcs.lisp
index 9a494cc..b1c00f4 100644
--- a/gl/funcs.lisp
+++ b/gl/funcs.lisp
@@ -6546,6 +6546,7 @@
   (buf (:pointer char)))
 
 ;;; GL version: 4.1, ARB_debug_output
+#+nil ; missing type
 (defglextfun ("glDebugMessageCallbackARB" debug-message-callback-arb) :void
   (callback DEBUGPROC-arb)
   (userParam (:pointer void)))
@@ -14024,6 +14025,7 @@
   (buf (:pointer char)))
 
 ;;; GL version: 4.1, AMD_debug_output
+#+nil ; missing type
 (defglextfun ("glDebugMessageCallbackAMD" debug-message-callback-amd) :void
   (callback DEBUGPROCAMD)
   (userParam void))
@@ -14039,6 +14041,7 @@
   (message (:pointer char)))
 
 ;;; GL version: 4.1, NV_vdpau_interop
+#+nil ; bad void type
 (defglextfun ("glVDPAUInitNV" vdpau-init-nv) :void
   (vdpDevice void)
   (getProcAddress void))
@@ -14047,6 +14050,7 @@
 (defglextfun ("glVDPAUFiniNV" vdpau-fini-nv) :void)
 
 ;;; GL version: 4.1, NV_vdpau_interop
+#+nil ; bad void type
 (defglextfun ("glVDPAURegisterVideoSurfaceNV" vdpau-register-video-surface-nv) vdpauSurface-nv
   (vdpSurface void)
   (target enum)
@@ -14054,6 +14058,7 @@
   (textureNames (:pointer uint)))
 
 ;;; GL version: 4.1, NV_vdpau_interop
+#+nil ; bad void type
 (defglextfun ("glVDPAURegisterOutputSurfaceNV" vdpau-register-output-surface-nv) vdpauSurface-nv
   (vdpSurface void)
   (target enum)
diff --git a/gl/types.lisp b/gl/types.lisp
index ec6f5d2..82634e6 100644
--- a/gl/types.lisp
+++ b/gl/types.lisp
@@ -111,3 +111,10 @@
 (defctype clampf ensure-float)
 (defctype double ensure-double)
 (defctype clampd ensure-double)
+
+;;; ???
+(defctype vdpausurface-nv (:pointer int))
+(defctype _cl_context (:pointer void))
+(defctype _cl_event (:pointer void))
+(defctype int64-ext :int64)
+(defctype uint64-ext :uint64)
-- 
1.7.5.GIT