67
67
#+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety*
68
68
ccl::*nx-debug* ccl::*nx-cspeed*)
69
69
#+(or cmu scl) '(c::*default-cookie*)
70
#+ecl (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*))
70
#+(and ecl (not clasp)) (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*))
71
72
#+gcl '(compiler::*speed* compiler::*space* compiler::*compiler-new-safety* compiler::*debug*)
72
73
#+lispworks '(compiler::*optimization-level*)
73
74
#+mkcl '(si::*speed* si::*space* si::*safety* si::*debug*)
74
75
#+sbcl '(sb-c::*policy*)))
75
76
(defun get-optimization-settings ()
76
77
"Get current compiler optimization settings, ready to PROCLAIM again"
77
#-(or abcl allegro clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
78
#-(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
78
79
(warn "~S does not support ~S. Please help me fix that."
79
80
'get-optimization-settings (implementation-type))
80
#+(or abcl allegro clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
81
#+(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl)
81
82
(let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity)))
82
83
#.`(loop #+(or allegro clozure)
83
84
,@'(:with info = #+allegro (sys:declaration-information 'optimize)
84
85
#+clozure (ccl:declaration-information 'optimize nil))
85
86
:for x :in settings
86
,@(or #+(or abcl ecl gcl mkcl xcl) '(:for v :in +optimization-variables+))
87
,@(or #+(or abcl clasp ecl gcl mkcl xcl) '(:for v :in +optimization-variables+))
87
88
:for y = (or #+(or allegro clozure) (second (assoc x info)) ; normalize order
88
89
#+clisp (gethash x system::*optimize* 1)
89
#+(or abcl ecl mkcl xcl) (symbol-value v)
90
#+(or abcl clasp ecl mkcl xcl) (symbol-value v)
90
91
#+(or cmu scl) (slot-value c::*default-cookie*
91
92
(case x (compilation-speed 'c::cspeed)
93
94
#+lispworks (slot-value compiler::*optimization-level* x)
94
#+sbcl (cdr (assoc x sb-c::*policy*)))
95
#+sbcl (sb-c::policy-quality sb-c::*policy* x))
95
96
:when y :collect (list x y))))
96
97
(defun proclaim-optimization-settings ()
97
98
"Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*"
610
611
(defun compile-file-type (&rest keys)
611
612
"pathname TYPE for lisp FASt Loading files"
612
613
(declare (ignorable keys))
613
#-(or ecl mkcl) (load-time-value (pathname-type (compile-file-pathname "foo.lisp")))
614
#+(or ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo" keys)))
614
#-(or clasp ecl mkcl) (load-time-value (pathname-type (compile-file-pathname "foo.lisp")))
615
#+(or clasp ecl mkcl) (pathname-type (apply 'compile-file-pathname "foo" keys)))
616
617
(defun call-around-hook (hook function)
617
618
"Call a HOOK around the execution of FUNCTION"
637
638
(defun* (compile-file*) (input-file &rest keys
638
639
&key (compile-check *compile-check*) output-file warnings-file
639
#+clisp lib-file #+(or ecl mkcl) object-file #+sbcl emit-cfasl
640
#+clisp lib-file #+(or clasp ecl mkcl) object-file #+sbcl emit-cfasl
640
641
&allow-other-keys)
641
642
"This function provides a portable wrapper around COMPILE-FILE.
642
643
It ensures that the OUTPUT-FILE value is only returned and
656
657
On ECL or MKCL, it creates both the linkable object and loadable fasl files.
657
658
On implementations that erroneously do not recognize standard keyword arguments,
658
659
it will filter them appropriately."
659
#+ecl (when (and object-file (equal (compile-file-type) (pathname object-file)))
660
#+(or clasp ecl) (when (and object-file (equal (compile-file-type) (pathname object-file)))
660
661
(format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%"
661
662
'compile-file* output-file object-file)
662
663
(rotatef output-file object-file))
663
664
(let* ((keywords (remove-plist-keys
664
665
`(:output-file :compile-check :warnings-file
665
#+clisp :lib-file #+(or ecl mkcl) :object-file) keys))
666
#+clisp :lib-file #+(or clasp ecl mkcl) :object-file) keys))
668
669
(apply 'compile-file-pathname* input-file :output-file output-file keywords)))
671
672
(unless (use-ecl-byte-compiler-p)
673
(compile-file-pathname output-file :type :object))))
674
#+ecl(compile-file-pathname output-file :type :object)
675
#+clasp (compile-file-pathname output-file :output-type :object)
690
693
(with-enough-pathname (input-file :defaults *base-build-directory*)
691
694
(with-saved-deferred-warnings (warnings-file :source-namestring (namestring input-file))
692
695
(with-muffled-compiler-conditions ()
696
(or #-(or clasp ecl mkcl)
694
697
(apply 'compile-file input-file :output-file tmp-file
695
698
#+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
697
700
#+ecl (apply 'compile-file input-file :output-file
699
(list* object-file :system-p t keywords)
700
(list* tmp-file keywords)))
702
(list* object-file :system-p t keywords)
703
(list* tmp-file keywords)))
704
#+clasp (apply 'compile-file input-file :output-file
706
(list* object-file :output-type :object #|:system-p t|# keywords)
707
(list* tmp-file keywords)))
701
708
#+mkcl (apply 'compile-file input-file
702
709
:output-file object-file :fasl-p nil keywords)))))
707
714
(and (check-flag failure-p *compile-file-failure-behaviour*)
708
715
(check-flag warnings-p *compile-file-warnings-behaviour*)))
711
(when (and #+ecl object-file)
717
#+(or clasp ecl mkcl)
718
(when (and #+(or clasp ecl) object-file)
712
719
(setf output-truename
713
(compiler::build-fasl
714
tmp-file #+ecl :lisp-files #+mkcl :lisp-object-files
715
(list object-file))))
720
(compiler::build-fasl tmp-file
721
#+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files (list object-file))))
716
722
(or (not compile-check)
717
(apply compile-check input-file :output-file tmp-file keywords))))
723
(apply compile-check input-file
724
:output-file #-(or clasp ecl) output-file #+(or clasp ecl) tmp-file
718
726
(delete-file-if-exists output-file)
719
727
(when output-truename
728
#+clasp (when output-truename (rename-file-overwriting-target tmp-file output-truename))
720
729
#+clisp (when lib-file (rename-file-overwriting-target tmp-lib lib-file))
721
730
#+sbcl (when cfasl-file (rename-file-overwriting-target tmp-cfasl cfasl-file))
722
731
(rename-file-overwriting-target output-truename output-file)
723
732
(setf output-truename (truename output-file)))
733
#+clasp (delete-file-if-exists tmp-file)
724
734
#+clisp (delete-file-if-exists tmp-lib))
725
735
(t ;; error or failed check
726
736
(delete-file-if-exists output-truename)
added
removed
uiop/lisp-build.lisp
