Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Wrap GLX context creation in without-fp-traps to postpone crashes und…

…er fglrx. Drawing code may also need this, but that's up to the user.
  • Loading branch information...
commit 00e9315074b35314d7d451468be8178140e82e13 1 parent eee4dd8
@Ralith Ralith authored
Showing with 28 additions and 27 deletions.
  1. +1 −1  src/utils.lisp
  2. +26 −25 src/x11/glop-x11.lisp
  3. +1 −1  src/x11/glx.lisp
View
2  src/utils.lisp
@@ -104,7 +104,7 @@ Otherwise, only one key-press event will be triggered.")
#+(and sbcl x86-64)
(defmacro without-fp-traps (&body body)
`(sb-int:with-float-traps-masked (:invalid :divide-by-zero)
- ,@body))
+ ,@body))
;;; Do nothing on Lisps that don't need traps disabled.
#-(and sbcl x86-64)
View
51 src/x11/glop-x11.lisp
@@ -47,31 +47,32 @@
(defmethod create-gl-context ((win x11-window) &key (make-current t) major minor
forward-compat debug
profile)
- (let ((ctx (make-glx-context :display (x11-window-display win))))
- (setf (glx-context-ctx ctx)
- (if (and major minor)
- (let ((attrs (list :major-version major :minor-version minor)))
- (when profile
- (case profile
- (:core (push :core-profile-bit attrs))
- (:compat (push :compatibility-profile-bit attrs)))
- (push :profile-mask attrs))
- (when (or forward-compat debug)
- (let ((flags '()))
- (when forward-compat (push :forward-compatible-bit flags))
- (when debug (push :debug-bit flags))
- (push flags attrs)
- (push :flags attrs)))
- (glop-glx:glx-create-specific-context (x11-window-display win)
- (x11-window-fb-config win)
- attrs))
- (glop-glx:glx-create-context (x11-window-display win)
- (x11-window-visual-infos win))))
- (when make-current
- (attach-gl-context win ctx))
- (when (and major minor)
- (glop-glx:correct-context? major minor))
- ctx))
+ (without-fp-traps
+ (let ((ctx (make-glx-context :display (x11-window-display win))))
+ (setf (glx-context-ctx ctx)
+ (if (and major minor)
+ (let ((attrs (list :major-version major :minor-version minor)))
+ (when profile
+ (case profile
+ (:core (push :core-profile-bit attrs))
+ (:compat (push :compatibility-profile-bit attrs)))
+ (push :profile-mask attrs))
+ (when (or forward-compat debug)
+ (let ((flags '()))
+ (when forward-compat (push :forward-compatible-bit flags))
+ (when debug (push :debug-bit flags))
+ (push flags attrs)
+ (push :flags attrs)))
+ (glop-glx:glx-create-specific-context (x11-window-display win)
+ (x11-window-fb-config win)
+ attrs))
+ (glop-glx:glx-create-context (x11-window-display win)
+ (x11-window-visual-infos win))))
+ (when make-current
+ (attach-gl-context win ctx))
+ (when (and major minor)
+ (glop-glx:correct-context? major minor))
+ ctx)))
(defmethod destroy-gl-context ((ctx glx-context))
(detach-gl-context ctx)
View
2  src/x11/glx.lisp
@@ -182,7 +182,7 @@
(redirect :boolean))
(defun glx-create-context (dpy visual)
- (let ((ctx (%glx-create-context dpy visual (null-pointer) 1)))
+ (let ((ctx (%glx-create-context dpy visual (null-pointer) t)))
(when (null-pointer-p ctx)
(error "Unable to create context"))
ctx))
Please sign in to comment.
Something went wrong with that request. Please try again.