as per Daniel Barlow's suggestion and Martin Atzmueller's patch
changes in sbcl-0.6.12 relative to sbcl-0.6.11:
+?? many patches ported from CMU CL by Martin Atzmueller, notably
+ ??
+ ??
?? new fasl file format version number (because a disused byte code
opcode was removed, causing the other opcodes to change)
* various tweaks to make the system easier to build under other
;; control other fancy numeric reasoning, e.g. knowing the result type of
;; a remainder calculation given the type of its inputs.
;;
- ;; KLUDGE: Even when this is implemented for the target feature list,
- ;; the code to implement this feature will not generated in the
- ;; cross-compiler (i.e. will only be generated in the target compiler).
- ;; The reason for this is that the interval arithmetic routines used
- ;; to implement this feature are written under the assumption that
- ;; Lisp arithmetic supports plus and minus infinity, which isn't guaranteed by
- ;; ANSI Common Lisp. I've tried to mark the conditionals which implement
- ;; this kludge with the string CROSS-FLOAT-INFINITY-KLUDGE so that
- ;; sometime it might be possible to undo them (perhaps by using
- ;; nice portable :PLUS-INFINITY and :MINUS-INFINITY values instead of
- ;; implementation dependent floating infinity values, which would
- ;; admittedly involve extra consing; or perhaps by finding some cleaner
- ;; way of suppressing the construction of this code in the cross-compiler).
- ;;
- ;; KLUDGE: Even after doing the KLUDGE above, the cross-compiler doesn't work,
- ;; because some interval operations are conditional on PROPAGATE-FUN-TYPE
- ;; instead of PROPAGATE-FLOAT-TYPE. So for now, I've completely turned off
- ;; both PROPAGATE-FUN-TYPE and PROPAGATE-FLOAT-TYPE. (After I build
- ;; a compiler which works, then I can think about getting the optimization
- ;; to work.) -- WHN 19990702
- ; :propagate-float-type
+ ;; CROSS-FLOAT-INFINITY-KLUDGE: The :PROPAGATE-FLOAT-TYPE and
+ ;; :PROPAGATE-FUN-TYPE features are problematic when building
+ ;; the cross-compiler itself. Their implementation depends on
+ ;; floating point infinities, which might not be supported in the
+ ;; cross-compilation host. In order to avoid this problem, while
+ ;; still supporting these features in the target Lisp compiler,
+ ;; we use the :WILL-PROPAGATE-FLOAT-TYPE feature when building
+ ;; the cross-compiler, and munge it into :PROPAGATE-FLOAT-TYPE
+ ;; only when building the target compiler; and similarly for
+ ;; :WILL-PROPAGATE-FUN-TYPE.
+ ;:will-propagate-float-type ; (becomes :PROPAGATE-FLOAT-TYPE)
;; According to cmu-user.tex, this enables the compiler to infer result
;; types for mathematical functions like SQRT, EXPT, and LOG, allowing
;; it to e.g. eliminate the possibility that a complex result will be
- ;; generated.
- ;;
- ;; KLUDGE: turned off as per the comments for PROPAGATE-FLOAT-TYPE above
- ; :propagate-fun-type
+ ;; generated. This applies only to the target compiler, not the
+ ;; cross-compiler: see CROSS-FLOAT-INFINITY-KLUDGE.
+ ;:will-propagate-fun-type ; (becomes :PROPAGATE-FUN-TYPE)
;; It's unclear to me what this does (but it was enabled in the code that I
;; picked up from Peter Van Eynde). -- WHN 19990224
;; phase of cross-compilation bootstrapping, when the cross-compiler is
;; being used to create the first target Lisp.
+ ;; notes on the :PROPAGATE-FLOAT-TYPE and :PROPAGATE-FUN-TYPE
+ ;; features: See the comments on CROSS-FLOAT-INFINITY-KLUDGE.
+
;; notes on the :SB-ASSEMBLING feature (which isn't controlled by
;; this file):
;;
"Call FN with everything set up appropriately for cross-compiling
a target file."
(let (;; Life is simpler at genesis/cold-load time if we
- ;; needn't worry about byte-compiled code.
- (sb!ext:*byte-compile-top-level* nil)
- ;; Let the target know that we're the cross-compiler.
- (*features* (cons :sb-xc *features*))
- ;; We need to tweak the readtable..
- (*readtable* (copy-readtable))
+ ;; needn't worry about byte-compiled code.
+ (sb!ext:*byte-compile-top-level* nil)
;; In order to reduce peak memory usage during GENESIS,
;; it helps to stuff several toplevel forms together
- ;; into the same function.
- (sb!c::*top-level-lambda-max* 10))
+ ;; into the same function.
+ (sb!c::*top-level-lambda-max* 10)
+ ;; Let the target know that we're the cross-compiler.
+ (*features* (cons :sb-xc *features*))
+ ;; the CROSS-FLOAT-INFINITY-KLUDGE: When building a
+ ;; compiler which runs under the SBCL runtime, which
+ ;; supports floating point infinities, it's safe to
+ ;; build with true PROPAGATE-FLOAT-TYPE and
+ ;; PROPAGATE-FUN-TYPE features. (It wasn't safe
+ ;; when building a cross-compiler to run under the
+ ;; cross-compilation host Lisp).
+ #+nil ; FIXME: suppressed since 0.6.11.3 has no fp infinities
+ (sb-cold:*shebang-features*
+ (substitute
+ :propagate-float-type
+ :will-propagate-float-type
+ (substitute
+ :propagate-fun-type
+ :will-propagate-fun-type
+ sb-cold:*shebang-features*)))
+ ;; We need to tweak the readtable..
+ (*readtable* (copy-readtable)))
;; ..in order to make backquotes expand into target code
;; instead of host code.
;; FIXME: Isn't this now taken care of automatically by
"RETURN-CHAR-CODE" "RUBOUT-CHAR-CODE" "TAB-CHAR-CODE"
;; symbol-hacking idioms
- "CONCAT-PNAMES" "KEYWORDICATE" "SYMBOLICATE"
+ "KEYWORDICATE" "SYMBOLICATE"
;; search lists (FIXME: should go away)
"ENUMERATE-SEARCH-LIST"
;; documentation on the structure
(doc nil :type (or string null))
;; prefix for slot names. If NIL, none.
- (conc-name (concat-pnames name '-) :type (or symbol null))
+ (conc-name (symbolicate name "-") :type (or symbol null))
;; the name of the primary standard keyword constructor, or NIL if none
(default-constructor nil :type (or symbol null))
;; all the explicit :CONSTRUCTOR specs, with name defaulted
(constructors () :type list)
;; name of copying function
- (copier (concat-pnames 'copy- name) :type (or symbol null))
+ (copier (symbolicate "COPY-" name) :type (or symbol null))
;; name of type predicate
- (predicate (concat-pnames name '-p) :type (or symbol null))
+ (predicate (symbolicate name "-P") :type (or symbol null))
;; the arguments to the :INCLUDE option, or NIL if no included
;; structure
(include nil :type list)
conc-name
(make-symbol (string conc-name))))))
(:constructor
- (destructuring-bind (&optional (cname (concat-pnames 'make- name))
+ (destructuring-bind (&optional (cname (symbolicate "MAKE-" name))
&rest stuff)
args
(push (cons cname stuff) (dd-constructors defstruct))))
(:copier
- (destructuring-bind (&optional (copier (concat-pnames 'copy- name)))
+ (destructuring-bind (&optional (copier (symbolicate "COPY-" name)))
args
(setf (dd-copier defstruct) copier)))
(:predicate
- (destructuring-bind (&optional (pred (concat-pnames name '-p))) args
+ (destructuring-bind (&optional (pred (symbolicate name "-P"))) args
(setf (dd-predicate defstruct) pred)))
(:include
(when (dd-include defstruct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun parse-name-and-options (name-and-options)
(destructuring-bind (name &rest options) name-and-options
+ (assert name) ; A null name doesn't seem to make sense here.
(let ((defstruct (make-defstruct-description name)))
(dolist (option options)
(cond ((consp option)
(setf (dsd-%name islot) (string name))
(setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
- (let* ((accname (concat-pnames (dd-conc-name defstruct) name))
+ (let* ((accname (symbolicate (or (dd-conc-name defstruct) "") name))
(existing (info :function :accessor-for accname)))
(if (and (structure-class-p existing)
(not (eq (sb!xc:class-name existing) (dd-name defstruct)))
(return-from constructor-definitions ()))
(unless (or defaults boas)
- (push (concat-pnames 'make- (dd-name defstruct)) defaults))
+ (push (symbolicate "MAKE-" (dd-name defstruct)) defaults))
(collect ((res))
(when defaults
\f
;;;; miscellany
-;;; FIXME: What is this used for that SYMBOLICATE couldn't be used for instead?
-;;; If nothing, replace it.
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun concat-pnames (name1 name2)
- (declare (symbol name1 name2))
- (if name1
- (intern (concatenate 'simple-string
- (symbol-name name1)
- (symbol-name name2)))
- name2)))
-
;;; Is NAME a legal function name?
(defun legal-function-name-p (name)
(or (symbolp name)
(follow-links t))
#!+sb-doc
"Returns a list of pathnames, one for each file that matches the given
- pathname. Supplying :ALL as nil causes this to ignore Unix dot files. This
+ pathname. Supplying :ALL as NIL causes this to ignore Unix dot files. This
never includes Unix dot and dot-dot in the result. If :FOLLOW-LINKS is NIL,
- then symblolic links in the result are not expanded. This is not the
+ then symbolic links in the result are not expanded. This is not the
default because TRUENAME does follow links, and the result pathnames are
defined to be the TRUENAME of the pathname (the truename of a link may well
be in another directory.)"
(char/= (schar name (1+ slash)) #\.))))
(push name results))))
(let ((*ignore-wildcards* t))
- (mapcar #'(lambda (name)
- (let ((name (if (and check-for-subdirs
- (eq (sb!unix:unix-file-kind name)
- :directory))
- (concatenate 'string name "/")
- name)))
- (if follow-links (truename name) (pathname name))))
+ (mapcar (lambda (name)
+ (let ((name (if (and check-for-subdirs
+ (eq (sb!unix:unix-file-kind name)
+ :directory))
+ (concatenate 'string name "/")
+ name)))
+ (if follow-links (truename name) (pathname name))))
(sort (delete-duplicates results :test #'string=) #'string<)))))
\f
;;;; translating Unix uid's
(unless ,(first endlist) (go ,label-1))
(return-from ,block (progn ,@(rest endlist))))))))))
+;;; DO-ANONYMOUS ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
+;;;
+;;; This is like DO, except it has no implicit NIL block. Each VAR is
+;;; initialized in parallel to the value of the specified INIT form.
+;;; On subsequent iterations, the VARS are assigned the value of the
+;;; STEP form (if any) in parallel. The TEST is evaluated before each
+;;; evaluation of the body FORMS. When the TEST is true, the
+;;; EXIT-FORMS are evaluated as a PROGN, with the result being the
+;;; value of the DO.
(defmacro do-anonymous (varlist endlist &rest body)
- #!+sb-doc
- "DO-ANONYMOUS ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
- Like DO, but has no implicit NIL block. Each Var is initialized in parallel
- to the value of the specified Init form. On subsequent iterations, the Vars
- are assigned the value of the Step form (if any) in parallel. The Test is
- evaluated before each evaluation of the body Forms. When the Test is true,
- the Exit-Forms are evaluated as a PROGN, with the result being the value
- of the DO."
(do-do-body varlist endlist body 'let 'psetq 'do-anonymous (gensym)))
\f
;;;; miscellany
(let ((*package* *keyword-package*))
(apply #'symbolicate things)))
-;;; Access *PACKAGE* in a way which lets us recover if someone has
+;;; Access *PACKAGE* in a way which lets us recover when someone has
;;; done something silly like (SETF *PACKAGE* :CL-USER). (Such an
-;;; assignment is undefined behavior, so it's sort of reasonable for it
-;;; to cause the system to go totally insane afterwards, but it's
-;;; a fairly easy mistake to make, so let's try to recover gracefully
+;;; assignment is undefined behavior, so it's sort of reasonable for
+;;; it to cause the system to go totally insane afterwards, but it's a
+;;; fairly easy mistake to make, so let's try to recover gracefully
;;; instead.)
(defun sane-package ()
(let ((maybe-package *package*))
;;; toy@rtp.ericsson.se:
;;;
-;;; Optimizers for scale-float. If the float has bounds, new bounds
+;;; optimizers for SCALE-FLOAT. If the float has bounds, new bounds
;;; are computed for the result, if possible.
-#-sb-xc-host ;(CROSS-FLOAT-INFINITY-KLUDGE, see base-target-features.lisp-expr)
-(progn
#!+propagate-float-type
(progn
(one-arg-derive-type num #',aux-name #',fun))))))
(frob %single-float single-float)
(frob %double-float double-float))
-)) ; PROGN PROGN
+) ; PROGN
\f
;;;; float contagion
(defvar *normal-fop-functions*)
-;;; This is like DEFINE-FOP which defines fops for warm load, but unlike
-;;; DEFINE-FOP, this version
-;;; (1) looks up the code for this name (created by a previous DEFINE-FOP)
-;;; instead of creating a code, and
-;;; (2) stores its definition in the *COLD-FOP-FUNCTIONS* vector, instead
-;;; of storing in the *FOP-FUNCTIONS* vector.
+;;; Cause a fop to have a special definition for cold load.
+;;;
+;;; This is similar to DEFINE-FOP, but unlike DEFINE-FOP, this version
+;;; (1) looks up the code for this name (created by a previous
+;; DEFINE-FOP) instead of creating a code, and
+;;; (2) stores its definition in the *COLD-FOP-FUNCTIONS* vector,
+;;; instead of storing in the *FOP-FUNCTIONS* vector.
(defmacro define-cold-fop ((name &optional (pushp t)) &rest forms)
(check-type pushp (member nil t :nope))
(let ((code (get name 'fop-code))
- (fname (concat-pnames 'cold- name)))
+ (fname (symbolicate "COLD-" name)))
(unless code
(error "~S is not a defined FOP." name))
`(progn
`(define-cold-fop (,name)
(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 loading functions.
+;;; COLD-LOAD loads stuff into the core image being built by calling
+;;; FASLOAD with the fop function table rebound to a table of cold
+;;; loading functions.
(defun cold-load (filename)
#!+sb-doc
"Load the file named by FILENAME into the cold load image being built."
;;; 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.3"
+"0.6.11.4"
projects / sbcl.git / commitdiff