X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=39b23eb04df46b1ff6ef8a1ff506d0f2010e4f7c;hb=fedd9f4e92ddb1b599695043eb1dafe356475afc;hp=c1b32ab39c0303c8d8a4076a019447fb21280b8f;hpb=3a618201c9f2370bb8784217a866d000371769e5;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index c1b32ab..39b23eb 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -123,7 +123,8 @@
 
 (define-alien-type nil
   (struct fd-set
-	  (fds-bits (array fd-mask #.(/ fd-setsize 32)))))
+	  (fds-bits (array fd-mask #.(/ fd-setsize
+					sb!vm:n-machine-word-bits)))))
 
 (/show0 "unix.lisp 304")
 
@@ -241,7 +242,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)
@@ -489,19 +490,24 @@
   `(if (fixnump ,num)
        (progn
 	 (setf (deref (slot ,fdset 'fds-bits) 0) ,num)
-	 ,@(loop for index upfrom 1 below (/ fd-setsize 32)
+	 ,@(loop for index upfrom 1 below (/ fd-setsize
+					     sb!vm:n-machine-word-bits)
 	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
        (progn
-	 ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+	 ,@(loop for index upfrom 0 below (/ fd-setsize
+					     sb!vm:n-machine-word-bits)
 	     collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
-			    (ldb (byte 32 ,(* index 32)) ,num))))))
+			    (ldb (byte sb!vm:n-machine-word-bits 
+				       ,(* index sb!vm:n-machine-word-bits))
+				 ,num))))))
 
 (defmacro fd-set-to-num (nfds fdset)
-  `(if (<= ,nfds 32)
+  `(if (<= ,nfds sb!vm:n-machine-word-bits)
        (deref (slot ,fdset 'fds-bits) 0)
-       (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+       (+ ,@(loop for index upfrom 0 below (/ fd-setsize
+					      sb!vm:n-machine-word-bits)
 	      collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
-			    ,(* index 32))))))
+			    ,(* index sb!vm:n-machine-word-bits))))))
 
 ;;; Examine the sets of descriptors passed as arguments to see whether
 ;;; they are ready for reading and writing. See the UNIX Programmer's
@@ -811,7 +817,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 +843,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 +859,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 +935,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)
@@ -956,32 +963,37 @@ previous timer after the body has finished executing"
 (defmacro fd-set (offset fd-set)
   (let ((word (gensym))
 	(bit (gensym)))
-    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+    `(multiple-value-bind (,word ,bit) (floor ,offset
+					      sb!vm:n-machine-word-bits)
        (setf (deref (slot ,fd-set 'fds-bits) ,word)
-	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
+	     (logior (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+				(ash 1 ,bit))
 		     (deref (slot ,fd-set 'fds-bits) ,word))))))
 
 ;;; not checked for linux...
 (defmacro fd-clr (offset fd-set)
   (let ((word (gensym))
 	(bit (gensym)))
-    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+    `(multiple-value-bind (,word ,bit) (floor ,offset
+					      sb!vm:n-machine-word-bits)
        (setf (deref (slot ,fd-set 'fds-bits) ,word)
 	     (logand (deref (slot ,fd-set 'fds-bits) ,word)
-		     (sb!kernel:32bit-logical-not
-		      (truly-the (unsigned-byte 32) (ash 1 ,bit))))))))
+		     (sb!kernel:word-logical-not
+		      (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+				 (ash 1 ,bit))))))))
 
 ;;; not checked for linux...
 (defmacro fd-isset (offset fd-set)
   (let ((word (gensym))
 	(bit (gensym)))
-    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+    `(multiple-value-bind (,word ,bit) (floor ,offset
+					      sb!vm:n-machine-word-bits)
        (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
 
 ;;; not checked for linux...
 (defmacro fd-zero (fd-set)
   `(progn
-     ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+     ,@(loop for index upfrom 0 below (/ fd-setsize sb!vm:n-machine-word-bits)
 	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))