96:
The TRACE facility can't be used on some kinds of functions.
- Basically, the breakpoint facility wasn incompletely implemented
- in the X86 port of CMU CL, and we haven't fixed it in SBCL.
-
-97:
- FRESH-LINE doesn't seem to work properly within pretty-printed
- output. E.g.
- "~@<unhandled CONDITION (of type ~S): ~2I~_~A~:>~2%"
- called on a CONDITION whose printer does
- "~&~@<error in function ~S: ~3I~:_~?~:>"
- gives two newlines between "unhandled CONDITION" and "error", when
- (it at least seems as though) correct behavior would be to give one.
+ (Basically, the breakpoint facility was incompletely implemented
+ in the X86 port of CMU CL, and hasn't been fixed in SBCL.)
+
+98:
+ In sbcl-0.6.11.41 (and in all earlier SBCL, and in CMU
+ CL), out-of-line structure slot setters are horribly inefficient
+ whenever the type of the slot is declared, because out-of-line
+ structure slot setters are implemented as closures to save space,
+ so the compiler doesn't compile the type test into code, but
+ instead just saves the type in a lexical closure and interprets it
+ at runtime.
+ A proper solution involves deciding whether it's really worth
+ saving space by implementing structure slot accessors as closures.
+ (If it's not worth it, the problem vanishes automatically. If it
+ is worth it, there are hacks we could use to force type tests to
+ be compiled anyway, and even shared. E.g. we could implement
+ an EQUAL hash table mapping from types to compiled type tests,
+ and save the appropriate compiled type test as part of each lexical
+ closure; or we could make the lexical closures be placeholders
+ which overwrite their old definition as a lexical closure with
+ a new compiled definition the first time that they're called.)
+ As a workaround for the problem, #'(SETF FOO) expressions can
+ be replaced with (EFFICIENT-SETF-FUNCTION FOO), where
+(defmacro efficient-setf-function (place-function-name)
+ (or #+sbcl (and (sb-impl::info :function :accessor-for place-function-name)
+ ;; a workaround for the problem, encouraging the
+ ;; inline expansion of the structure accessor, so
+ ;; that the compiler can optimize its type test
+ (let ((new-value (gensym "NEW-VALUE-"))
+ (structure-value (gensym "STRUCTURE-VALUE-")))
+ `(lambda (,new-value ,structure-value)
+ (setf (,place-function-name ,structure-value)
+ ,new-value))))
+ ;; no problem, can just use the ordinary expansion
+ `(function (setf ,place-function-name))))
+
+99:
+ DESCRIBE interacts poorly with *PRINT-CIRCLE*, e.g. the output from
+ (let ((*print-circle* t)) (describe (make-hash-table)))
+ is weird. (This is likely a pretty-printer problem which happens to
+ be exercised by DESCRIBE, not actually a DESCRIBE problem.)
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
when it gets in trouble (by printing a debug prompt on *DEBUG-IO*).
However, this is not useful behavior for a system running with no
programmer available, and this option tries to set up more appropriate
-behavior for that situation. Thus we set *DEBUG-IO* to send its output
-to *ERROR-OUTPUT*, and to raise an error if any input is requested
-from it, and we set *DEBUGGER-HOOK* to output a backtrace, then exit
-the process with a failure code.
+behavior for that situation. Thus we set *DEBUG-IO* to send its
+output to *ERROR-OUTPUT*, and to raise an error if any input is
+requested from it; and we set *DEBUGGER-HOOK* to output a backtrace,
+then exit the process with a failure code.
.PP
Regardless of the order in which --sysinit, --userinit, and --eval
"TYPE-BOUND-NUMBER"
"CONSTANTLY-T" "CONSTANTLY-NIL" "CONSTANTLY-0"
"PSXHASH"
+ "%BREAK"
;; ..and macros..
"COLLECT"
(invoke-debugger condition)))))
nil)
-(defun break (&optional (datum "break") &rest arguments)
- #!+sb-doc
- "Print a message and invoke the debugger without allowing any possibility
- of condition handling occurring."
+;;; like BREAK, but without rebinding *DEBUGGER-HOOK* to NIL, so that
+;;; we can use it in system code (e.g. in SIGINT handling) without
+;;; messing up --noprogrammer mode (which works by setting
+;;; *DEBUGGER-HOOK*)
+(defun %break (what &optional (datum "break") &rest arguments)
+ ;; FIXME: Do we really want INFINITE-ERROR-PROTECT in BREAKish stuff?
(sb!kernel:infinite-error-protect
- (with-simple-restart (continue "Return from BREAK.")
+ (with-simple-restart (continue "Return from ~S." what)
(let ((sb!debug:*stack-top-hint* (maybe-find-stack-top-hint)))
(invoke-debugger
- (coerce-to-condition datum arguments 'simple-condition 'break)))))
+ (coerce-to-condition datum arguments 'simple-condition what)))))
nil)
+(defun break (&optional (datum "break") &rest arguments)
+ #!+sb-doc
+ "Print a message and invoke the debugger without allowing any possibility
+ of condition handling occurring."
+ (let ((*debugger-hook* nil)) ; as specifically required by ANSI
+ (apply #'%break 'break datum arguments)))
+
(defun warn (datum &rest arguments)
#!+sb-doc
"Warn about a situation by signalling a condition formed by DATUM and
:type (or sb!di:code-location sb!di:debug-function))
;; the breakpoint returned by sb!di:make-breakpoint
(breakpoint (required-argument) :type sb!di:breakpoint)
- ;; the function returned from sb!di:preprocess-for-eval. If result is
+ ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
;; non-NIL, drop into the debugger.
(break #'identity :type function)
;; the function returned from sb!di:preprocess-for-eval. If result is
;;; Setting this variable causes execution of a FOP-NOP4 to produce
;;; output to *DEBUG-IO*. This can be handy when trying to follow the
-;;; progress of FASLOAD.
+;;; progress of FASL loading.
#!+sb-show
(defvar *show-fop-nop4-p* nil)
;;; (1) *LOAD-SYMBOL-BUFFER-SIZE* is redundant, should just be
;;; (LENGTH *LOAD-SYMBOL-BUFFER*).
;;; (2) *LOAD-SYMBOL-BUFFER* should not have a global value, but should
-;;; be bound on entry to FASLOAD, and it should be renamed to
-;;; *FASLOAD-SYMBOL-BUFFER*.
+;;; be bound on entry to FASL loading, and it should be renamed to
+;;; *FASL-SYMBOL-BUFFER*.
(macrolet (;; FIXME: Should all this code really be duplicated inside
;; each fop? Perhaps it would be better for this shared
;; (load-fresh-line)
;; (prin1 result)
;; (terpri))
- ;; Unfortunately, this dependence on the *LOAD-PRINT* global variable is
- ;; non-ANSI, so for now we've just punted printing in fasload.
+ ;; Unfortunately, this dependence on the *LOAD-PRINT* global
+ ;; variable is non-ANSI, so for now we've just punted printing in
+ ;; fasl loading.
result))
(define-fop (fop-eval-for-effect 54 nil)
;;; fasl file format, the value should not be "FASL FILE", which
;;; is what CMU CL used for the same purpose.
;;; * Since its presence at the head of a file is used by LOAD to
-;;; decide whether a file is to be fasloaded or sloloaded, the value
-;;; should be something which can't legally appear at the head of a
-;;; Lisp source file.
+;;; decide whether a file is to be fasloaded or just loaded
+;;; ordinarily (as source), the value should be something which
+;;; can't legally appear at the head of a Lisp source file.
;;; * The value should not contain any line-terminating characters,
;;; because they're hard to express portably and because the LOAD
;;; code might reasonably use READ-LINE to get the value to compare
(prog1
(fast-read-u-integer ,n)
(done-with-fast-read-byte)))))
+
;;; FIXME: This deserves a more descriptive name, and should probably
;;; be implemented as an ordinary function, not a macro.
;;;
;;; offset. We may need to have several, since LOAD can be called
;;; recursively.
-(defvar *free-fop-tables* (list (make-array 1000))
- #!+sb-doc
- "List of free fop tables for the fasloader.")
+;;; a list of free fop tables for the fasloader
+;;;
+;;; FIXME: Is it really a win to have this permanently bound?
+;;; Couldn't we just bind it on entry to LOAD-AS-FASL?
+(defvar *free-fop-tables* (list (make-array 1000)))
;;; the current fop table
(defvar *current-fop-table*)
(progn ,@forms)
(setq *fop-stack-pointer* ,n-index)))))))
\f
-;;;; FASLOAD
+;;;; LOAD-AS-FASL
;;;;
-;;;; Note: FASLOAD is used not only by LOAD, but also (after suitable
-;;;; modification of the fop table) in genesis. Therefore, it's needed
-;;;; not only in the target Lisp, but also in the cross-compilation
-;;;; host.
+;;;; Note: LOAD-AS-FASL is used not only by LOAD, but also (with
+;;;; suitable modification of the fop table) in GENESIS. Therefore,
+;;;; it's needed not only in the target Lisp, but also in the
+;;;; cross-compilation host.
;;; a helper function for LOAD-FASL-GROUP
;;;
#!+sb-show
(defvar *show-fops-p* nil)
-;;; a helper function for FASLOAD
+;;; a helper function for LOAD-AS-FASL
;;;
-;;; Return true if we successfully load a group from the stream, or NIL if EOF
-;;; was encountered while trying to read from the stream. Dispatch to the right
-;;; function for each fop. Special-case FOP-BYTE-PUSH since it is real common.
+;;; Return true if we successfully load a group from the stream, or
+;;; NIL if EOF was encountered while trying to read from the stream.
+;;; Dispatch to the right function for each fop. Special-case
+;;; FOP-BYTE-PUSH since it is real common.
(defun load-fasl-group (stream)
(when (check-fasl-header stream)
(catch 'fasl-group-end
(svref *current-fop-table* (read-byte stream))))
(funcall (the function (svref *fop-functions* byte))))))))))
-(defun fasload (stream verbose print)
+(defun load-as-fasl (stream verbose print)
;; KLUDGE: ANSI says it's good to do something with the :PRINT
;; argument to LOAD when we're fasloading a file, but currently we
;; don't. (CMU CL did, but implemented it in a non-ANSI way, and I
(declaim (type (or pathname null) *load-truename* *load-pathname*))
\f
-;;;; SLOLOAD
+;;;; LOAD-AS-SOURCE
;;; Load a text file.
-(defun sloload (stream verbose print)
+(defun load-as-source (stream verbose print)
(do-load-verbose stream verbose)
(do ((sexpr (read stream nil *eof-object*)
(read stream nil *eof-object*)))
(with-open-file (stream truename
:direction :input
:if-does-not-exist if-does-not-exist)
- (sloload stream verbose print)))
+ (load-as-source stream verbose print)))
(:binary
(with-open-file (stream truename
:direction :input
:if-does-not-exist if-does-not-exist
:element-type '(unsigned-byte 8))
- (fasload stream verbose print)))
+ (load-as-fasl stream verbose print)))
(t
(let ((first-line (with-open-file (stream truename :direction :input)
(read-line stream nil)))
;; *PACKAGE* to the values they held before loading the file."
(*package* (sane-package))
(*readtable* *readtable*)
- ;; The old CMU CL LOAD function used an IF-DOES-NOT-EXIST argument of
- ;; (MEMBER :ERROR NIL) type. ANSI constrains us to accept a generalized
- ;; boolean argument value for this externally-visible function, but the
- ;; internal functions still use the old convention.
+ ;; The old CMU CL LOAD function used an IF-DOES-NOT-EXIST
+ ;; argument of (MEMBER :ERROR NIL) type. ANSI constrains us to
+ ;; accept a generalized boolean argument value for this
+ ;; externally-visible function, but the internal functions
+ ;; still use the old convention.
(internal-if-does-not-exist (if if-does-not-exist :error nil)))
- ;; FIXME: This VALUES wrapper is inherited from CMU CL.
- ;; Once SBCL gets function return type checking right, we can
- ;; achieve a similar effect better by adding FTYPE declarations.
+ ;; FIXME: This VALUES wrapper is inherited from CMU CL. Once SBCL
+ ;; gets function return type checking right, we can achieve a
+ ;; similar effect better by adding FTYPE declarations.
(values
(if (streamp filespec)
(if (or (equal (stream-element-type filespec)
'(unsigned-byte 8)))
- (fasload filespec verbose print)
- (sloload filespec verbose print))
+ (load-as-fasl filespec verbose print)
+ (load-as-source filespec verbose print))
(let ((pn (merge-pathnames (pathname filespec)
*default-pathname-defaults*)))
(if (wild-pathname-p pn)
(dolist (symbol *!initial-foreign-symbols*)
(setf (gethash (car symbol) *static-foreign-symbols*) (cdr symbol))))
-(declaim (ftype (function (string) sb!vm:word) foreign-symbol-address-as-integer))
+(declaim (ftype (function (string) sb!vm:word)
+ foreign-symbol-address-as-integer))
(defun foreign-symbol-address-as-integer (foreign-symbol)
(or (gethash foreign-symbol *static-foreign-symbols*)
(gethash (concatenate 'simple-string
(error "unknown foreign symbol: ~S" foreign-symbol)))
(defun foreign-symbol-address (symbol)
- (int-sap (foreign-symbol-address-as-integer (sb!vm:extern-alien-name symbol))))
+ (int-sap (foreign-symbol-address-as-integer
+ (sb!vm:extern-alien-name symbol))))
\f
;;;; C routines that actually do all the work of establishing signal handlers
(sb!alien:def-alien-routine ("install_handler" install-handler)
- sb!c-call:unsigned-long
+ sb!c-call:unsigned-long
(signal sb!c-call:int)
(handler sb!c-call:unsigned-long))
\f
;;;;
;;;; Most of these just call ERROR to report the presence of the signal.
+;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores
+;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that
+;;; SIGINT in --noprogrammer mode will cleanly terminate the system
+;;; (by respecting the *DEBUGGER-HOOK* established in that mode).
+(defun sigint-%break (format-string &rest format-arguments)
+ (apply #'%break 'sigint format-string format-arguments))
+
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro define-signal-handler (name
what
(with-alien ((context (* os-context-t) context))
(sap-int (sb!vm:context-pc context)))))))
-(define-signal-handler sigint-handler "interrupted" break)
+(define-signal-handler sigint-handler "interrupted" sigint-%break)
(define-signal-handler sigill-handler "illegal instruction")
(define-signal-handler sigtrap-handler "breakpoint/trap")
(define-signal-handler sigiot-handler "SIGIOT")
(enable-interrupt :sigsys #'sigsys-handler)
(enable-interrupt :sigpipe #'sigpipe-handler)
(enable-interrupt :sigalrm #'sigalrm-handler)
- nil)
+ (values))
\f
;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
#|
(quit :unix-status 1 :recklessly-p recklessly-p)))
;; This HANDLER-CASE is here mostly to stop output immediately
;; (and fall through to QUIT) when there's an I/O error. Thus,
- ;; when we're run under a Perl script or something, we can die
+ ;; when we're run under a shell script or something, we can die
;; cleanly when the script dies (and our pipes are cut), instead
;; of falling into ldb or something messy like that.
(handler-case
;; (Where to truncate the BACKTRACE is of course arbitrary, but
;; it seems as though we should at least truncate it somewhere.)
(sb!debug:backtrace 128 *error-output*)
- (finish-output *error-output*)
(format *error-output*
"~%unhandled condition in --noprogrammer mode, quitting~%")
+ (finish-output *error-output*)
(failure-quit))
(condition ()
- (%primitive print "Argh! error within --noprogrammer error handling")
+ ;; We IGNORE-ERRORS here because even %PRIMITIVE PRINT can
+ ;; fail when our output streams are blown away, as e.g. when
+ ;; we're running under a Unix shell script and it dies somehow
+ ;; (e.g. because of a SIGINT). In that case, we might as well
+ ;; just give it up for a bad job, and stop trying to notify
+ ;; the user of anything.
+ ;;
+ ;; Actually, the only way I've run across to exercise the
+ ;; problem is to have more than one layer of shell script.
+ ;; I have a shell script which does
+ ;; time nice -10 sh make.sh "$1" 2>&1 | tee make.tmp
+ ;; and the problem occurs when I interrupt this with Ctrl-C
+ ;; under Linux 2.2.14-5.0 and GNU bash, version 1.14.7(1).
+ ;; I haven't figured out whether it's bash, time, tee, Linux, or
+ ;; what that is responsible, but that it's possible at all
+ ;; means that we should IGNORE-ERRORS here. -- WHN 2001-04-24
+ (ignore-errors
+ (%primitive print "Argh! error within --noprogrammer error handling"))
(failure-quit :recklessly-p t)))))
\f
;;; a convenient way to get into the assembly-level debugger
;;; Setting this variable to an (UNSIGNED-BYTE 32) value causes
;;; DUMP-FOP to use it as a counter and emit a FOP-NOP4 with the
;;; counter value before every ordinary fop. This can make it easier
-;;; to follow the progress of FASLOAD when
+;;; to follow the progress of LOAD-AS-FASL when
;;; debugging/testing/experimenting.
#!+sb-show (defvar *fop-nop4-count* nil)
#!+sb-show (declaim (type (or (unsigned-byte 32) null) *fop-nop4-count*))
(internal-apply res nil '#()))
(internal-apply res nil '#()))))
-;;; Later this will probably be the same weird internal thing the compiler
-;;; makes to represent these things.
-(defun make-indirect-value-cell (value)
- (list value))
-;;; FIXME: used only in this file, needn't be in runtime
-(defmacro indirect-value (value-cell)
- `(car ,value-cell))
-
;;; This passes on a node's value appropriately, possibly returning from
;;; function to do so. When we are tail-p, don't push the value, return it on
;;; the system's actual call stack; when we blow out of function this way, we
(cond ((sb!c::leaf-refs var)
(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
(if (sb!c::lambda-var-indirect var)
- (make-indirect-value-cell (pop args))
+ (sb!c::make-value-cell (pop args))
(pop args))))
(ignore-unused (pop args)))))
(internal-apply-loop (sb!c::lambda-bind lambda) frame-ptr lambda args
(let ((env (sb!c::node-environment node)))
(cond ((not (eq (sb!c::lambda-environment (sb!c::lambda-var-home var))
env))
- (setf (indirect-value
- (svref closure
- (position var (sb!c::environment-closure env)
- :test #'eq)))
- value))
+ (sb!c::value-cell-set
+ (svref closure
+ (position var (sb!c::environment-closure env)
+ :test #'eq))
+ value))
((sb!c::lambda-var-indirect var)
- (setf (indirect-value
- (eval-stack-local frame-ptr (sb!c::lambda-var-info var)))
- value))
+ (sb!c::value-cell-set
+ (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
+ value))
(t
(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info var))
value))))))
(position leaf (sb!c::environment-closure env)
:test #'eq)))))
(if (sb!c::lambda-var-indirect leaf)
- (indirect-value temp)
+ (sb!c::value-cell-ref temp)
temp)))
;;; Compute a closure for a local call and for returned call'able
(when (sb!c::leaf-refs v)
(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
(if (sb!c::lambda-var-indirect v)
- (make-indirect-value-cell (pop args))
+ (sb!c::make-value-cell (pop args))
(pop args)))))))
;;; This is similar to STORE-LET-VARS, but the values for the locals
(if (sb!c::leaf-refs v)
(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
(if (sb!c::lambda-var-indirect v)
- (make-indirect-value-cell (pop args))
+ (sb!c::make-value-cell (pop args))
(pop args)))
(pop args)))))
(when (sb!c::leaf-refs v)
(setf (eval-stack-local frame-ptr (sb!c::lambda-var-info v))
(if (sb!c::lambda-var-indirect v)
- (make-indirect-value-cell (car remaining-args))
+ (sb!c::make-value-cell (car remaining-args))
(car remaining-args))))
(cdr remaining-args))
args))
(error "The fop ~S is not supported in cold load." ',name)))
;;; COLD-LOAD loads stuff into the core image being built by calling
-;;; FASLOAD with the fop function table rebound to a table of cold
+;;; LOAD-AS-FASL with the fop function table rebound to a table of cold
;;; loading functions.
(defun cold-load (filename)
#!+sb-doc
(string filename)
(pathname (namestring filename)))))
(with-open-file (s filename :element-type '(unsigned-byte 8))
- (fasload s nil nil))))
+ (load-as-fasl s nil nil))))
\f
;;;; miscellaneous cold fops
;;; 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.11.41"
+"0.6.11.42"
projects / sbcl.git / commitdiff