X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fcommon-os.lisp;h=66ef963db051894426672468a468a7cb149e8286;hb=5b6e02e435453eddace1a36d30aaf04d6ebd2f1d;hp=bf7174477bf001e90a7516348eaa720dad8a82d1;hpb=3257c25015012253a096c990d5809daee974d057;p=sbcl.git

diff --git a/src/code/common-os.lisp b/src/code/common-os.lisp
index bf71744..66ef963 100644
--- a/src/code/common-os.lisp
+++ b/src/code/common-os.lisp
@@ -20,34 +20,55 @@
 (sb!alien:define-alien-variable
  ("saved_runtime_path" *native-saved-runtime-path*) (* char))
 
-;;; if something ever needs to be done differently for one OS, then
+(defmacro init-var-ignoring-errors (variable
+                                    form
+                                    &key default
+                                         explanation
+                                         (condition 'error))
+  `(setf ,variable
+         (handler-case ,form
+           (,condition (c)
+             (let ((default ,default))
+               (warn "Error initializing ~a~@[ ~a~]:~@
+             ~a
+             ~% Using ~s instead."
+                     ',variable
+                     ,explanation
+                     c
+                     default)
+               default)))))
+
+;;; If something ever needs to be done differently for one OS, then
 ;;; split out the different part into per-os functions.
 (defun os-cold-init-or-reinit ()
   (/show0 "setting *CORE-STRING*")
-  (setf *core-string*
-        (sb!alien:cast *native-core-string* sb!alien:c-string))
+  (init-var-ignoring-errors
+   *core-string*
+   (sb!alien:cast *native-core-string* sb!alien:c-string)
+   :default "")
   (/show0 "setting *POSIX-ARGV*")
-  (setf sb!ext:*posix-argv*
-        (loop for i from 0
-              for arg = (sb!alien:deref *native-posix-argv* i)
-              until (sb!alien:null-alien arg)
-              collect (sb!alien:cast arg sb!alien:c-string)))
+  (init-var-ignoring-errors
+   sb!ext:*posix-argv*
+   (loop for i from 0
+         for arg = (sb!alien:deref *native-posix-argv* i)
+         until (sb!alien:null-alien arg)
+         collect (sb!alien:cast arg sb!alien:c-string)))
   (/show0 "entering OS-COLD-INIT-OR-REINIT")
   (setf *software-version* nil)
   (/show0 "setting *DEFAULT-PATHNAME-DEFAULTS*")
-  (setf *default-pathname-defaults*
-        ;; (temporary value, so that #'NATIVE-PATHNAME won't blow up when
-        ;; we call it below:)
-        (make-trivial-default-pathname)
-        *default-pathname-defaults*
-        ;; (final value, constructed using #'NATIVE-PATHNAME:)
-        (native-pathname (sb!unix:posix-getcwd/)))
+  ;; Temporary value, so that #'NATIVE-PATHNAME won't blow up when
+  ;; we call it below
+  (setf *default-pathname-defaults* (make-trivial-default-pathname))
+  (init-var-ignoring-errors
+   *default-pathname-defaults* (native-pathname (sb!unix:posix-getcwd/))
+   :default (make-trivial-default-pathname)
+   :explanation "with the current directory")
   (/show0 "setting *CORE-PATHNAME*")
-  (setf *core-pathname*
-        (merge-pathnames (native-pathname *core-string*)))
+  (setf *core-pathname* (merge-pathnames (native-pathname *core-string*)))
   (/show0 "setting *RUNTIME-PATHNAME*")
-  (let ((exe (os-get-runtime-executable-path t))
-        (saved (sb!alien:cast *native-saved-runtime-path* sb!alien:c-string)))
-    (setf *runtime-pathname*
-          (when (or exe saved) (native-pathname (or exe saved)))))
+  (init-var-ignoring-errors
+   *runtime-pathname*
+   (let ((exe (os-get-runtime-executable-path t))
+         (saved (sb!alien:cast *native-saved-runtime-path* sb!alien:c-string)))
+     (when (or exe saved) (native-pathname (or exe saved)))))
   (/show0 "leaving OS-COLD-INIT-OR-REINIT"))