SANE-PACKAGE now issues TYPE-ERROR, not just vanilla ERROR.
removed *COMPILE-TIME-DEFINE-MACROS*
added DTC comments clarifying that "MNA: dump-circular hack"
is a suboptimal solution
added underlying MNA typecase-implicit-declarations problem
to the BUGS list as bug #62
finished reviewing MNA megapatch (but haven't removed
rejected open-coded-simple-array-patch yet)
then requesting a BACKTRACE at the debugger prompt gives no information
about where in the user program the problem occurred.
+62:
+ The compiler is supposed to do type inference well enough that
+ the declaration in
+ (TYPECASE X
+ ((SIMPLE-ARRAY SINGLE-FLOAT)
+ (LOCALLY
+ (DECLARE (TYPE (SIMPLE-ARRAY SINGLE-FLOAT) X))
+ ..))
+ ..)
+ is redundant. However, it doesn't. As a quick fix to work around
+ the problem, sbcl-0.6.8.10 was patched to automatically add the
+ appropriate declarations in the macroexpansion of TYPECASE and
+ related macros (thanks to Martin Atzmueller porting Juan Jose
+ Garcia Ripoll's CMU CL patch). But the underlying compiler problem
+ really should be fixed instead, and at that time the workarounds
+ in the TYPECASE-ish expansions should be removed.
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
"*BACKEND-T-PRIMITIVE-TYPE*"
"*CODE-SEGMENT*"
- "*COMPILE-TIME-DEFINE-MACROS*"
"*COMPILING-FOR-INTERPRETER*" "*CONVERTING-FOR-INTERPRETER*"
"*COUNT-VOP-USAGES*" "*ELSEWHERE*"
"*FASL-HEADER-STRING-START-STRING*"
"ASSQ" "DELQ" "MEMQ"
"%FIND-PACKAGE-OR-LOSE" "FIND-UNDELETED-PACKAGE-OR-LOSE"
"SANE-PACKAGE"
+ "CIRCULAR-LIST-P"
;; ..and macros
"COLLECT"
;;; Return two values:
;;; MNA: fix-instance-typep-call patch
;;; 1. A list of all the positional (fixed and optional) types.
-;;; 2] The rest type (if any). If keywords allowed, *universal-type*.
-;;; If no keywords or rest then the default-type.
+;;; 2. The &REST type (if any). If keywords allowed, *UNIVERSAL-TYPE*.
+;;; If no keywords or &REST, then the DEFAULT-TYPE.
(defun values-type-types (type &optional (default-type *empty-type*))
(declare (type values-type type))
(values (append (args-type-required type)
\f
;;;; opening and closing fasl files
-;;; Open a fasl file, write its header, and return a FASL-FILE object for
-;;; dumping to it. Some human-readable information about the source code is
-;;; given by the string WHERE. If BYTE-P is true, this file will contain no
-;;; native code, and is thus largely implementation independent.
+;;; Open a fasl file, write its header, and return a FASL-FILE object
+;;; for dumping to it. Some human-readable information about the
+;;; source code is given by the string WHERE. If BYTE-P is true, this
+;;; file will contain no native code, and is thus largely
+;;; implementation independent.
(defun open-fasl-file (name where &optional byte-p)
(declare (type pathname name))
(let* ((stream (open name
;; semi-human-readable) string which is used to identify fasl files.
(write-string sb!c:*fasl-header-string-start-string* stream)
- ;; The constant string which begins the header is followed by arbitrary
- ;; human-readable text, terminated by a special character code.
+ ;; The constant string which begins the header is followed by
+ ;; arbitrary human-readable text, terminated by a special
+ ;; character code.
(with-standard-io-syntax
(format stream
"~% ~
(close (fasl-file-stream file) :abort abort-p)
(values))
\f
+;;;; main entries to object dumping
-;;; MNA dump-circular hack
+;;; KLUDGE: This definition doesn't really belong in this file, but at
+;;; least it can be compiled without error here, and it's used here.
+;;; The definition requires the IGNORE-ERRORS macro, and in
+;;; sbcl-0.6.8.11 that's defined in early-target-error.lisp, and all
+;;; of the files which would otherwise be natural homes for this
+;;; definition (e.g. early-extensions.lisp or late-extensions.lisp)
+;;; are compiled before early-target-error.lisp. -- WHN 2000-11-07
(defun circular-list-p (list)
(and (listp list)
(multiple-value-bind (res condition)
nil
(null res)))))
-;;;; main entries to object dumping
-
-;;; This function deals with dumping objects that are complex enough so that
-;;; we want to cache them in the table, rather than repeatedly dumping them.
-;;; If the object is in the EQ-TABLE, then we push it, otherwise, we do a type
-;;; dispatch to a type specific dumping function. The type specific branches
-;;; do any appropriate EQUAL-TABLE check and table entry.
+;;; This function deals with dumping objects that are complex enough
+;;; so that we want to cache them in the table, rather than repeatedly
+;;; dumping them. If the object is in the EQ-TABLE, then we push it,
+;;; otherwise, we do a type dispatch to a type specific dumping
+;;; function. The type specific branches do any appropriate
+;;; EQUAL-TABLE check and table entry.
;;;
;;; When we go to dump the object, we enter it in the CIRCULARITY-TABLE.
(defun dump-non-immediate-object (x file)
(typecase x
(symbol (dump-symbol x file))
(list
- ;; MNA dump-circular hack
- (if (circular-list-p x)
- (progn
- (dump-list x file)
- (eq-save-object x file))
+ ;; KLUDGE: The code in this case has been hacked
+ ;; to match Douglas Crosher's quick fix to CMU CL
+ ;; (on cmucl-imp 1999-12-27), applied in sbcl-0.6.8.11
+ ;; with help from Martin Atzmueller. This is not an
+ ;; ideal solution; to quote DTC,
+ ;; The compiler locks up trying to coalesce the
+ ;; constant lists. The hack below will disable the
+ ;; coalescing of lists while dumping and allows
+ ;; the code to compile. The real fix would be to
+ ;; take a little more care while dumping these.
+ ;; So if better list coalescing is needed, start here.
+ ;; -- WHN 2000-11-07
+ (if (circular-list-p x)
+ (progn
+ (dump-list x file)
+ (eq-save-object x file))
(unless (equal-check-table x file)
(dump-list x file)
(equal-save-object x file))))
(dump-structure x file)
(eq-save-object x file))
(array
- ;; FIXME: The comment at the head of DUMP-NON-IMMEDIATE-OBJECT
- ;; says it's for objects which we want to save, instead of
- ;; repeatedly dumping them. But then we dump arrays here without
- ;; doing anything like EQUAL-SAVE-OBJECT. What gives?
+ ;; FIXME: The comment at the head of
+ ;; DUMP-NON-IMMEDIATE-OBJECT says it's for objects which
+ ;; we want to save, instead of repeatedly dumping them.
+ ;; But then we dump arrays here without doing anything
+ ;; like EQUAL-SAVE-OBJECT. What gives?
(dump-array x file))
(number
(unless (equal-check-table x file)
(integer (dump-integer x file)))
(equal-save-object x file)))
(t
- ;; This probably never happens, since bad things tend to be
- ;; detected during IR1 conversion.
+ ;; This probably never happens, since bad things tend to
+ ;; be detected during IR1 conversion.
(error "This object cannot be dumped into a fasl file:~% ~S"
x))))))
(values))
-;;; Dump an object of any type by dispatching to the correct type-specific
-;;; dumping function. We pick off immediate objects, symbols and and magic
-;;; lists here. Other objects are handled by Dump-Non-Immediate-Object.
+;;; Dump an object of any type by dispatching to the correct
+;;; type-specific dumping function. We pick off immediate objects,
+;;; symbols and and magic lists here. Other objects are handled by
+;;; DUMP-NON-IMMEDIATE-OBJECT.
;;;
-;;; This is the function used for recursive calls to the fasl dumper. We don't
-;;; worry about creating circularities here, since it is assumed that there is
-;;; a top-level call to Dump-Object.
+;;; This is the function used for recursive calls to the fasl dumper.
+;;; We don't worry about creating circularities here, since it is
+;;; assumed that there is a top-level call to DUMP-OBJECT.
(defun sub-dump-object (x file)
(cond ((listp x)
(if x
(t
(dump-non-immediate-object x file))))
-;;; Dump stuff to backpatch already dumped objects. Infos is the list of
-;;; Circularity structures describing what to do. The patching FOPs take the
-;;; value to store on the stack. We compute this value by fetching the
-;;; enclosing object from the table, and then CDR'ing it if necessary.
+;;; Dump stuff to backpatch already dumped objects. INFOS is the list
+;;; of CIRCULARITY structures describing what to do. The patching FOPs
+;;; take the value to store on the stack. We compute this value by
+;;; fetching the enclosing object from the table, and then CDR'ing it
+;;; if necessary.
(defun dump-circularities (infos file)
(let ((table (fasl-file-eq-table file)))
(dolist (info infos)
(dump-unsigned-32 (gethash (circularity-object info) table) file)
(dump-unsigned-32 (circularity-index info) file))))
-;;; Set up stuff for circularity detection, then dump an object. All shared
-;;; and circular structure will be exactly preserved within a single call to
-;;; Dump-Object. Sharing between objects dumped by separate calls is only
-;;; preserved when convenient.
+;;; Set up stuff for circularity detection, then dump an object. All
+;;; shared and circular structure will be exactly preserved within a
+;;; single call to Dump-Object. Sharing between objects dumped by
+;;; separate calls is only preserved when convenient.
;;;
-;;; We peek at the object type so that we only pay the circular detection
-;;; overhead on types of objects that might be circular.
+;;; We peek at the object type so that we only pay the circular
+;;; detection overhead on types of objects that might be circular.
(defun dump-object (x file)
(if (or (array-header-p x)
(simple-vector-p x)
(deftransform data-vector-ref ((array index)
(simple-array t))
(let ((array-type (continuation-type array)))
+ ;; FIXME: How could this happen? Doesn't the limitation to arg
+ ;; type SIMPLE-ARRAY guarantee that ARRAY-TYPE is an ARRAY-TYPE?
(unless (array-type-p array-type)
(give-up-ir1-transform))
(let ((dims (array-type-dimensions array-type)))
(give-up-ir1-transform))
(let* ((el-type (array-type-element-type array-type))
(total-size (if (or (atom dims) (member '* dims))
- '*
- (reduce #'* dims)))
+ '*
+ (reduce #'* dims)))
(type-sp `(simple-array ,(type-specifier el-type)
(,total-size))))
(if (atom dims)
(deftransform data-vector-set ((array index new-value)
(simple-array t t))
(let ((array-type (continuation-type array)))
+ ;; FIXME: How could this happen? Doesn't the limitation to arg
+ ;; type SIMPLE-ARRAY guarantee that ARRAY-TYPE is an ARRAY-TYPE?
(unless (array-type-p array-type)
(give-up-ir1-transform))
(let ((dims (array-type-dimensions array-type)))
(give-up-ir1-transform))
(let* ((el-type (array-type-element-type array-type))
(total-size (if (or (atom dims) (member '* dims))
- '*
- (reduce #'* dims)))
+ '*
+ (reduce #'* dims)))
(type-sp `(simple-array ,(type-specifier el-type)
(,total-size))))
- (if (atom dims)
+ (if (atom dims)
`(let ((a (truly-the ,type-sp (%array-simp array))))
(data-vector-set a index new-value))
`(let ((a (truly-the ,type-sp (%array-data-vector array))))
(defvar *converting-for-interpreter* nil)
;;; FIXME: Rename to *IR1-FOR-INTERPRETER-NOT-COMPILER-P*.
-;;; *COMPILE-TIME-DEFINE-MACROS* is true when we want DEFMACRO
-;;; definitions to be installed in the compilation environment as
-;;; interpreted functions. We set this to false when compiling some
-;;; parts of the system.
-(defvar *compile-time-define-macros* t)
-;;; FIXME: I think this can go away with the new system.
-
;;; FIXME: This nastiness was one of my original motivations to start
;;; hacking CMU CL. The non-ANSI behavior can be useful, but it should
;;; be made not the default, and perhaps should be controlled by
`(multiple-value-call #'%throw ,tag ,result)))
;;; This is a special special form used to instantiate a cleanup as
-;;; the current cleanup within the body. Kind is a the kind of cleanup
-;;; to make, and Mess-Up is a form that does the mess-up action. We
-;;; make the MESS-UP be the USE of the Mess-Up form's continuation,
+;;; the current cleanup within the body. KIND is a the kind of cleanup
+;;; to make, and MESS-UP is a form that does the mess-up action. We
+;;; make the MESS-UP be the USE of the MESS-UP form's continuation,
;;; and introduce the cleanup into the lexical environment. We
-;;; back-patch the Entry-Cleanup for the current cleanup to be the new
+;;; back-patch the ENTRY-CLEANUP for the current cleanup to be the new
;;; cleanup, since this inner cleanup is the interesting one.
(def-ir1-translator %within-cleanup ((kind mess-up &body body) start cont)
(let ((dummy (make-continuation))
;;; This is a special special form that makes an "escape function"
;;; which returns unknown values from named block. We convert the
-;;; function, set its kind to :Escape, and then reference it. The
+;;; function, set its kind to :ESCAPE, and then reference it. The
;;; :Escape kind indicates that this function's purpose is to
;;; represent a non-local control transfer, and that it might not
;;; actually have to be compiled.
;;;
;;; Note that environment analysis replaces references to escape
-;;; functions with references to the corresponding NLX-Info structure.
+;;; functions with references to the corresponding NLX-INFO structure.
(def-ir1-translator %escape-function ((tag) start cont)
(let ((fun (ir1-convert-lambda
`(lambda ()
(reference-leaf start cont fun)))
;;; Yet another special special form. This one looks up a local
-;;; function and smashes it to a :Cleanup function, as well as
+;;; function and smashes it to a :CLEANUP function, as well as
;;; referencing it.
(def-ir1-translator %cleanup-function ((name) start cont)
(let ((fun (lexenv-find name functions)))
;;; We represent the possibility of the control transfer by making an
;;; "escape function" that does a lexical exit, and instantiate the
-;;; cleanup using %within-cleanup.
+;;; cleanup using %WITHIN-CLEANUP.
(def-ir1-translator catch ((tag &body body) start cont)
#!+sb-doc
"Catch Tag Form*
;;; UNWIND-PROTECT is similar to CATCH, but more hairy. We make the
;;; cleanup forms into a local function so that they can be referenced
;;; both in the case where we are unwound and in any local exits. We
-;;; use %Cleanup-Function on this to indicate that reference by
-;;; %Unwind-Protect isn't "real", and thus doesn't cause creation of
+;;; use %CLEANUP-FUNCTION on this to indicate that reference by
+;;; %UNWIND-PROTECT ISN'T "real", and thus doesn't cause creation of
;;; an XEP.
(def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
#!+sb-doc
;;;; multiple-value stuff
;;; If there are arguments, MULTIPLE-VALUE-CALL turns into an
-;;; MV-Combination.
+;;; MV-COMBINATION.
;;;
;;; If there are no arguments, then we convert to a normal
-;;; combination, ensuring that a MV-Combination always has at least
+;;; combination, ensuring that a MV-COMBINATION always has at least
;;; one argument. This can be regarded as an optimization, but it is
-;;; more important for simplifying compilation of MV-Combinations.
+;;; more important for simplifying compilation of MV-COMBINATIONS.
(def-ir1-translator multiple-value-call ((fun &rest args) start cont)
#!+sb-doc
"MULTIPLE-VALUE-CALL Function Values-Form*
(use-continuation node cont)
(setf (basic-combination-args node) (arg-conts))))))
-;;; Multiple-Value-Prog1 is represented implicitly in IR1 by having a
+;;; MULTIPLE-VALUE-PROG1 is represented implicitly in IR1 by having a
;;; the result code use result continuation (CONT), but transfer
;;; control to the evaluation of the body. In other words, the result
-;;; continuation isn't Immediately-Used-P by the nodes that compute
+;;; continuation isn't IMMEDIATELY-USED-P by the nodes that compute
;;; the result.
;;;
;;; In order to get the control flow right, we convert the result with
;;; a dummy result continuation, then convert all the uses of the
-;;; dummy to be uses of CONT. If a use is an Exit, then we also
-;;; substitute CONT for the dummy in the corresponding Entry node so
+;;; dummy to be uses of CONT. If a use is an EXIT, then we also
+;;; substitute CONT for the dummy in the corresponding ENTRY node so
;;; that they are consistent. Note that this doesn't amount to
;;; changing the exit target, since the control destination of an exit
;;; is determined by the block successor; we are just indicating the
;;; Note that we both exploit and maintain the invariant that the CONT
;;; to an IR1 convert method either has no block or starts the block
;;; that control should transfer to after completion for the form.
-;;; Nested MV-Prog1's work because during conversion of the result
+;;; Nested MV-PROG1's work because during conversion of the result
;;; form, we use dummy continuation whose block is the true control
;;; destination.
(def-ir1-translator multiple-value-prog1 ((result &rest forms) start cont)
(compiler-error "The special form ~S can't be redefined as a macro."
name)))
- (setf (info :function :kind name) :macro)
- (setf (info :function :where-from name) :defined)
-
- (when *compile-time-define-macros*
- (setf (info :function :macro-function name)
- (coerce def 'function)))
+ (setf (info :function :kind name) :macro
+ (info :function :where-from name) :defined
+ (info :function :macro-function name) (coerce def 'function))
(let* ((*current-path* (revert-source-path 'defmacro))
(fun (ir1-convert-lambda def name)))
(ir1-convert start cont `(%%defmacro ',name ,fun ,doc)))
(when sb!xc:*compile-print*
- ;; MNA compiler message patch
+ ;; FIXME: It would be nice to convert this, and the other places
+ ;; which create compiler diagnostic output prefixed by
+ ;; semicolons, to use some common utility which automatically
+ ;; prefixes all its output with semicolons. (The addition of
+ ;; semicolon prefixes was introduced ca. sbcl-0.6.8.10 as the
+ ;; "MNA compiler message patch", and implemented by modifying a
+ ;; bunch of output statements on a case-by-case basis, which
+ ;; seems unnecessarily error-prone and unclear, scattering
+ ;; implicit information about output style throughout the
+ ;; system.) Starting by rewriting COMPILER-MUMBLE to add
+ ;; semicolon prefixes would be a good start, and perhaps also:
+ ;; * Add semicolon prefixes for "FOO assembled" messages emitted
+ ;; when e.g. src/assembly/x86/assem-rtns.lisp is processed.
+ ;; * At least some debugger output messages deserve semicolon
+ ;; prefixes too:
+ ;; ** restarts table
+ ;; ** "Within the debugger, you can type HELP for help."
(compiler-mumble "~&; converted ~S~%" name))))
(def-ir1-translator %define-compiler-macro ((name def lambda-list doc)
start cont
:kind :function)
(let ((name (eval name))
- (def (second def))) ; Don't want to make a function just yet...
+ (def (second def))) ; We don't want to make a function just yet...
(when (eq (info :function :kind name) :special-form)
(compiler-error "attempt to define a compiler-macro for special form ~S"
name))
- (when *compile-time-define-macros*
- (setf (info :function :compiler-macro-function name)
- (coerce def 'function)))
+ (setf (info :function :compiler-macro-function name)
+ (coerce def 'function))
(let* ((*current-path* (revert-source-path 'define-compiler-macro))
(fun (ir1-convert-lambda def name)))
(*current-path* (revert-source-path 'defun))
(expansion (unless (eq (info :function :inlinep name) :notinline)
(inline-syntactic-closure-lambda lambda))))
- ;; If not in a simple environment or NOTINLINE, then discard any forward
- ;; references to this function.
+ ;; If not in a simple environment or NOTINLINE, then discard any
+ ;; forward references to this function.
(unless expansion (remhash name *free-functions*))
(let* ((var (get-defined-function name))
expansion)))
(setf (defined-function-inline-expansion var) expansion)
(setf (info :function :inline-expansion name) save-expansion)
- ;; If there is a type from a previous definition, blast it, since it is
- ;; obsolete.
+ ;; If there is a type from a previous definition, blast it,
+ ;; since it is obsolete.
(when (eq (leaf-where-from var) :defined)
(setf (leaf-type var) (specifier-type 'function)))
(&rest (setq state 'rest))
(&aux (setq state 'aux))
(otherwise
- (error "encountered the non-standard lambda list keyword ~S"
- var)))
+ (error
+ "encountered the non-standard lambda list keyword ~S"
+ var)))
nil)
(case state
(required `((,var (pop ,args-tail))))
(+ i f)))
(assert (= (exercise-valuesify 1.25) 2.25))
-;;; A bug inherited from CMU CL screwed up special variable bindings
-;;; inside closures. This was fixed in sbcl-0.6.8.10 by applying the
-;;; patches Douglas Crosher posted to cmucl-imp@cons.org 2000-03-10
-;;; (split across two different messages).
-;;; FIXME: I'd like to find a test case for this..
+
+;;; Don Geddis reported this test case 25 December 1999 on a CMU CL
+;;; mailing list: dumping circular lists caused an infinite loop.
+;;; Douglas Crosher reported a patch 27 Dec 1999. The patch was tested
+;;; on SBCL by Martin Atzmueller 2 Nov 2000, and merged in
+;;; sbcl-0.6.8.11.
+(defun q1 () (dolist (x '#1=("A" "B" . #1#)) x))
+(defun q2 () (dolist (x '#1=("C" "D" . #1#)) x))
+(defun q3 () (dolist (x '#1=("E" "F" . #1#)) x))
+(defun q4 () (dolist (x '#1=("C" "D" . #1#)) x))
+(defun never5 ())
+(defun useful (keys)
+ (declare (type list keys))
+ (loop
+ for c in '#1=("Red" "Blue" . #1#)
+ for key in keys ))
(sb-ext:quit :unix-status 104) ; success
;;; 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.8.10"
+"0.6.8.11"
projects / sbcl.git / commitdiff