0.9.13.50: Windows baby-steps

  * Less sucky toplevel-init: use PARSE-NATIVE-NAMESTRING to deal with
    user-supplied init-file names, and refactor the logic between Posix
    and Windows.
  * New runtime option: --debug-environment, prints out the command line
    arguments and environment before anything fancy gets done to them.
    Good for debugging startup from Windows shortcuts, etc.
  * Less magic constants, more groveled stuff.
  * SB-WIN32::GET-FOLDER-PATH renamed to SB-WIN32::GET-FOLDER-PATHNAME,
    and it now returns pathnames instead of strings.
  * Add internal function SBCL-HOMEDIR-PATHNAME, and centralize the
    SBCL_HOME stuff there.
  * Still LESS_SHOUTING.
  * Move stuff-groveled-from-headers.lisp earlier in the build-order,
    so toplevel.lisp can use it.
  * No localtime_r and gmtime_r on Windows.

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 9976de7..7e49e54 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -172,6 +172,10 @@
  ("src/code/target-error" :not-host)
 
  ("src/compiler/early-backend")
+ ;; "src/code/toplevel.lisp" si the first to need this. It's generated
+ ;; automatically by grovel_headers.c, i.e. it's not in CVS.
+ ("output/stuff-groveled-from-headers" :not-host)
+
  ;; a comment from classic CMU CL:
  ;;   "These guys can supposedly come in any order, but not really.
  ;;    Some are put at the end so that macros don't run interpreted
@@ -211,10 +215,6 @@
  ("src/code/string"     :not-host)
  ("src/code/mipsstrops" :not-host)
 
- ;; "src/code/unix.lisp" needs this. It's generated automatically by
- ;; grovel_headers.c, i.e. it's not in CVS.
- ("output/stuff-groveled-from-headers" :not-host)
-
  ("src/code/unix" :not-host)
  #!+win32 ("src/code/win32" :not-host)
  #!+mach  ("src/code/mach"     :not-host)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 7ff9268..ac421d6 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -859,6 +859,7 @@ retained, possibly temporariliy, because it might be used internally."
                "MAKE-TRIVIAL-DEFAULT-PATHNAME"
                "PHYSICALIZE-PATHNAME"
                "SANE-DEFAULT-PATHNAME-DEFAULTS"
+               "SBCL-HOMEDIR-PATHNAME"
 
                ;; PCOUNTERs
                "FASTBIG-INCF-PCOUNTER-OR-FIXNUM"

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 273e758..55048db 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -555,21 +555,35 @@
         (simple-file-perror "couldn't delete ~A" namestring err))))
   t)
 \f
