X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=94bf062befaa27a5376c4b5b20c7ae96659b98db;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=40cfd07b24f9aa14d1e4a9870dfea708a820ced4;hpb=2b90fd1dbad23322258222a2ef4cef7f6a00831d;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 40cfd07..94bf062 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -167,7 +167,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
   (declare (type unix-pathname path)
            (type fixnum flags)
            (type unix-file-mode mode))
-  (int-syscall ("open" c-string int int) path (logior #!+win32 o_binary flags) mode))
+  (int-syscall ("open" c-string int int)
+               path
+               (logior #!+win32 o_binary
+                       #!+largefile o_largefile
+                       flags)
+               mode))
 
 ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file
 ;;; associated with it.
@@ -257,7 +262,9 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
   "
   (declare (type unix-fd fd)
            (type (integer 0 2) whence))
-  (let ((result (alien-funcall (extern-alien "lseek" (function off-t int off-t int))
+  (let ((result (alien-funcall (extern-alien #!-largefile "lseek"
+                                             #!+largefile "lseek_largefile"
+                                             (function off-t int off-t int))
                  fd offset whence)))
     (if (minusp result )
         (values nil (get-errno))
@@ -614,23 +621,19 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
 ;;; longer than 32 bits anyway, right?":-|
 (define-alien-type nil
   (struct wrapped_stat
-    #!-mips
-    (st-dev unsigned-int)              ; would be dev-t in a real stat
-    #!+mips
-    (st-dev unsigned-long)             ; this is _not_ a dev-t on mips
+    (st-dev #!-(or mips largefile) unsigned-int
+            #!+mips unsigned-long
+            #!+largefile dev-t)
     (st-ino ino-t)
     (st-mode mode-t)
     (st-nlink nlink-t)
     (st-uid uid-t)
     (st-gid gid-t)
-    #!-mips
-    (st-rdev unsigned-int)             ; would be dev-t in a real stat
-    #!+mips
-    (st-rdev unsigned-long)             ; this is _not_ a dev-t on mips
-    #!-mips
-    (st-size unsigned-int)              ; would be off-t in a real stat
-    #!+mips
-    (st-size off-t)
+    (st-rdev #!-(or mips largefile) unsigned-int
+             #!+mips unsigned-long
+             #!+largefile dev-t)
+    (st-size #!-(or mips largefile) unsigned-int
+             #!+(or mips largefile) off-t)
     (st-blksize unsigned-long)
     (st-blocks unsigned-long)
     (st-atime time-t)
@@ -907,7 +910,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
           (if (null link)
               (return pathname)
               (let ((new-pathname
-                     (unix-simplify-pathname
+                     (simplify-namestring
                       (if (relative-unix-pathname? link)
                           (let* ((dir-len (1+ (position #\/
                                                         pathname
@@ -928,93 +931,6 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
         (if (member pathname previous-pathnames :test #'string=)
             (return pathname)
             (push pathname previous-pathnames))))
-
-(defun unix-simplify-pathname (src)
-  (declare (type simple-string src))
-  (let* ((src-len (length src))
-         (dst (make-string src-len :element-type 'character))
-         (dst-len 0)
-         (dots 0)
-         (last-slash nil))
-    (macrolet ((deposit (char)
-                 `(progn
-                    (setf (schar dst dst-len) ,char)
-                    (incf dst-len))))
-      (dotimes (src-index src-len)
-        (let ((char (schar src src-index)))
-          (cond ((char= char #\.)
-                 (when dots
-                   (incf dots))
-                 (deposit char))
-                ((char= char #\/)
-                 (case dots
-                   (0
-                    ;; either ``/...' or ``...//...'
-                    (unless last-slash
-                      (setf last-slash dst-len)
-                      (deposit char)))
-                   (1
-                    ;; either ``./...'' or ``..././...''
-                    (decf dst-len))
-                   (2
-                    ;; We've found ..
-                    (cond
-                     ((and last-slash (not (zerop last-slash)))
-                      ;; There is something before this ..
-                      (let ((prev-prev-slash
-                             (position #\/ dst :end last-slash :from-end t)))
-                        (cond ((and (= (+ (or prev-prev-slash 0) 2)
-                                       last-slash)
-                                    (char= (schar dst (- last-slash 2)) #\.)
-                                    (char= (schar dst (1- last-slash)) #\.))
-                               ;; The something before this .. is another ..
-                               (deposit char)
-                               (setf last-slash dst-len))
-                              (t
-                               ;; The something is some directory or other.
-                               (setf dst-len
-                                     (if prev-prev-slash
-                                         (1+ prev-prev-slash)
-                                         0))
-                               (setf last-slash prev-prev-slash)))))
-                     (t
-                      ;; There is nothing before this .., so we need to keep it
-                      (setf last-slash dst-len)
-                      (deposit char))))
-                   (t
-                    ;; something other than a dot between slashes
-                    (setf last-slash dst-len)
-                    (deposit char)))
-                 (setf dots 0))
-                (t
-                 (setf dots nil)
-                 (setf (schar dst dst-len) char)
-                 (incf dst-len))))))
-    (when (and last-slash (not (zerop last-slash)))
-      (case dots
-        (1
-         ;; We've got  ``foobar/.''
-         (decf dst-len))
-        (2
-         ;; We've got ``foobar/..''
-         (unless (and (>= last-slash 2)
-                      (char= (schar dst (1- last-slash)) #\.)
-                      (char= (schar dst (- last-slash 2)) #\.)
-                      (or (= last-slash 2)
-                          (char= (schar dst (- last-slash 3)) #\/)))
-           (let ((prev-prev-slash
-                  (position #\/ dst :end last-slash :from-end t)))
-             (if prev-prev-slash
-                 (setf dst-len (1+ prev-prev-slash))
-                 (return-from unix-simplify-pathname
-                   (coerce "./" 'simple-string))))))))
-    (cond ((zerop dst-len)
-           "./")
-          ((= dst-len src-len)
-           dst)
-          (t
-           (subseq dst 0 dst-len)))))
-
 
 ;;; UNIX specific code, that has been cleanly separated from the
 ;;; Windows build.