Commit ab03a2f3 authored by William Harold Newman's avatar William Harold Newman
Browse files

0.8.7.51: 

	merged Zach Beane's option processing changes patch from
		sbcl-devel
	trivial formatting and comment changes elsewhere
parent 082a5f0f

src/code/primordial-extensions.lisp

+13 −7
Original line number Diff line number Diff line
@@ -168,21 +168,27 @@ 
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)

  (defun symbolicate (&rest things)

    (let ((name (case (length things)

		  ;; why isn't this just the value in the T branch?

		  ;; Why isn't this just the value in the T branch?

		  ;; Well, this is called early in cold-init, before

		  ;; the type system is set up; however, now that we

		  ;; check for bad lengths, the type system is needed

		  ;; for calls to CONCATENATE. So we need to make sure

		  ;; that the calls are transformed away:

		  (1 (concatenate 'string

				  (the simple-base-string (string (car things)))))

				  (the simple-base-string

				    (string (car things)))))

		  (2 (concatenate 'string 

				  (the simple-base-string (string (car things)))

				  (the simple-base-string (string (cadr things)))))

				  (the simple-base-string

				    (string (car things)))

				  (the simple-base-string

				    (string (cadr things)))))

		  (3 (concatenate 'string

				  (the simple-base-string (string (car things)))

				  (the simple-base-string (string (cadr things)))

				  (the simple-base-string (string (caddr things)))))

				  (the simple-base-string

				    (string (car things)))

				  (the simple-base-string

				    (string (cadr things)))

				  (the simple-base-string

				    (string (caddr things)))))

		  (t (apply #'concatenate 'string (mapcar #'string things))))))

    (values (intern name)))))

src/code/toplevel.lisp

