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

Preliminary allegro implementation of get-optimization-settings.

parent 9d0b9b0d
No related branches found
No related tags found
No related merge requests found
...@@ -314,7 +314,7 @@ ...@@ -314,7 +314,7 @@
(assert-equal (multiple-value-list (ensure-gethash 3 h 5)) '(nil t))) (assert-equal (multiple-value-list (ensure-gethash 3 h 5)) '(nil t)))
(DBG :optimization-settings) (DBG :optimization-settings)
#-(or allegro ecl-bytecmp gcl mkcl) #-(or ecl-bytecmp gcl mkcl)
(loop :with settings = (get-optimization-settings) (loop :with settings = (get-optimization-settings)
:for i :from 0 :to 3 :do :for i :from 0 :to 3 :do
(with-optimization-settings (`((speed ,i) (space ,i) (safety ,i) (debug ,i))) (with-optimization-settings (`((speed ,i) (space ,i) (safety ,i) (debug ,i)))
......
...@@ -74,15 +74,18 @@ This can help you produce more deterministic output for FASLs.")) ...@@ -74,15 +74,18 @@ This can help you produce more deterministic output for FASLs."))
#+sbcl '(sb-c::*policy*))) #+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 abcl clisp clozure cmu ecl lispworks mkcl sbcl scl xcl) #-(or abcl allegro clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
(warn "~S does not support ~S. Please help me fix that." (warn "~S does not support ~S. Please help me fix that."
'get-optimization-settings (implementation-type)) 'get-optimization-settings (implementation-type))
#+clozure (ccl:declaration-information 'optimize nil) #+(or abcl allegro clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
#+(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 #+(or allegro clozure)
,@'(:with info = #+allegro (sys:declaration-information 'optimize)
#+clozure (ccl:declaration-information 'optimize nil))
:for x :in settings
,@(or #+(or abcl ecl gcl mkcl xcl) '(:for v :in +optimization-variables+)) ,@(or #+(or abcl ecl gcl mkcl xcl) '(:for v :in +optimization-variables+))
:for y = (or #+clisp (gethash x system::*optimize* 0) :for y = (or #+(or allegro clozure) (second (assoc x info)) ; normalize order
#+clisp (gethash x system::*optimize* 1)
#+(or abcl ecl mkcl xcl) (symbol-value v) #+(or abcl ecl mkcl xcl) (symbol-value v)
#+(or cmu scl) (slot-value c::*default-cookie* #+(or cmu scl) (slot-value c::*default-cookie*
(case x (compilation-speed 'c::cspeed) (case x (compilation-speed 'c::cspeed)
...@@ -97,13 +100,13 @@ This can help you produce more deterministic output for FASLs.")) ...@@ -97,13 +100,13 @@ This can help you produce more deterministic output for FASLs."))
(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) (defmacro with-optimization-settings ((&optional (settings *optimization-settings*)) &body body)
#+clisp #+(or allegro clisp)
(let ((previous-settings (gensym "PREVIOUS-SETTINGS"))) (let ((previous-settings (gensym "PREVIOUS-SETTINGS")))
`(let ((,previous-settings (get-optimization-settings))) `(let ((,previous-settings (get-optimization-settings)))
,@(when settings `((proclaim `(optimize ,@,settings)))) ,@(when settings `((proclaim `(optimize ,@,settings))))
(unwind-protect (progn ,@body) (unwind-protect (progn ,@body)
(proclaim `(optimize ,@,previous-settings))))) (proclaim `(optimize ,@,previous-settings)))))
#-clisp #-(or allegro clisp)
`(let ,(loop :for v :in +optimization-variables+ :collect `(,v ,v)) `(let ,(loop :for v :in +optimization-variables+ :collect `(,v ,v))
,@(when settings `((proclaim `(optimize ,@,settings)))) ,@(when settings `((proclaim `(optimize ,@,settings))))
,@body))) ,@body)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment