X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-grovel%2Fdef-to-lisp.lisp;h=d87d7c2c5b4728627aa9099698a432c1f37354db;hb=260de2062fca170efdac3e42491d7d866c2d2e56;hp=4c6cad4bd1ba1d4d3e103939a96e295f403ba3f2;hpb=53ab0266f9a92943cc93f675cc727d01cfa55474;p=sbcl.git diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp index 4c6cad4..d87d7c2 100644 --- a/contrib/sb-grovel/def-to-lisp.lisp +++ b/contrib/sb-grovel/def-to-lisp.lisp @@ -120,7 +120,7 @@ code: (when (eql type :errno) (printf "(cl:setf (get '~A 'errno) t)" lispname)) (as-c "#else") - (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname) + (printf "(sb-int:style-warn \"Couldn't grovel for ~~A (unknown to the C compiler).\" \"~A\")" cname) (as-c "#endif")) (:enum (c-for-enum lispname cname export)) @@ -153,28 +153,31 @@ code: (definitions (read i))) (print-c-source f headers definitions package))))) -(defclass grovel-constants-file (asdf:cl-source-file) +(defclass grovel-constants-file (cl-source-file) ((package :accessor constants-package :initarg :package) (do-not-grovel :accessor do-not-grovel :initform nil :initarg :do-not-grovel))) +(defclass asdf::sb-grovel-constants-file (grovel-constants-file) ()) -(define-condition c-compile-failed (compile-failed) () - (:report (lambda (c s) - (format s "~@" - (error-operation c) (error-component c))))) -(define-condition a-dot-out-failed (compile-failed) () - (:report (lambda (c s) - (format s "~@" - (error-operation c) (error-component c))))) - -(defmethod asdf:perform ((op asdf:compile-op) - (component grovel-constants-file)) +(define-condition c-compile-failed (compile-file-error) + ((description :initform "C compiler failed"))) +(define-condition a-dot-out-failed (compile-file-error) + ((description :initform "a.out failed"))) + +(defmethod perform ((op compile-op) + (component grovel-constants-file)) ;; we want to generate all our temporary files in the fasl directory ;; because that's where we have write permission. Can't use /tmp; ;; it's insecure (these files will later be owned by root) - (let* ((output-file (car (output-files op component))) + (let* ((output-files (output-files op component)) + (output-file (first output-files)) + (warnings-file (second output-files)) (filename (component-pathname component)) + (context-format "~/asdf-action::format-action/") + (context-arguments `((,op . ,component))) + (condition-arguments `(:context-format ,context-format + :context-arguments ,context-arguments)) (real-output-file (if (typep output-file 'logical-pathname) (translate-logical-pathname output-file) @@ -192,10 +195,12 @@ code: (unless (do-not-grovel component) (let* ((cc (or (and (string/= (sb-ext:posix-getenv "CC") "") (sb-ext:posix-getenv "CC")) - ;; It might be nice to include a CONTINUE or - ;; USE-VALUE restart here, but ASDF seems to insist - ;; on handling the errors itself. - (error "The CC environment variable has not been set in SB-GROVEL. Since this variable should always be set during the SBCL build process, this might indicate an SBCL with a broken contrib installation."))) + (if (member :sb-building-contrib *features*) + (error "~@") + (sb-int:style-warn + "CC environment variable not set, SB-GROVEL falling back to \"cc\".")) + "cc")) (code (sb-ext:process-exit-code (sb-ext:run-program cc @@ -205,8 +210,17 @@ code: '("-D_LARGEFILE_SOURCE" "-D_LARGEFILE64_SOURCE" "-D_FILE_OFFSET_BITS=64") - #+(and x86-64 darwin) - '("-arch" "x86_64") + #+(and (or x86 ppc) linux) '("-m32") + #+(and x86-64 darwin inode64) + '("-arch" "x86_64" + "-mmacosx-version-min=10.5" + "-D_DARWIN_USE_64_BIT_INODE") + #+(and x86-64 darwin (not inode64)) + '("-arch" "x86_64" + "-mmacosx-version-min=10.4") + #+(and x86 darwin) + '("-arch" "i386" + "-mmacosx-version-min=10.4") #+(and x86-64 sunos) '("-m64") (list "-o" (namestring tmp-a-dot-out) @@ -215,11 +229,7 @@ code: :input nil :output *trace-output*)))) (unless (= code 0) - (case (operation-on-failure op) - (:warn (warn "~@" - op component)) - (:error - (error 'c-compile-failed :operation op :component component))))) + (apply 'error 'c-compile-failed condition-arguments))) (let ((code (sb-ext:process-exit-code (sb-ext:run-program (namestring tmp-a-dot-out) (list (namestring tmp-constants)) @@ -227,29 +237,7 @@ code: :input nil :output *trace-output*)))) (unless (= code 0) - (case (operation-on-failure op) - (:warn (warn "~@" - op component)) - (:error - (error 'a-dot-out-failed :operation op :component component)))))) + (apply 'error 'a-dot-out-failed condition-arguments))) (multiple-value-bind (output warnings-p failure-p) - (compile-file tmp-constants :output-file output-file) - (when warnings-p - (case (operation-on-warnings op) - (:warn (warn - (formatter "~@") - op component)) - (:error (error 'compile-warned :component component :operation op)) - (:ignore nil))) - (when failure-p - (case (operation-on-failure op) - (:warn (warn - (formatter "~@") - op component)) - (:error (error 'compile-failed :component component :operation op)) - (:ignore nil))) - (unless output - (error 'compile-error :component component :operation op))))) - + (compile-file* tmp-constants :output-file output-file :warnings-file warnings-file) + (check-lisp-compile-results output warnings-p failure-p context-format context-arguments)))))