From: William Harold Newman Date: Sun, 10 Dec 2000 22:22:44 +0000 (+0000) Subject: 0.6.9.4: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e8c27392f426b5ebe180fa07b220a9b650a49061;p=sbcl.git 0.6.9.4: MNA software-version patch + Raymond Wiker FreeBSD corrections started fix for bug #17 (loosely based on MNA's patch) by ANSIfying COMPILE-FILE-PATHNAME *DEFAULT-PATHNAME-DEFAULTS* and SEARCH-LIST stuff can be initialized in a toplevel form, so !FILESYS-COLD-INIT can go away. --- diff --git a/NEWS b/NEWS index 2550d3b..c4d0a33 100644 --- a/NEWS +++ b/NEWS @@ -617,6 +617,12 @@ changes in sbcl-0.6.10 relative to sbcl-0.6.9: (If you find any new bugs, please report them!) * More compiler warnings in src/runtime/ are gone, thanks to patches from Martin Atzmueller. +* The compiler no longer uses special file extensions for + byte-compiled code. (The ANSI definition of COMPILE-FILE-PATHNAME + seems to require a single default extension for compiled code, + and there's no compelling reason to try to stretch the standard + to allow two different extensions.) +* #'(SETF DOCUMENTATION) is now defined. planned incompatible changes in 0.7.x: * The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index d694809..e291d4b 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1190,7 +1190,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "!ALIEN-TYPE-COLD-INIT" "!CLASSES-COLD-INIT" "!EARLY-TYPE-COLD-INIT" "!LATE-TYPE-COLD-INIT" "!TARGET-TYPE-COLD-INIT" "!RANDOM-COLD-INIT" - "!FILESYS-COLD-INIT" "!READER-COLD-INIT" + "!READER-COLD-INIT" "STREAM-COLD-INIT-OR-RESET" "!LOADER-COLD-INIT" "!PACKAGE-COLD-INIT" "SIGNAL-COLD-INIT-OR-REINIT" "!SET-SANE-COOKIE-DEFAULTS" "!VM-TYPE-COLD-INIT" diff --git a/src/code/bsd-os.lisp b/src/code/bsd-os.lisp index 0fce3c9..5b0e6fc 100644 --- a/src/code/bsd-os.lisp +++ b/src/code/bsd-os.lisp @@ -18,19 +18,18 @@ #!+FreeBSD "FreeBSD" #!+OpenBSD "OpenBSD")) +(defvar *software-version* nil) + (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL if not available." - #+nil ; won't work until we support RUN-PROGRAM.. - (unless *software-version* - (setf *software-version* - (string-trim '(#\newline) - (with-output-to-string (stream) - (run-program "/usr/bin/uname" - '("-r") - :output stream))))) - nil) + (or *software-version* + (setf *software-version* + (string-trim '(#\newline) + (with-output-to-string (stream) + (sb!ext:run-program "/usr/bin/uname" `("-r") + :output stream)))))) ;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface. ;;; It sets the values of the global port variables to what they diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index 7d607f8..a594191 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -199,7 +199,6 @@ (setf *type-system-initialized* t) (show-and-call os-cold-init-or-reinit) - (show-and-call !filesys-cold-init) (show-and-call stream-cold-init-or-reset) (show-and-call !loader-cold-init) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 744eeaf..f48f9cb 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -979,13 +979,11 @@ (/show0 "filesys.lisp 934") -(defun !filesys-cold-init () - (/show0 "entering !FILESYS-COLD-INIT") - (setf *default-pathname-defaults* - (%make-pathname *unix-host* nil nil nil nil :newest)) - (setf (search-list "default:") (default-directory)) - (/show0 "leaving !FILESYS-COLD-INIT") - nil) +(/show0 "entering what used to be !FILESYS-COLD-INIT") +(defvar *default-pathname-defaults* + (%make-pathname *unix-host* nil nil nil nil :newest)) +(setf (search-list "default:") (default-directory)) +(/show0 "leaving what used to be !FILESYS-COLD-INIT") (defun ensure-directories-exist (pathspec &key verbose (mode #o777)) #!+sb-doc diff --git a/src/code/linux-os.lisp b/src/code/linux-os.lisp index b7a235e..50ae48e 100644 --- a/src/code/linux-os.lisp +++ b/src/code/linux-os.lisp @@ -20,20 +20,18 @@ "Return a string describing the supporting software." (values "Linux")) +(defvar *software-version* nil) + (defun software-version () #!+sb-doc "Return a string describing version of the supporting software, or NIL if not available." - ;; The old CMU CL code is NILed out here. If we wanted to do this, we should - ;; probably either use "/bin/uname -r", but since in any case we don't have - ;; RUN-PROGRAM working right now (sbcl-0.6.4), for now we just punt, - ;; returning NIL. - #+nil - (string-trim '(#\newline) - (with-output-to-string (stream) - (run-program "/usr/cs/etc/version" ; Site dependent??? - nil :output stream))) - nil) + (or *software-version* + (setf *software-version* + (string-trim '(#\newline) + (with-output-to-string (stream) + (sb!ext:run-program "/bin/uname" `("-r") + :output stream)))))) ;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface. ;;; It sets the values of the global port variables to what they diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 2980700..00dd420 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -216,9 +216,6 @@ ;;;; pathname functions -;;; implementation-determined defaults to pathname slots -(defvar *default-pathname-defaults*) - (defun pathname= (pathname1 pathname2) (declare (type pathname pathname1) (type pathname pathname2)) @@ -627,7 +624,9 @@ a host-structure or string." nil))) (defun parse-namestring (thing - &optional host (defaults *default-pathname-defaults*) + &optional + host + (defaults *default-pathname-defaults*) &key (start 0) end junk-allowed) #!+sb-doc "Converts pathname, a pathname designator, into a pathname structure, @@ -712,7 +711,8 @@ a host-structure or string." pathname))))) (defun enough-namestring (pathname - &optional (defaults *default-pathname-defaults*)) + &optional + (defaults *default-pathname-defaults*)) #!+sb-doc "Returns an abbreviated pathname sufficent to identify the pathname relative to the defaults." diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index 1d696f7..0f8c8e6 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -22,17 +22,17 @@ ;; compilation of the target. (let ((package-name "SB-XC")) (make-package package-name :use nil :nicknames nil) - (dolist (name '("*COMPILE-FILE-PATHNAME*" - "*COMPILE-FILE-TRUENAME*" - "*COMPILE-PRINT*" - "*COMPILE-VERBOSE*" - "ARRAY-RANK-LIMIT" + (dolist (name '("ARRAY-RANK-LIMIT" "ARRAY-DIMENSION-LIMIT" "ARRAY-TOTAL-SIZE-LIMIT" "BUILT-IN-CLASS" "CLASS" "CLASS-NAME" "CLASS-OF" "COMPILE-FILE" "COMPILE-FILE-PATHNAME" + "*COMPILE-FILE-PATHNAME*" + "*COMPILE-FILE-TRUENAME*" + "*COMPILE-PRINT*" + "*COMPILE-VERBOSE*" "COMPILER-MACRO-FUNCTION" "CONSTANTP" "DEFCONSTANT" diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 4f90a81..8386703 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1009,9 +1009,9 @@ ;;;; from the "File System Interface" chapter: -;;; No pathname functions are foldable because they all potentially +;;; (No pathname functions are FOLDABLE because they all potentially ;;; depend on *DEFAULT-PATHNAME-DEFAULTS*, e.g. to provide a default -;;; host when parsing a namestring. +;;; host when parsing a namestring.) (defknown wild-pathname-p (pathname-designator &optional diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index b1677cb..6a16a60 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -467,9 +467,10 @@ (and *byte-compile* *byte-compiling*))) ;;; Delete components with no external entry points before we try to -;;; generate code. Unreachable closures can cause IR2 conversion to puke on -;;; itself, since it is the reference to the closure which normally causes the -;;; components to be combined. This doesn't really cover all cases... +;;; generate code. Unreachable closures can cause IR2 conversion to +;;; puke on itself, since it is the reference to the closure which +;;; normally causes the components to be combined. This doesn't really +;;; cover all cases... (defun delete-if-no-entries (component) (dolist (fun (component-lambdas component) (delete-component component)) @@ -1448,9 +1449,9 @@ ;;; out of the compile, then abort the writing of the output file, so ;;; we don't overwrite it with known garbage. (defun sb!xc:compile-file - (source + (input-file &key - (output-file t) ; FIXME: ANSI says this should be a pathname designator. + (output-file (cfp-output-file-default input-file)) ;; FIXME: ANSI doesn't seem to say anything about ;; *COMPILE-VERBOSE* and *COMPILE-PRINT* being rebound by this ;; function.. @@ -1461,9 +1462,9 @@ ((:entry-points *entry-points*) nil) ((:byte-compile *byte-compile*) *byte-compile-default*)) #!+sb-doc - "Compile SOURCE, producing a corresponding FASL file. + "Compile INPUT-FILE, producing a corresponding fasl file. :Output-File - The name of the fasl to output, NIL for none, T for the default. + The name of the fasl to output. :Block-Compile Determines whether multiple functions are compiled together as a unit, resolving function references at compile time. NIL means that global @@ -1486,7 +1487,6 @@ (compile-won nil) (warnings-p nil) (failure-p t) ; T in case error keeps this from being set later - ;; KLUDGE: The listifying and unlistifying in the next calls ;; is to interface to old CMU CL code which accepted and ;; returned lists of multiple source files. It would be @@ -1494,18 +1494,17 @@ ;; VERIFY-SOURCE-FILE, accepting a single source file, and ;; do a similar transformation on MAKE-FILE-SOURCE-INFO too. ;; -- WHN 20000201 - (source (first (verify-source-files (list source)))) - (source-info (make-file-source-info (list source)))) + (input-pathname (first (verify-source-files (list input-file)))) + (source-info (make-file-source-info (list input-pathname)))) (unwind-protect (progn (when output-file (setq output-file-name - (sb!xc:compile-file-pathname source - :output-file output-file - :byte-compile *byte-compile*)) + (sb!xc:compile-file-pathname input-file + :output-file output-file)) (setq fasl-file (open-fasl-file output-file-name - (namestring source) + (namestring input-pathname) (eq *byte-compile* t)))) (when sb!xc:*compile-verbose* @@ -1534,22 +1533,35 @@ warnings-p failure-p))) -(defun sb!xc:compile-file-pathname (file-path - &key (output-file t) byte-compile +;;; a helper function for COMPILE-FILE-PATHNAME: the default for +;;; the OUTPUT-FILE argument +;;; +;;; ANSI: The defaults for the OUTPUT-FILE are taken from the pathname +;;; that results from merging the INPUT-FILE with the value of +;;; *DEFAULT-PATHNAME-DEFAULTS*, except that the type component should +;;; default to the appropriate implementation-defined default type for +;;; compiled files. +(defun cfp-output-file-default (input-file) + (let* ((output-type (make-pathname :type *backend-fasl-file-type*)) + (merge1 (merge-pathnames output-type input-file)) + (merge2 (merge-pathnames merge1 *default-pathname-defaults*))) + merge2)) + +;;; KLUDGE: Part of the ANSI spec for this seems contradictory: +;;; If INPUT-FILE is a logical pathname and OUTPUT-FILE is unsupplied, +;;; the result is a logical pathname. If INPUT-FILE is a logical +;;; pathname, it is translated into a physical pathname as if by +;;; calling TRANSLATE-LOGICAL-PATHNAME. +;;; So I haven't really tried to make this precisely ANSI-compatible +;;; at the level of e.g. whether it returns logical pathname or a +;;; physical pathname. Patches to make it more correct are welcome. +;;; -- WHN 2000-12-09 +(defun sb!xc:compile-file-pathname (input-file + &key + (output-file (cfp-output-file-default + input-file)) &allow-other-keys) #!+sb-doc "Return a pathname describing what file COMPILE-FILE would write to given these arguments." - (declare (values (or null pathname))) - (let ((pathname (pathname file-path))) - (cond ((not (eq output-file t)) - (when output-file - (translate-logical-pathname (pathname output-file)))) - ((and (typep pathname 'logical-pathname) (not (eq byte-compile t))) - (make-pathname :type "FASL" :defaults pathname - :case :common)) - (t - (make-pathname :defaults (translate-logical-pathname pathname) - :type (if (eq byte-compile t) - (backend-byte-fasl-file-type) - *backend-fasl-file-type*)))))) + (pathname output-file)) diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index aa944e4..94b2de8 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -319,12 +319,12 @@ interrupt_handle_now(int signal, siginfo_t *info, void *void_context) * rounding modes are under user control, then perhaps we should * leave this up to the user.) * - * For now we just suppress this code completely (just like the + * In the absence of a test case to show that this is really a + * problem, we just suppress this code completely (just like the * parallel code in maybe_now_maybe_later). * #ifdef __linux__ * SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw); - * #endif - */ + * #endif */ handler = interrupt_handlers[signal]; @@ -405,8 +405,7 @@ maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context) * For now, we just suppress this code completely. * #ifdef __linux__ * SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw); - * #endif - */ + * #endif */ if (SymbolValue(INTERRUPTS_ENABLED) == NIL) { diff --git a/version.lisp-expr b/version.lisp-expr index 95b2291..0370fd3 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.9.3" +"0.6.9.4"