"C-STRINGS->STRING-LIST"
;; misc. utilities used internally
- "LEGAL-FUN-NAME-P"
+ "LEGAL-FUN-NAME-P" "LEGAL-FUN-NAME-OR-TYPE-ERROR"
"FUN-NAME-BLOCK-NAME"
"FUN-NAME-INLINE-EXPANSION"
"WHITESPACE-CHAR-P"
*debug-command-level*))
(defparameter *debug-help-string*
-"The prompt is right square brackets, the number indicating how many
- recursive command loops you are in.
-Any command may be uniquely abbreviated.
+"The prompt is square brackets, with number(s) indicating the current control
+ stack level and, if you've entered the debugger recursively, how deeply
+ recursed you are.
+Any command -- including the name of a restart -- may be uniquely abbreviated.
The debugger rebinds various special variables for controlling i/o, sometimes
to defaults (much like WITH-STANDARD-IO-SYNTAX does) and sometimes to
its own special values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*.
-Debug commands do not affect * and friends, but evaluation in the debug loop
- does affect these variables.
+Debug commands do not affect *, //, and similar variables, but evaluation in
+ the debug loop does affect these variables.
SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt
- drop you into deeper into the debugger.
+ drop you deeper into the debugger.
Getting in and out of the debugger:
RESTART invokes restart numbered as shown (prompt if not given).
ERROR prints the error condition and restart cases.
- The name of any restart, or its number, is a valid command, and is the same
- as using RESTART to invoke that restart.
+ The number of any restart, or its name, or a unique abbreviation for its
+ name, is a valid command, and is the same as using RESTART to invoke that
+ restart.
Changing frames:
U up frame D down frame
;;;; the BREAKPOINT-INFO structure
;;; info about a made breakpoint
-(defstruct (breakpoint-info (:copier nil))
+(defstruct (breakpoint-info (:copier nil)
+ (:constructor %make-breakpoint-info))
;; where we are going to stop
- (place (missing-arg) :type (or sb!di:code-location sb!di:debug-fun))
- ;; the breakpoint returned by sb!di:make-breakpoint
- (breakpoint (missing-arg) :type sb!di:breakpoint)
+ (place (missing-arg)
+ :type (or sb!di:code-location sb!di:debug-fun)
+ :read-only t)
+ ;; the breakpoint returned by SB!DI:MAKE-BREAKPOINT
+ (breakpoint (missing-arg) :type sb!di:breakpoint :read-only t)
;; 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
+ (break #'identity :type function :read-only t)
+ ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
;; non-NIL, eval (each) print and print results.
- (condition #'identity :type function)
- ;; the list of functions from sb!di:preprocess-for-eval to evaluate.
- ;; Results are conditionally printed. Car of each element is the
- ;; function, cdr is the form it goes with.
- (print nil :type list)
+ (condition #'identity :type function :read-only t)
+ ;; the list of functions from SB!DI:PREPROCESS-FOR-EVAL to evaluate.
+ ;; Results are conditionally printed. CAR of each element is the
+ ;; function, CDR is the form it goes with.
+ (print nil :type list :read-only t)
;; the number used when listing the possible breakpoints within a
- ;; function. Could also be a symbol such as start or end.
- (code-location-number (missing-arg) :type (or symbol integer))
- ;; the number used when listing the breakpoints active and to delete
- ;; breakpoints
- (breakpoint-number (missing-arg) :type integer))
-
-;;; Return a new BREAKPOINT-INFO structure with the info passed.
-(defun create-breakpoint-info (place breakpoint code-location-number
+ ;; function; or could also be a symbol such as START or END
+ (code-location-selector (missing-arg) :type (or symbol integer) :read-only t)
+ ;; the number used when listing the active breakpoints, and when
+ ;; deleting breakpoints
+ (breakpoint-number (missing-arg) :type integer) :read-only t)
+
+(defun create-breakpoint-info (place breakpoint code-location-selector
&key (break #'identity)
(condition #'identity) (print nil))
(setf *breakpoints*
(first breakpoints)))))
i))))
- (make-breakpoint-info :place place :breakpoint breakpoint
- :code-location-number code-location-number
- :breakpoint-number breakpoint-number
- :break break :condition condition :print print)))
+ (%make-breakpoint-info :place place
+ :breakpoint breakpoint
+ :code-location-selector code-location-selector
+ :breakpoint-number breakpoint-number
+ :break break
+ :condition condition
+ :print print)))
-;;; Print the breakpoint info for the breakpoint-info structure passed.
(defun print-breakpoint-info (breakpoint-info)
(let ((place (breakpoint-info-place breakpoint-info))
- (bp-number (breakpoint-info-breakpoint-number breakpoint-info))
- (loc-number (breakpoint-info-code-location-number breakpoint-info)))
+ (bp-number (breakpoint-info-breakpoint-number breakpoint-info)))
(case (sb!di:breakpoint-kind (breakpoint-info-breakpoint breakpoint-info))
(:code-location
(print-code-location-source-form place 0)
(format t
"~&~S: ~S in ~S"
bp-number
- loc-number
- (sb!di:debug-fun-name (sb!di:code-location-debug-fun
- place))))
+ (breakpoint-info-code-location-selector breakpoint-info)
+ (sb!di:debug-fun-name (sb!di:code-location-debug-fun place))))
(:fun-start
(format t "~&~S: FUN-START in ~S" bp-number
(sb!di:debug-fun-name place)))
(defun %defun (name def doc)
(declare (type function def))
(declare (type (or null simple-string doc)))
- (aver (legal-fun-name-p name))
+ (aver (legal-fun-name-p name)) ; should've been checked by DEFMACRO DEFUN
(when (fboundp name)
(/show0 "redefining NAME in %DEFUN")
(style-warn "redefining ~S in DEFUN" name))
(symbolp (cadr name))
(null (cddr name)))))
+;;; Signal an error unless NAME is a legal function name.
+(defun legal-fun-name-or-type-error (name)
+ (unless (legal-fun-name-p name)
+ (error 'simple-type-error
+ :datum name
+ :expected-type '(or symbol list)
+ :format-control "invalid function name: ~S"
+ :format-arguments (list name))))
+
;;; Given a function name, return the name for the BLOCK which
;;; encloses its body (e.g. in DEFUN, DEFINE-COMPILER-MACRO, or FLET).
(declaim (ftype (function ((or symbol cons)) symbol) fun-name-block-name))
;;; CREATE is non-NIL, create a new (unbound) one.
(defun fdefinition-object (name create)
(declare (values (or fdefn null)))
- (unless (legal-fun-name-p name)
- (error 'simple-type-error
- :datum name
- :expected-type '(or symbol list)
- :format-control "invalid function name: ~S"
- :format-arguments (list name)))
+ (legal-fun-name-or-type-error name)
(let ((fdefn (info :function :definition name)))
(if (and (null fdefn) create)
(setf (info :function :definition name) (make-fdefn name))
\f
;;;; DEFINE-COMPILER-MACRO
-;;; FIXME: The logic here for handling compiler macros named (SETF
-;;; FOO) was added after the fork from SBCL, is not well tested, and
-;;; may conflict with subtleties of the ANSI standard. E.g. section
-;;; "3.2.2.1 Compiler Macros" says that creating a lexical binding for
-;;; a function name shadows a compiler macro, and it's not clear that
-;;; that works with this version. It should be tested.
(defmacro-mundanely define-compiler-macro (name lambda-list &body body)
#!+sb-doc
"Define a compiler-macro for NAME."
+ (legal-fun-name-or-type-error name)
+ (when (consp name)
+ ;; It's fairly clear that the user intends the compiler macro to
+ ;; expand when he does (SETF (FOO ...) X). And that's even a
+ ;; useful and reasonable thing to want. Unfortunately,
+ ;; (SETF (FOO ...) X) macroexpands into (FUNCALL (SETF FOO) X ...),
+ ;; and it's not at all clear that it's valid to expand a FUNCALL form,
+ ;; and the ANSI standard doesn't seem to say anything else which
+ ;; would justify us expanding the compiler macro the way the user
+ ;; wants. So instead we rely on 3.2.2.1.3 "When Compiler Macros Are
+ ;; Used" which says they never have to be used, so by ignoring such
+ ;; macros we're erring on the safe side. But any user who does
+ ;; (DEFINE-COMPILER-MACRO (SETF FOO) ...) could easily be surprised
+ ;; by this way of complying with a rather screwy aspect of the ANSI
+ ;; spec, so at least we can warn him...
+ (compiler-style-warn
+ "defining compiler macro of (SETF ...), which will not be expanded"))
(let ((whole (gensym "WHOLE-"))
(environment (gensym "ENV-")))
(multiple-value-bind (body local-decs doc)
:hash-vector (unless (eq test 'eq)
(make-array size+1
:element-type '(unsigned-byte 32)
+ ;; as explained by pmai on
+ ;; openprojects #lisp IRC
+ ;; 2002-07-30: #x80000000 is
+ ;; bigger than any possible nonEQ
+ ;; hash value, and thus indicates
+ ;; an empty slot; and EQ hash
+ ;; tables don't use
+ ;; HASH-TABLE-HASH-VECTOR
:initial-element #x80000000)))))
(declare (type index size+1 scaled-size length))
;; Set up the free list, all free. These lists are 0 terminated.
(warm-symbol cadr-des))))
(#.sb!vm:other-pointer-lowtag
(warm-symbol des)))))
- (unless (legal-fun-name-p result)
- (error "not a legal function name: ~S" result))
+ (legal-fun-name-or-type-error result)
result))
(defun cold-fdefinition-object (cold-name &optional leave-fn-raw)
(defun sb!xc:compiler-macro-function (name &optional env)
#!+sb-doc
- "If NAME names a compiler-macro, return the expansion function, else
- return NIL. Note: if the name is shadowed in ENV by a local definition,
- or declared NOTINLINE, NIL is returned. Can be set with SETF."
- (let ((found (and env
- (cdr (assoc name (sb!c::lexenv-funs env)
- :test #'equal)))))
- (unless (eq (cond ((sb!c::defined-fun-p found)
- (sb!c::defined-fun-inlinep found))
- (found :notinline)
- (t
- (info :function :inlinep name)))
- :notinline)
- (values (info :function :compiler-macro-function name)))))
-(defun (setf sb!xc:compiler-macro-function) (function name)
+ "If NAME names a compiler-macro in ENV, return the expansion function, else
+ return NIL. Can be set with SETF when ENV is NIL."
+ (legal-fun-name-or-type-error name)
+ ;; Note: CMU CL used to return NIL here when a NOTINLINE declaration
+ ;; was in force. That's fairly logical, given the specified effect
+ ;; of NOTINLINE declarations on compiler-macro expansion. However,
+ ;; (1) it doesn't seem to be consistent with the ANSI spec for
+ ;; COMPILER-MACRO-FUNCTION, and (2) it would give surprising
+ ;; behavior for (SETF (COMPILER-MACRO-FUNCTION FOO) ...) in the
+ ;; presence of a (PROCLAIM '(NOTINLINE FOO)). So we don't do it.
+ (values (info :function :compiler-macro-function name)))
+(defun (setf sb!xc:compiler-macro-function) (function name &optional env)
(declare (type (or symbol list) name)
(type (or function null) function))
+ (when env
+ ;; ANSI says this operation is undefined.
+ (error "can't SETF COMPILER-MACRO-FUNCTION when ENV is non-NIL"))
(when (eq (info :function :kind name) :special-form)
(error "~S names a special form." name))
(setf (info :function :compiler-macro-function name) function)
(when (null (find-uses cont))
(setf (continuation-asserted-type cont) new))
(when (and (not intersects)
+ ;; FIXME: Is it really right to look at *LEXENV* here,
+ ;; instead of looking at the LEXENV argument? Why?
(not (policy *lexenv*
(= inhibit-warnings 3)))) ;FIXME: really OK to suppress?
(compiler-warn
(values))
;;; Convert anything that looks like a special form, global function
-;;; or macro call.
+;;; or compiler-macro call.
(defun ir1-convert-global-functoid (start cont form)
(declare (type continuation start cont) (list form))
- (let* ((fun (first form))
- (translator (info :function :ir1-convert fun))
- (cmacro (info :function :compiler-macro-function fun)))
- (cond (translator (funcall translator start cont form))
- ((and cmacro
- (not (eq (info :function :inlinep fun)
- :notinline)))
- (let ((res (careful-expand-macro cmacro form)))
+ (let* ((fun-name (first form))
+ (translator (info :function :ir1-convert fun-name))
+ (cmacro-fun (sb!xc:compiler-macro-function fun-name *lexenv*)))
+ (cond (translator
+ (when cmacro-fun
+ (compiler-warn "ignoring compiler macro for special form"))
+ (funcall translator start cont form))
+ ((and cmacro-fun
+ ;; gotcha: If you look up the DEFINE-COMPILER-MACRO
+ ;; macro in the ANSI spec, you might think that
+ ;; suppressing compiler-macro expansion when NOTINLINE
+ ;; is some pre-ANSI hack. However, if you look up the
+ ;; NOTINLINE declaration, you'll find that ANSI
+ ;; requires this behavior after all.
+ (not (eq (info :function :inlinep fun-name) :notinline)))
+ (let ((res (careful-expand-macro cmacro-fun form)))
(if (eq res form)
- (ir1-convert-global-functoid-no-cmacro start cont form fun)
+ (ir1-convert-global-functoid-no-cmacro
+ start cont form fun-name)
(ir1-convert start cont res))))
(t
- (ir1-convert-global-functoid-no-cmacro start cont form fun)))))
+ (ir1-convert-global-functoid-no-cmacro start cont form fun-name)))))
;;; Handle the case of where the call was not a compiler macro, or was
;;; a compiler macro and passed.
:source-name source-name
:debug-name debug-name))))
-;;; Get a DEFINED-FUN object for a function we are about to
-;;; define. If the function has been forward referenced, then
-;;; substitute for the previous references.
+;;; Get a DEFINED-FUN object for a function we are about to define. If
+;;; the function has been forward referenced, then substitute for the
+;;; previous references.
(defun get-defined-fun (name)
(proclaim-as-fun-name name)
(let ((found (find-free-fun name "shouldn't happen! (defined-fun)")))
;; nice default for things where we don't have a
;; real source path (as in e.g. inside CL:COMPILE).
'(original-source-start 0 0)))
- (unless (or (null name) (legal-fun-name-p name))
- (error "not a legal function name: ~S" name))
+ (when name
+ (legal-fun-name-or-type-error name))
(let* ((*lexenv* (make-lexenv :policy *policy*))
(fun (make-functional-from-toplevel-lambda lambda-expression
:name name
(defun process-toplevel-cold-fset (name lambda-expression path)
(unless (producing-fasl-file)
(error "can't COLD-FSET except in a fasl file"))
- (unless (legal-fun-name-p name)
- (error "not a legal function name: ~S" name))
+ (legal-fun-name-or-type-error name)
(fasl-dump-cold-fset name
(%compile lambda-expression
*compile-object*
;;; Break a lambda list into its component parts. We return eleven
;;; values:
;;; 1. a list of the required args;
-;;; 2. a list of the optional arg specs;
-;;; 3. true if a rest arg was specified;
-;;; 4. the &rest arg;
+;;; 2. a list of the &OPTIONAL arg specs;
+;;; 3. true if a &REST arg was specified;
+;;; 4. the &REST arg;
;;; 5. true if &KEY args are present;
;;; 6. a list of the &KEY arg specs;
;;; 7. true if &ALLOW-OTHER-KEYS was specified.;
\f
(defmacro defgeneric (fun-name lambda-list &body options)
(declare (type list lambda-list))
- (unless (legal-fun-name-p fun-name)
- (error 'simple-program-error
- :format-control "illegal generic function name ~S"
- :format-arguments (list fun-name)))
+ (legal-fun-name-or-type-error fun-name)
(let ((initargs ())
(methods ()))
(flet ((duplicate-option (name)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.6.19"
+"0.7.6.20"
projects / sbcl.git / commitdiff