X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Finterface.lisp;h=91c5b32323b40114720ae7b6967287038187893f;hb=66cff1e1319861c080d563359afea284614b3a7f;hp=67c903545d831e499a8a9f1636bafa7cff329d55;hpb=4872f5795e786a05519c211d26243ebf2fc10540;p=sbcl.git

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 67c9035..91c5b32 100644
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -247,6 +247,27 @@
   (define-call "setpgid" int minusp (pid pid-t) (pgid pid-t))
   (define-call "setpgrp" int minusp))
 
+(defmacro with-growing-c-string ((buffer size) &body body)
+  (sb-int:with-unique-names (c-string-block)
+    `(block ,c-string-block
+       (let (,buffer)
+         (flet ((,buffer (&optional (size-incl-null))
+                  (when size-incl-null
+                    (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap ,buffer) size-incl-null)
+                          0))
+                  (return-from ,c-string-block
+                    (sb-alien::c-string-to-string
+                     (sb-alien:alien-sap ,buffer)
+                     (sb-impl::default-external-format)
+                     'character))))
+           (loop for ,size = 128 then (* 2 ,size)
+                 do (unwind-protect
+                         (progn
+                           (setf ,buffer (make-alien c-string ,size))
+                           ,@body)
+                      (when ,buffer
+                        (free-alien ,buffer)))))))))
+
 #-win32
 (progn
   (export 'readlink :sb-posix)
@@ -255,22 +276,27 @@
              (alien-funcall
               (extern-alien "readlink" (function int c-string (* t) int))
               path buf length)))
-      (loop for size = 128 then (* 2 size)
-            for buf = (make-alien c-string size)
-            do (unwind-protect
-                    (let ((count (%readlink (filename pathspec) buf size)))
-                      (cond ((minusp count)
-                             (syscall-error))
-                            ((< 0 count size)
-                             (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap buf)
-                                                     count)
-                                   0)
-                             (return
-                               (sb-alien::c-string-to-string
-                                (sb-alien:alien-sap buf)
-                                (sb-impl::default-external-format)
-                                'character)))))
-                 (free-alien buf))))))
+      (with-growing-c-string (buf size)
+        (let ((count (%readlink (filename pathspec) buf size)))
+          (cond ((minusp count)
+                 (syscall-error))
+                ((< 0 count size)
+                 (buf count))))))))
+
+(progn
+  (export 'getcwd :sb-posix)
+  (defun getcwd ()
+    (flet ((%getcwd (buffer size)
+             (alien-funcall
+              (extern-alien #-win32 "getcwd"
+                            #+win32 "_getcwd" (function c-string (* t) int))
+              buffer size)))
+      (with-growing-c-string (buf size)
+        (let ((result (%getcwd buf size)))
+          (cond (result
+                 (buf))
+                ((/= (get-errno) sb-posix:erange)
+                 (syscall-error))))))))
 
 #-win32
 (progn
@@ -279,9 +305,10 @@
  (defun wait (&optional statusptr)
    (declare (type (or null (simple-array (signed-byte 32) (1))) statusptr))
    (let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
-          (pid (alien-funcall
-                (extern-alien "wait" (function pid-t (* int)))
-                (sb-sys:vector-sap ptr))))
+          (pid (sb-sys:with-pinned-objects (ptr)
+                 (alien-funcall
+                  (extern-alien "wait" (function pid-t (* int)))
+                  (sb-sys:vector-sap ptr)))))
      (if (minusp pid)
          (syscall-error)
          (values pid (aref ptr 0))))))
@@ -295,10 +322,11 @@
             (type (sb-alien:alien int) options)
             (type (or null (simple-array (signed-byte 32) (1))) statusptr))
    (let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
-          (pid (alien-funcall
-                (extern-alien "waitpid" (function pid-t
-                                                  pid-t (* int) int))
-                pid (sb-sys:vector-sap ptr) options)))
+          (pid (sb-sys:with-pinned-objects (ptr)
+                 (alien-funcall
+                  (extern-alien "waitpid" (function pid-t
+                                                    pid-t (* int) int))
+                  pid (sb-sys:vector-sap ptr) options))))
      (if (minusp pid)
          (syscall-error)
          (values pid (aref ptr 0)))))
@@ -431,10 +459,11 @@
    (declare (type (or null (simple-array (signed-byte 32) (2))) filedes2))
    (unless filedes2
      (setq filedes2 (make-array 2 :element-type '(signed-byte 32))))
-   (let ((r (alien-funcall
-             ;; FIXME: (* INT)?  (ARRAY INT 2) would be better
-             (extern-alien "pipe" (function int (* int)))
-             (sb-sys:vector-sap filedes2))))
+   (let ((r (sb-sys:with-pinned-objects (filedes2)
+              (alien-funcall
+               ;; FIXME: (* INT)?  (ARRAY INT 2) would be better
+               (extern-alien "pipe" (function int (* int)))
+               (sb-sys:vector-sap filedes2)))))
      (when (minusp r)
        (syscall-error)))
    (values (aref filedes2 0) (aref filedes2 1))))