(defun escape-for-string (string)
(c-escape string))
+(defun split-cflags (string)
+ (remove-if (lambda (flag)
+ (zerop (length flag)))
+ (loop
+ for start = 0 then (if end (1+ end) nil)
+ for end = (and start (position #\Space string :start start))
+ while start
+ collect (subseq string start end))))
+
(defun c-escape (string &optional (dangerous-chars '(#\")) (escape-char #\\))
"Escape DANGEROUS-CHARS in STRING, with ESCAPE-CHAR."
+ (declare (simple-string string))
(coerce (loop for c across string
if (member c dangerous-chars) collect escape-char
collect c)
(dolist (def definitions)
(destructuring-bind (type lispname cname &optional doc export) def
(case type
- (:integer
+ ((:integer :errno)
(as-c "#ifdef" cname)
(printf "(cl:defconstant ~A %d \"~A\")" lispname doc
cname)
+ (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))
(definitions (read i)))
(print-c-source f headers definitions package)))))
-(defclass grovel-constants-file (asdf:cl-source-file)
- ((package :accessor constants-package :initarg :package)))
+(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 "~@<C compiler failed when performing ~A on ~A.~@:>"
- (error-operation c) (error-component c)))))
-(define-condition a-dot-out-failed (compile-failed) ()
- (:report (lambda (c s)
- (format s "~@<a.out failed when performing ~A on ~A.~@:>"
- (error-operation c) (error-component c)))))
+(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 asdf:perform ((op asdf:compile-op)
- (component grovel-constants-file))
+(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)
(terpri)
(funcall (intern "C-CONSTANTS-EXTRACT" (find-package "SB-GROVEL"))
filename tmp-c-source (constants-package component))
- (let ((code (sb-ext:process-exit-code
- (sb-ext:run-program "gcc"
- (append
- (sb-ext:posix-getenv "EXTRA_CFLAGS")
- (list "-o"
- (namestring tmp-a-dot-out)
- (namestring tmp-c-source)))
- :search t
- :input nil
- :output *trace-output*))))
- (unless (= code 0)
- (case (operation-on-failure op)
- (:warn (warn "~@<C compiler failure when performing ~A on ~A.~@:>"
- op component))
- (:error
- (error 'c-compile-failed :operation op :component component)))))
- (let ((code (sb-ext:process-exit-code
- (sb-ext:run-program (namestring tmp-a-dot-out)
- (list (namestring tmp-constants))
- :search nil
- :input nil
- :output *trace-output*))))
- (unless (= code 0)
- (case (operation-on-failure op)
- (:warn (warn "~@<a.out failure when performing ~A on ~A.~@:>"
- op component))
- (:error
- (error 'a-dot-out-failed :operation op :component component)))))
+ (unless (do-not-grovel component)
+ (let* ((cc (or (and (string/= (sb-ext:posix-getenv "CC") "")
+ (sb-ext:posix-getenv "CC"))
+ (if (member :sb-building-contrib *features*)
+ (error "~@<The CC environment variable not set during ~
+ SB-GROVEL build.~:@>")
+ (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
+ (append
+ (split-cflags (sb-ext:posix-getenv "EXTRA_CFLAGS"))
+ #+(and linux largefile)
+ '("-D_LARGEFILE_SOURCE"
+ "-D_LARGEFILE64_SOURCE"
+ "-D_FILE_OFFSET_BITS=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)
+ (namestring tmp-c-source)))
+ :search t
+ :input nil
+ :output *trace-output*))))
+ (unless (= code 0)
+ (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))
+ :search nil
+ :input nil
+ :output *trace-output*))))
+ (unless (= code 0)
+ (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 "~@<COMPILE-FILE warned while ~
- performing ~A on ~A.~@:>")
- op component))
- (:error (error 'compile-warned :component component :operation op))
- (:ignore nil)))
- (when failure-p
- (case (operation-on-failure op)
- (:warn (warn
- (formatter "~@<COMPILE-FILE failed while ~
- performing ~A on ~A.~@:>")
- 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)))))
projects / sbcl.git / blobdiff