1.0.15.2: Add binding to fcntl's struct flock in SB-POSIX.

[sbcl.git] / contrib / sb-posix / macros.lisp

diff --git a/contrib/sb-posix/macros.lisp b/contrib/sb-posix/macros.lisp
index dd22a7c..2e15e10 100644 (file)
--- a/contrib/sb-posix/macros.lisp
+++ b/contrib/sb-posix/macros.lisp
@@ -2,7 +2,8 @@
 
 (define-designator filename c-string
   (pathname
-   (sb-ext:native-namestring (translate-logical-pathname filename)))
+   (sb-ext:native-namestring (translate-logical-pathname filename)
+                             :as-file t))
   (string filename))
 
 (define-designator file-descriptor (integer 32)
@@ -25,20 +26,29 @@
      (let ((root (if (eql #\_ (char name 0)) (subseq name 1) name)))
        (intern (substitute #\- #\_ (string-upcase root)) :sb-posix)))))
 
+;; Note: this variable is set in interface.lisp.  defined here for
+;; clarity and so the real-c-name compile as desired.
+(defparameter *c-functions-in-runtime* nil)
+
 (defun real-c-name (name)
-  (etypecase name
-    (list
-     (destructuring-bind (name &key c-name options) name
-       (if c-name
-           c-name
-           (cond #+largefile
-                 ((or (eql options :largefile)
-                      (member :largefile options))
-                  (format nil "~a_largefile" name))
-                 (t
-                  name)))))
-    (string
-     name)))
+  (let  ((maybe-name
+          (etypecase name
+            (list
+             (destructuring-bind (name &key c-name options) name
+               (if c-name
+                   c-name
+                   (cond #+largefile
+                         ((or (eql options :largefile)
+                              (member :largefile options))
+                          (format nil "~a_largefile" name))
+                         (t
+                          name)))))
+            (string
+             name))))
+    (if (member maybe-name *c-functions-in-runtime*
+                :test #'string=)
+        (format nil "_~A" maybe-name)
+        maybe-name)))
 
 (defmacro define-call-internally (lisp-name c-name return-type error-predicate
                                   &rest arguments)