X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=b011c9e6632db48b2d4ab23b8d05379bd42a30b9;hb=dfe6138af5c38d92568b6dac48e852c01be0ec8e;hp=c1b32ab39c0303c8d8a4076a019447fb21280b8f;hpb=3a618201c9f2370bb8784217a866d000371769e5;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index c1b32ab..b011c9e 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -241,7 +241,7 @@ ;;; UNIX-WRITE accepts a file descriptor, a buffer, an offset, and the ;;; length to write. It attempts to write len bytes to the device -;;; associated with fd from the the buffer starting at offset. It returns +;;; associated with fd from the buffer starting at offset. It returns ;;; the actual number of bytes written. (defun unix-write (fd buf offset len) (declare (type unix-fd fd) @@ -811,7 +811,7 @@ previous timer after the body has finished executing" ;;; paths have been converted to absolute paths, so we don't need to ;;; try to handle any more generality than that. (defun unix-resolve-links (pathname) - (declare (type simple-string pathname)) + (declare (type simple-base-string pathname)) (aver (not (relative-unix-pathname? pathname))) (/noshow "entering UNIX-RESOLVE-LINKS") (loop with previous-pathnames = nil do @@ -837,7 +837,7 @@ previous timer after the body has finished executing" :from-end t))) (dir (subseq pathname 0 dir-len))) (/noshow dir) - (concatenate 'string dir link)) + (concatenate 'base-string dir link)) link)))) (if (unix-file-kind new-pathname) (setf pathname new-pathname) @@ -853,9 +853,9 @@ previous timer after the body has finished executing" (push pathname previous-pathnames)))) (defun unix-simplify-pathname (src) - (declare (type simple-string src)) + (declare (type simple-base-string src)) (let* ((src-len (length src)) - (dst (make-string src-len)) + (dst (make-string src-len :element-type 'base-char)) (dst-len 0) (dots 0) (last-slash nil)) @@ -929,7 +929,8 @@ previous timer after the body has finished executing" (position #\/ dst :end last-slash :from-end t))) (if prev-prev-slash (setf dst-len (1+ prev-prev-slash)) - (return-from unix-simplify-pathname "./"))))))) + (return-from unix-simplify-pathname + (coerce "./" 'simple-base-string)))))))) (cond ((zerop dst-len) "./") ((= dst-len src-len) @@ -968,7 +969,9 @@ previous timer after the body has finished executing" `(multiple-value-bind (,word ,bit) (floor ,offset 32) (setf (deref (slot ,fd-set 'fds-bits) ,word) (logand (deref (slot ,fd-set 'fds-bits) ,word) - (sb!kernel:32bit-logical-not + ;; FIXME: This may not be quite right for 64-bit + ;; ports of SBCL. --njf, 2004-08-04 + (sb!kernel:word-logical-not (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) ;;; not checked for linux...