Skip to content
Snippets Groups Projects
Commit 87487526 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Beef up get-optimization-settings. Introduce with-optimization-settings.

parent 9716173a
No related branches found
No related tags found
No related merge requests found
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
;; Types ;; Types
#+sbcl #:sb-grovel-unknown-constant-condition #+sbcl #:sb-grovel-unknown-constant-condition
;; Functions & Macros ;; Functions & Macros
#:get-optimization-settings #:proclaim-optimization-settings #:get-optimization-settings #:proclaim-optimization-settings #:with-optimization-settings
#:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions
#:call-with-muffled-loader-conditions #:with-muffled-loader-conditions #:call-with-muffled-loader-conditions #:with-muffled-loader-conditions
#:reify-simple-sexp #:unreify-simple-sexp #:reify-simple-sexp #:unreify-simple-sexp
...@@ -60,20 +60,32 @@ This can help you produce more deterministic output for FASLs.")) ...@@ -60,20 +60,32 @@ This can help you produce more deterministic output for FASLs."))
"Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS") "Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS")
(defvar *previous-optimization-settings* nil (defvar *previous-optimization-settings* nil
"Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS") "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS")
(defparameter +optimization-variables+
;; TODO: allegro genera corman mcl
(or #+(or abcl xcl) '(system::*speed* c::*space* c::*safety* c::*debug*)
#+clisp '(system::*optimize*)
#+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety*
ccl::*nx-debug* ccl::*nx-cspeed*)
#+(or cmu scl) '(c::*default-cookie*)
#+ecl '(c::*speed* c::*space* c::*safety* c::*debug*)
#+gcl '(compiler::*speed* compiler::*space* compiler::*compiler-new-safety* compiler::*debug*)
#+lispworks '(compiler::*optimization-level*)
#+mkcl '(si::*speed* si::*space* si::*safety* si::*debug*)
#+sbcl '(sb-c::*policy*)))
(defun get-optimization-settings () (defun get-optimization-settings ()
"Get current compiler optimization settings, ready to PROCLAIM again" "Get current compiler optimization settings, ready to PROCLAIM again"
#-(or clisp clozure cmu ecl mkcl sbcl scl) #-(or abcl clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
(warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type)) (warn "~S does not support ~S. Please help me fix that."
'get-optimization-settings (implementation-type))
#+clozure (ccl:declaration-information 'optimize nil) #+clozure (ccl:declaration-information 'optimize nil)
#+(or clisp cmu ecl mkcl sbcl scl) #+(or abcl clisp cmu ecl lispworks mkcl sbcl scl xcl)
(let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
#.`(loop :for x :in settings #.`(loop :for x :in settings
,@(or #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) ,@(or #+(or abcl ecl gcl mkcl xcl) '(:for v :in *optimization-variables*))
#+mkcl '(:for v :in '(si::*speed* si::*space* si::*safety* si::*debug*))
#+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity)))
:for y = (or #+clisp (gethash x system::*optimize*) :for y = (or #+clisp (gethash x system::*optimize*)
#+(or ecl mkcl) (symbol-value v) #+(or abcl ecl mkcl xcl) (symbol-value v)
#+(or cmu scl) (funcall f c::*default-cookie*) #+(or cmu scl) (slot-value c::*default-cookie* x)
#+lispworks (slot-value compiler::*optimization-level* x)
#+sbcl (cdr (assoc x sb-c::*policy*))) #+sbcl (cdr (assoc x sb-c::*policy*)))
:when y :collect (list x y)))) :when y :collect (list x y))))
(defun proclaim-optimization-settings () (defun proclaim-optimization-settings ()
...@@ -81,7 +93,11 @@ This can help you produce more deterministic output for FASLs.")) ...@@ -81,7 +93,11 @@ This can help you produce more deterministic output for FASLs."))
(proclaim `(optimize ,@*optimization-settings*)) (proclaim `(optimize ,@*optimization-settings*))
(let ((settings (get-optimization-settings))) (let ((settings (get-optimization-settings)))
(unless (equal *previous-optimization-settings* settings) (unless (equal *previous-optimization-settings* settings)
(setf *previous-optimization-settings* settings))))) (setf *previous-optimization-settings* settings))))
(defmacro with-optimization-settings ((&optional (settings *optimization-settings*)) &body body)
`(let ,(loop :for v :in +optimization-variables+ :collect `(,v ,v))
,@(when settings `((proclaim `(optimize ,@,settings))))
,@body)))
;;; Condition control ;;; Condition control
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment