(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.
;; A time value that is accurate to the nearest
;; microsecond but also has a range of years.
+;; CLH: Note that tv-usec used to be a time-t, but that this seems
+;; problematic on Darwin x86-64 (and wrong). Trying suseconds-t.
+#!-win32
+(define-alien-type nil
+ (struct timeval
+ (tv-sec time-t) ; seconds
+ (tv-usec suseconds-t))) ; and microseconds
+
+#!+win32
(define-alien-type nil
- (struct timeval
- (tv-sec time-t) ; seconds
- (tv-usec time-t))) ; and microseconds
+ (struct timeval
+ (tv-sec time-t) ; seconds
+ (tv-usec long))) ; and microseconds
\f
;;;; resourcebits.h
"
(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))
;;; 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)
(if (null link)
(return pathname)
(let ((new-pathname
- (unix-simplify-pathname
+ (simplify-namestring
(if (relative-unix-pathname? link)
(let* ((dir-len (1+ (position #\/
pathname
(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)))))
-
\f
;;; UNIX specific code, that has been cleanly separated from the
;;; Windows build.
projects / sbcl.git / blobdiff