New contrib: SB-GMP

[sbcl.git] / contrib / sb-grovel / def-to-lisp.lisp

diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp
index 32b448d..97f2435 100644 (file)
--- a/contrib/sb-grovel/def-to-lisp.lisp
+++ b/contrib/sb-grovel/def-to-lisp.lisp
@@ -5,8 +5,18 @@
 (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)
@@ -103,10 +113,12 @@ code:
     (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)
            (as-c "#endif"))
@@ -142,7 +154,10 @@ code:
         (print-c-source  f headers definitions package)))))
 
 (defclass grovel-constants-file (asdf:cl-source-file)
-  ((package :accessor constants-package :initarg :package)))
+  ((package :accessor constants-package :initarg :package)
+   (do-not-grovel :accessor do-not-grovel
+                  :initform nil
+                  :initarg :do-not-grovel)))
 
 (define-condition c-compile-failed (compile-failed) ()
   (:report (lambda (c s)
@@ -174,34 +189,60 @@ code:
     (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)
+          (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))))))
     (multiple-value-bind (output warnings-p failure-p)
         (compile-file tmp-constants :output-file output-file)
       (when warnings-p