+(defun ensure-trailing-slash (string)
+  (let ((last-char (char string (1- (length string)))))
+         (if (or (eql last-char #\/)
+                 #!+win32
+                 (eql last-char #\\))
+             string
+             (concatenate 'string string "/"))))
+
+(defun sbcl-homedir-pathname ()
+  (parse-native-namestring
+   (ensure-trailing-slash (posix-getenv "SBCL_HOME"))))
+
 ;;; (This is an ANSI Common Lisp function.)
 (defun user-homedir-pathname (&optional host)
-  "Return the home directory of the user as a pathname."
+  "Return the home directory of the user as a pathname. If the
+HOME environment variable has be specified, returns the directory
+is designated, otherwise obtains the home directory from the
+operating system."
   (declare (ignore host))
-  #!-win32
-  (pathname (sb!unix:uid-homedir (sb!unix:unix-getuid)))
-  #!+win32
-  (pathname (if (posix-getenv "HOME")
-                (let* ((path (posix-getenv "HOME"))
-                       (last-char (char path (1- (length path)))))
-                  (if (or (char= last-char #\/)
-                          (char= last-char #\\))
-                      path
-                    (concatenate 'string path "/")))
-              (sb!win32::get-folder-path 40)))) ;;SB-WIN32::CSIDL_PROFILE
+  (parse-native-namestring
+   (ensure-trailing-slash
+    (if (posix-getenv "HOME")
+        (posix-getenv "HOME")
+        #!-win32
+        (sb!unix:uid-homedir (sb!unix:unix-getuid))
+        #!+win32
+        ;; Needs to bypass PARSE-NATIVE-NAMESTRING & ENSURE-TRAILING-SLASH
+        (return-from user-homedir-pathname
+          (sb!win32::get-folder-pathname sb!win32::csidl_profile))))))
 
 (defun file-write-date (file)
   #!+sb-doc

diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index d218fd5..ade40b9 100644 (file)
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -474,37 +474,29 @@ steppers to maintain contextual information.")
                                 &rest default-init-file-names)
                (declare (type list default-init-file-names))
                (if explicitly-specified-init-file-name
-                   (or (probe-file explicitly-specified-init-file-name)
-                        (startup-error "The file ~S was not found."
-                                       explicitly-specified-init-file-name))
+                   (or (probe-file
+                        (parse-native-pathname
+                         explicitly-specified-init-file-name))
+                       (startup-error "The file ~S was not found."
+                                      explicitly-specified-init-file-name))
                    (find-if (lambda (x)
-                              (and (stringp x) (probe-file x)))
-                            default-init-file-names)))
-             ;; shared idiom for creating default names for
-             ;; SYSINITish and USERINITish files
-             (init-file-name (maybe-dir-name basename)
-               (and maybe-dir-name
-                    (concatenate 'string maybe-dir-name "/" basename))))
+                              (and (pathnamep x) (probe-file x)))
+                            default-init-file-names))))
         (let ((sysinit-truename
-               #!-win32 (probe-init-files sysinit
-                                          (init-file-name (posix-getenv "SBCL_HOME")
-                                                          "sbclrc")
-                                          "/etc/sbclrc")
-               #!+win32 (probe-init-files sysinit
-                                          (init-file-name (posix-getenv "SBCL_HOME")
-                                                          "sbclrc")
-                                          (concatenate 'string
-                                                       (sb!win32::get-folder-path 35) ;;SB-WIN32::CSIDL_COMMON_APPDATA
-                                                       "\\sbcl\\sbclrc")))
-
-               (userinit-truename
-                #!-win32 (probe-init-files userinit
-                                           (init-file-name (posix-getenv "HOME")
-                                                           ".sbclrc"))
-                #!+win32 (probe-init-files userinit
-                                           (init-file-name (namestring (user-homedir-pathname))
-                                                           ".sbclrc"))))
-
+               (probe-init-files sysinit
+                                 (merge-pathnames (sbcl-homedir-pathname)
+                                                  "sbclrc")
+                                 #!-win32
+                                 "/etc/sbclrc"
+                                 #!+win32
+                                 (merge-pathnames
+                                  (sb!win32::get-folder-pathname
+                                   sb!win32::csidl_common_appdata)
+                                  "\\sbcl\\sbclrc")))
+              (userinit-truename
+               (probe-init-files userinit
+                                 (merge-pathnames (user-homedir-pathname)
+                                                  ".sbclrc"))))
           ;; This CATCH is needed for the debugger command TOPLEVEL to
           ;; work.
           (catch 'toplevel-catcher

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index 65e3d6a..98bc440 100644 (file)
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -402,26 +402,27 @@
             err-code
             (sb!win32::get-last-error-message err-code))))
 
-(defun get-folder-path (CSIDL)
+(defun get-folder-pathname (csidl)
   "http://msdn.microsoft.com/library/en-us/shellcc/platform/shell/reference/functions/shgetfolderpath.asp"
-  (with-alien ((apath (* tchar) (make-alien tchar (1+ MAX_PATH))))
+  (with-alien ((apath (* tchar) (make-alien tchar (1+ max_path))))
     (alien-funcall
      (extern-alien #!-sb-unicode "SHGetFolderPathA@20"
                    #!+sb-unicode "SHGetFolderPathW@20"
                    (function int handle int handle dword (* tchar)))
-     0 CSIDL 0 0 apath)
-    (concatenate 'string (ucs2->string&free apath) "\\")))
+     0 csidl 0 0 apath)
+    (parse-native-namestring
+     (concatenate 'string (ucs2->string&free apath) "\\"))))
 
 (defun sb!unix:posix-getcwd ()
-  (with-alien ((apath (* tchar) (make-alien tchar (1+ MAX_PATH)))
+  (with-alien ((apath (* tchar) (make-alien tchar (1+ max_path)))
                (afunc (function dword dword (* tchar))
                       :extern
                       #!-sb-unicode "GetCurrentDirectoryA@8"
                       #!+sb-unicode "GetCurrentDirectoryW@8"))
-    (let ((ret (alien-funcall afunc (1+ MAX_PATH) apath)))
+    (let ((ret (alien-funcall afunc (1+ max_path) apath)))
       (when (zerop ret)
         (win32-error "GetCurrentDirectory"))
-      (when (> ret (1+ MAX_PATH))
+      (when (> ret (1+ max_path))
         (free-alien apath)
         (setf apath (make-alien tchar ret))
         (alien-funcall afunc ret apath))

diff --git a/src/runtime/globals.h b/src/runtime/globals.h
index 4ffd653..60480a7 100644 (file)
--- a/src/runtime/globals.h
+++ b/src/runtime/globals.h
@@ -24,6 +24,13 @@
 extern int foreign_function_call_active;
 extern boolean stop_the_world;
 
+#ifdef LISP_FEATURE_WIN32
+#define ENVIRON _environ
+#else
+#define ENVIRON environ
+#endif
+extern char **ENVIRON;
+
 #if defined(LISP_FEATURE_SB_THREAD)
 extern pthread_key_t specials;
 #endif

diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c
index 1dba2da..b547453 100644 (file)
--- a/src/runtime/runtime.c
+++ b/src/runtime/runtime.c
@@ -271,6 +271,20 @@ main(int argc, char *argv[], char *envp[])
                 /* As in "--help" case, I think this is expected. */
                 print_version();
                 exit(0);
+           } else if (0 == strcmp(arg, "--debug-environment")) {
+               int n = 0;
+               printf("; Commandline arguments:\n");
+               while (n < argc) {
+                   printf(";  %2d: \"%s\"\n", n, argv[n]);
+                   ++n;
+               }
+               n = 0;
+               printf(";\n; Environment:\n");
+               while (ENVIRON[n]) {
+                   printf(";  %2d: \"%s\"\n", n, ENVIRON[n]);
+                   ++n;
+               }
+               ++argi;
             } else if (0 == strcmp(arg, "--end-runtime-options")) {
                 end_runtime_options = 1;
                 ++argi;

diff --git a/src/runtime/time.c b/src/runtime/time.c
index 402a19f..4b4cf9c 100644 (file)
--- a/src/runtime/time.c
+++ b/src/runtime/time.c
@@ -23,8 +23,17 @@ void get_timezone(time_t when, int *secwest, boolean *dst)
     struct tm ltm, gtm;
     int sw;
 
+#ifdef LISP_FEATURE_WIN32
+    /* No _r versions on Windows, but the API documentation also
+     * doesn't warn them about being non-reentrant... So here's
+     * hoping they actually are -- once Windows grows threads
+     * this better be checked, though. */
+    ltm = *localtime(&when);
+    gtm = *gmtime(&when);
+#else
     ltm = *localtime_r(&when, &ltm);
     gtm = *gmtime_r(&when, &gtm);
+#endif
 
     sw = (((gtm.tm_hour*60)+gtm.tm_min)*60+gtm.tm_sec) - (((ltm.tm_hour*60)+ltm.tm_min)*60+ltm.tm_sec);
     if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday)

diff --git a/version.lisp-expr b/version.lisp-expr
index 55305e2..a7d8a93 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.13.49"
+"0.9.13.50"