+172 −154
Original line number Diff line number Diff line
@@ -323,29 +323,38 @@ 
    ;; FIXME: There are lots of ways for errors to happen around here

    ;; (e.g. bad command line syntax, or READ-ERROR while trying to

    ;; READ an --eval string). Make sure that they're handled

    ;; reasonably. Also, perhaps all errors while parsing the command

    ;; line should cause the system to QUIT, instead of trying to go

    ;; into the Lisp debugger, since trying to go into the debugger

    ;; gets into various annoying issues of where we should go after

    ;; the user tries to return from the debugger.

    ;; reasonably.

    

    ;; Parse command line options.

    ;; Process command line options.

    (flet (;; Errors while processing the command line cause the system

	   ;; to QUIT, instead of trying to go into the Lisp debugger,

	   ;; because trying to go into the Lisp debugger would get

	   ;; into various annoying issues of where we should go after

	   ;; the user tries to return from the debugger.

	   (startup-error (control-string &rest args)

             (format

	      *error-output*

	      "fatal error before reaching READ-EVAL-PRINT loop: ~%  ~?~%"

	      control-string

	      args)

             (quit :unix-status 1)))

      (loop while options do

	    (/show0 "at head of LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")

	    (let ((option (first options)))

	      (flet ((pop-option ()

		       (if options

			   (pop options)

			 (error "unexpected end of command line options"))))

			   (startup-error

			    "unexpected end of command line options"))))

		(cond ((string= option "--sysinit")

		       (pop-option)

		       (if sysinit

			 (error "multiple --sysinit options")

			   (startup-error "multiple --sysinit options")

			   (setf sysinit (pop-option))))

		      ((string= option "--userinit")

		       (pop-option)

		       (if userinit

			 (error "multiple --userinit options")

			   (startup-error "multiple --userinit options")

			   (setf userinit (pop-option))))

		      ((string= option "--eval")

		       (pop-option)
@@ -385,7 +394,8 @@ 
		       ;; "--eval(b)" is an error.)

		       (if (find "--end-toplevel-options" options

				 :test #'string=)

			 (error "bad toplevel option: ~S" (first options))

			   (startup-error "bad toplevel option: ~S"

					  (first options))

			   (return)))))))

      (/show0 "done with LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
@@ -395,28 +405,32 @@ 


      ;; Handle initialization files.

      (/show0 "handling initialization files in TOPLEVEL-INIT")

    (flet (;; If any of POSSIBLE-INIT-FILE-NAMES names a real file,

	   ;; return its truename.

	   (probe-init-files (&rest possible-init-file-names)

      (flet (;; shared idiom for searching for SYSINITish and

	     ;; USERINITish files

             (probe-init-files (explicitly-specified-init-file-name

				&rest default-init-file-names)

               (declare (type list possible-init-file-names))

	     (/show0 "entering PROBE-INIT-FILES")

	     (prog1

	       (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))

                   (find-if (lambda (x)

                              (and (stringp x) (probe-file x)))

			  possible-init-file-names)

	       (/show0 "leaving PROBE-INIT-FILES"))))

      (let* ((sbcl-home (posix-getenv "SBCL_HOME"))

	     (sysinit-truename

                            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))))

        (let ((sysinit-truename

	       (probe-init-files sysinit

				(concatenate 'string sbcl-home "/sbclrc")

				 (init-file-name (posix-getenv "SBCL_HOME")

						 "sbclrc")

				 "/etc/sbclrc"))

	     (user-home (or (posix-getenv "HOME")

			    (error "The HOME environment variable is unbound, ~

				    so user init file can't be found.")))

	     (userinit-truename (probe-init-files userinit

						  (concatenate 'string

							       user-home

							       "/.sbclrc"))))

               (userinit-truename

		(probe-init-files userinit

				  (init-file-name (posix-getenv "HOME")

						  ".sbclrc"))))



          ;; We wrap all the pre-REPL user/system customized startup code 

          ;; in a restart.
@@ -435,7 +449,8 @@ 
                (flet ((process-init-file (truename)

                         (when truename

                           (unless (load truename)

			   (error "~S was not successfully loaded." truename))

                             (error "~S was not successfully loaded."

				    truename))

                           (flush-standard-output-streams))))

                  (process-init-file sysinit-truename)

                  (process-init-file userinit-truename))
@@ -447,13 +462,16 @@ 
                  (let ((expr (with-input-from-string (eval-stream

                                                       expr-as-string)

                                (let* ((eof-marker (cons :eof :eof))

				     (result (read eval-stream nil eof-marker))

                                       (result (read eval-stream

						     nil

						     eof-marker))

                                       (eof (read eval-stream nil eof-marker)))

                                  (cond ((eq result eof-marker)

                                         (error "unable to parse ~S"

                                                expr-as-string))

                                        ((not (eq eof eof-marker))

				       (error "more than one expression in ~S"

                                         (error

					  "more than one expression in ~S"

					  expr-as-string))

                                        (t

                                         result))))))
@@ -477,7 +495,7 @@ 
        (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL-INIT")

        (toplevel-repl noprint)

        ;; (classic CMU CL error message: "You're certainly a clever child.":-)

      (critically-unreachable "after TOPLEVEL-REPL"))))

        (critically-unreachable "after TOPLEVEL-REPL")))))



;;; hooks to support customized toplevels like ACL-style toplevel from

;;; KMR on sbcl-devel 2002-12-21.  Altered by CSR 2003-11-16 for

src/compiler/srctran.lisp

+5 −0
Original line number Diff line number Diff line
@@ -3589,6 +3589,11 @@ 
;;; code has been written from scratch following Chapter 7 of

;;; _Introduction to Algorithms_ by Corman, Rivest, and Shamir.

(define-source-transform sb!impl::sort-vector (vector start end predicate key)

  ;; Like CMU CL, we use HEAPSORT. However, other than that, this code

  ;; isn't really related to the CMU CL code, since instead of trying

  ;; to generalize the CMU CL code to allow START and END values, this

  ;; code has been written from scratch following Chapter 7 of

  ;; _Introduction to Algorithms_ by Corman, Rivest, and Shamir.

  `(macrolet ((%index (x) `(truly-the index ,x))

	      (%parent (i) `(ash ,i -1))

	      (%left (i) `(%index (ash ,i 1)))

version.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -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.8.7.50"
 
"0.8.7.51"