Changeset 10601

Timestamp:

Sep 2, 2008, 11:58:11 AM (12 years ago)

Author:

gb

Message:

Fix a few problems with %OS-GETCWD and CURRENT-DIRECTORY-NAME, mostly
related to the interpretation of "bufsize".

File:

• branches/win64/level-1/linux-files.lisp (modified) (3 diffs)

branches/win64/level-1/linux-files.lisp

@@ -194 +194 @@
   (%signal-semaphore-ptr (semaphore-value s)))
 
-(defun %os-getcwd (buf bufsize)
+(defun %os-getcwd (buf noctets)
   ;; Return N < 0, if error
-  ;;        N < bufsize: success, string is of length n
-  ;;        N > bufsize: buffer needs to be larger.
-  (let* ((p (#+windows-target #__wgetcwd #-windows-target #_getcwd buf bufsize)))
+  ;;        N < noctets: success, string is of length N (octets).
+  ;;        N >= noctets: buffer needs to be larger.
+  (let* ((p #+windows-target
+           (#__wgetcwd buf (ash noctets -1))
+           #-windows-target
+           (#_getcwd buf noctets)))
     (declare (dynamic-extent p))
     (if (%null-ptr-p p)
       (let* ((err (%get-errno)))
         (if (eql err (- #$ERANGE))
-          (+ bufsize bufsize)
+          (+ noctets noctets)
           err))
       #+windows-target
       (do* ((i 0 (+ i 2)))
-           ((= i bufsize) (+ bufsize))
+           ((= i noctets) (+ noctets noctets))
         (when (eql (%get-unsigned-word buf i) 0)
-          (return (ash i -1))))
+          (return i)))
       #-windows-target
-      (dotimes (i bufsize (+ bufsize bufsize))
+      (dotimes (i noctets (+ noctets noctets))
         (when (eql 0 (%get-byte buf i))
           (return i))))))
@@ -222 +225 @@
            (%stack-block ((buf bufsize))
              (let* ((len (%os-getcwd buf bufsize)))
-               (cond ((< len 0) (%errno-disp len bufsize))
+               (cond ((< len 0) (%errno-disp len))
                      ((< len bufsize)
-                      #+windows-target
-                      (setf (%get-unsigned-word buf (+ len len)) 0)
-                      #-windows-target
-                      (setf (%get-unsigned-byte buf len) 0)
                       (values (get-foreign-namestring buf) len))
                      (t (values nil len)))))))
     (do* ((string nil)
-          (len 64)
+          (len #+windows-target 128 #-windows-target 64)
           (bufsize len len))
          ((multiple-value-setq (string len) (try-getting-dirname bufsize))
@@ -646 +645 @@
       (+ date unix-to-universal-time))))
 
-#-windows-target
 (defun %file-author (namestring)
+  #+windows-target (declare (ignore namestring))
+  #-windows-target
   (let* ((uid (nth-value 5 (%stat namestring))))
     (if uid