"James Baker" <[EMAIL PROTECTED]> writes:
> I'm running 32bit debian on a x86-64
Please let me know if the attached patch helps.
diff -rN -u old-cl-opengl/glut/init.lisp new-cl-opengl/glut/init.lisp
--- old-cl-opengl/glut/init.lisp 2008-03-06 06:11:33.000000000 +0000
+++ new-cl-opengl/glut/init.lisp 2008-03-06 06:11:33.000000000 +0000
@@ -43,25 +43,33 @@
(defparameter *argcp* (null-pointer))
(defparameter *argv* (null-pointer))
+(defmacro without-fp-traps (&body body)
+ #+(and sbcl (or x86 x86-64))
+ `(sb-int:with-float-traps-masked (:invalid :divide-by-zero)
+ ,@body)
+ #-(and sbcl (or x86 x86-64))
+ `(progn ,@body))
+
(defun init (&optional (program-name (lisp-implementation-type)))
- (unless (getp :init-state)
- ;; freeglut will exit() if we try to call initGlut() when
- ;; things are already initialized.
- (when (not (null-pointer-p *argcp*))
- (foreign-free *argcp*))
- (when (not (null-pointer-p *argv*))
- (foreign-free (mem-aref *argv* :pointer 0))
- (foreign-free *argv*))
- (setq *argcp* (foreign-alloc :int :initial-element 1))
- (setq *argv* (foreign-alloc
- :pointer
- :initial-element (foreign-string-alloc program-name)))
- (%glutInit *argcp* *argv*)
- ;; By default, we choose the saner option to return from the event
- ;; loop on window close instead of exit()ing.
- (set-action-on-window-close :action-continue-execution)
- ;; this probably doesn't play well with other toolkits
- (setq %gl:*gl-get-proc-address* 'get-proc-address))
+ (without-fp-traps
+ (unless (getp :init-state)
+ ;; freeglut will exit() if we try to call initGlut() when
+ ;; things are already initialized.
+ (when (not (null-pointer-p *argcp*))
+ (foreign-free *argcp*))
+ (when (not (null-pointer-p *argv*))
+ (foreign-free (mem-aref *argv* :pointer 0))
+ (foreign-free *argv*))
+ (setq *argcp* (foreign-alloc :int :initial-element 1))
+ (setq *argv* (foreign-alloc
+ :pointer
+ :initial-element (foreign-string-alloc program-name)))
+ (%glutInit *argcp* *argv*)
+ ;; By default, we choose the saner option to return from the event
+ ;; loop on window close instead of exit()ing.
+ (set-action-on-window-close :action-continue-execution)
+ ;; this probably doesn't play well with other toolkits
+ (setq %gl:*gl-get-proc-address* 'get-proc-address)))
(values))
;; We call init at load-time in order to ensure a usable glut as
diff -rN -u old-cl-opengl/glut/interface.lisp new-cl-opengl/glut/interface.lisp
--- old-cl-opengl/glut/interface.lisp 2008-03-06 06:11:33.000000000 +0000
+++ new-cl-opengl/glut/interface.lisp 2008-03-06 06:11:33.000000000 +0000
@@ -356,26 +356,12 @@
(with-window win
(set-window-title string))))
-;;; Execute BODY with floating-point traps disabled. This seems to be
-;;; necessary on (at least) Linux/x86-64 where SIGFPEs are signalled
-;;; when creating making a GLX context active.
-#+(and sbcl x86-64)
-(defmacro without-fp-traps (&body body)
- `(sb-int:with-float-traps-masked (:invalid :divide-by-zero)
- ,@body))
-
-;;; Do nothing on Lisps that don't need traps disabled.
-#-(and sbcl x86-64)
-(defmacro without-fp-traps (&body body)
- `(progn ,@body))
-
(defmethod display-window :around ((win window))
- (without-fp-traps
- (apply #'init-display-mode (slot-value win 'mode))
- (setf (slot-value win 'id) (create-window (title win)))
- (call-next-method)
- (when *run-main-loop-after-display*
- (glut:main-loop))))
+ (apply #'init-display-mode (slot-value win 'mode))
+ (setf (slot-value win 'id) (create-window (title win)))
+ (call-next-method)
+ (when *run-main-loop-after-display*
+ (glut:main-loop)))
;;;; Sub-windows
diff -rN -u old-cl-opengl/glut/main.lisp new-cl-opengl/glut/main.lisp
--- old-cl-opengl/glut/main.lisp 2008-03-06 06:11:33.000000000 +0000
+++ new-cl-opengl/glut/main.lisp 2008-03-06 06:11:33.000000000 +0000
@@ -35,7 +35,8 @@
(defcfun ("glutMainLoop" %glutMainLoop) :void)
(defun main-loop ()
- (%glutMainLoop)
+ (without-fp-traps
+ (%glutMainLoop))
(init))
(defcfun ("glutMainLoopEvent" main-loop-event) :void)
--
Luís Oliveira
http://student.dei.uc.pt/~lmoliv/
_______________________________________________
cl-opengl-devel mailing list
cl-opengl-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/cl-opengl-devel
