26:
reported by Sam Steingold on the cmucl-imp mailing list 12 May 2000:
-
-Also, there is another bug: `array-displacement' should return an array
-or nil as first value (as per ANSI CL), while CMUCL declares it as
-returning an array as first value always.
+ Also, there is another bug: `array-displacement' should return an
+ array or nil as first value (as per ANSI CL), while CMUCL declares
+ it as returning an array as first value always.
+ (Actually, I think the old CMU CL version in SBCL never returns NIL,
+ i.e. it's not just a declaration problem, but the definition doesn't
+ behave ANSIly.)
27:
Sometimes (SB-EXT:QUIT) fails with
multiple-VALUES types. (Some issues related to this were discussed
on cmucl-imp at some length sometime in 2000.)
+95:
+ The facility for dumping a running Lisp image to disk gets confused
+ when run without the PURIFY option, and creates an unnecessarily large
+ core file (apparently representing memory usage up to the previous
+ high-water mark). Moreover, when the file is loaded, it confuses the
+ GC, so that thereafter memory usage can never be reduced below that
+ level.
+
+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.
KNOWN BUGS RELATED TO THE IR1 INTERPRETER
attached to individual source files, so they have been moved here
instead.
-William Harold Newman <william.newman@airmail.net> did this
-transformation, and so any errors made are probably his. Corrections
-would be appreciated.
+Bill Newman <william.newman@airmail.net> did this transformation, and
+so any errors made are probably his. Corrections would be appreciated.
MORE DETAILS ON SBCL'S CLOS CODE
Guy Steele wrote the original character functions
code/char.lisp
-They were subsequently rewritten by David Dill, speeded up by Scott Fahlman,
-and rewritten without fonts and with a new type system by Rob MachLachlan.
+They were subsequently rewritten by David Dill, speeded up by Scott
+Fahlman, and rewritten without fonts and with a new type system by Rob
+MachLachlan.
Lee Schumacher made the Spice Lisp version of backquote. The comment
in the CMU CL sources suggests he based it on someone else's code for
Fahlman, Dan Aronson, and Steve Handerson did stuff here too."
The same credit statement was given for the original Mach OS interface code.
-The CMU CL printer, print.lisp, was credited as "written by
-Neal Feinberg, Bill Maddox, Steven Handerson, and Skef Wholey, and
-modified by various CMU Common Lisp maintainers."
+The CMU CL printer, print.lisp, was credited as "written by Neal
+Feinberg, Bill Maddox, Steven Handerson, and Skef Wholey, and modified
+by various CMU Common Lisp maintainers." The comments on the float
+printer said specifically that it was written by Bill Maddox. The
+comments on bignum printing said specifically that it was written by
+Steven Handerson (based on Skef's idea), and that it was rewritten by
+William Lott to remove assumptions about length of fixnums on the MIPS
+port.
The comments in the main body of the CMU CL debugger
code/debug.lisp
complicated result types, and interactions of various variants of
STREAM).
-Raymond Toy wrote the PROPAGATE-FLOAT-TYPE extension and various
-other floating point optimizations.
+Raymond Toy wrote CMU CL's PROPAGATE-FLOAT-TYPE extension and various
+other floating point optimizations. (In SBCL, the PROPAGATE-FLOAT-TYPE
+entry in *FEATURES* first became SB-PROPAGATE-FLOAT-TYPE, then went
+away completely as the code became an unconditional part of the
+system.)
CMU CL's long float support was written by Douglas T. Crosher.
CREDITS SINCE THE RELEASE OF SBCL
-(Some more details are available in the NEWS file and in the
-project's CVS change logs.)
+(Note: (1) This is probably incomplete, since there's no systematic
+procedure for updating it. (2) Some more details are available in the
+NEWS file, in the project's CVS change logs, and in the archives of
+the sbcl-devel mailing list.)
Martin Atzmueller:
He reported many bugs, fixed many bugs, ported various fixes
file loading code to work under SBCL.
Cadabra, Inc. (later merged into GoTo.com):
- They hired William Newman to do some consulting for them,
+ They hired Bill Newman to do some consulting for them,
including the implementation of EQUALP hash tables for CMU CL;
then agreed to release the EQUALP code into the public domain,
giving SBCL (and CMU CL) EQUALP hash tables.
problems, has been invaluable to the CMU CL project and, by
porting, invaluable to the SBCL project as well.
-William Newman:
- He continued to work on the project after the fork, increasing
- ANSI compliance, fixing bugs, regularizing the internals of the
+Bill Newman:
+ He continued to work on SBCL after the fork, increasing ANSI
+ compliance, fixing bugs, regularizing the internals of the
system, deleting unused extensions, improving performance in
some areas (especially sequence functions and non-simple vectors),
and updating documentation.
+Raymond Toy:
+ He continued to work on CMU CL after the SBCL fork, especially on
+ floating point stuff. Various patches and fixes of his have been
+ ported to SBCL.
+
Peter Van Eynde:
- He wrestled the CLISP test suite into a portable test suite which
- can be used on SBCL, and submitted many other bug reports as well.
+ He wrestled the CLISP test suite into a portable test suite
+ (clocc ansi-test) which can be used on SBCL, provided a slew of
+ of bug reports resulting from that, and submitted many other bug
+ reports as well.
Colin Walters:
His O(N) implementation of the general case of MAP, posted on the
complex special functions have been merged from CMU CL sources.
(When I was first setting up SBCL, I misunderstood a compile-time
conditional #-OLD-SPECFUN, and so accidentally deleted them.)
+?? The --noprogrammer command line option is now supported. (Its
+ behavior is slightly different in detail from what the old man
+ page claimed it would do, but it's appropriate under the same
+ circumstances.)
* The :SB-PROPAGATE-FLOAT-TYPE and :SB-PROPAGATE-FUN-TYPE features
are now supported, and enabled by default. Thus, the compiler can
handle many floating point and complex operations much less
the initialization of the Common Lisp system, and any remaining
command line arguments are passed on to user code.
-The full, unambiguous syntax for SBCL is
+The full, unambiguous syntax for invoking SBCL at the command line is
.TP 3
.B sbcl [runtime options] --end-runtime-options [toplevel options] --end-toplevel-options [user options]
.PP
.B --core <corefilename>
Run the specified Lisp core file instead of the default. (See the FILES
section.) Note that if the Lisp core file is a user-created core file, it may
-run a nonstandard toplevel which does not accept the standard toplevel options.
+run a nonstandard toplevel which does not recognize the standard toplevel
+options.
.TP 3
.B --noinform
Suppress the printing of any banner or other informational message at
Supported toplevel options for the standard SBCL core are
.TP 3
.B --sysinit <filename>
-Load filename instead of the default system-wide
-initialization file. (See the FILES section.)
-There is no special option to cause
-no system-wide initialization file to be read, but on a Unix
-system "--sysinit /dev/null" can be used to achieve the same effect.
+Load filename instead of the default system-wide initialization file.
+(See the FILES section.) There is no special option to cause no
+system-wide initialization file to be read, but on a Unix system
+"--sysinit /dev/null" can be used to achieve the same effect.
.TP 3
.B --userinit <filename>
-Load filename instead of the default user
-initialization file. (See the FILES section.)
-There is no special option to cause
-no user initialization file to be read, but on a Unix
-system "--userinit /dev/null" can be used to achieve the same effect.
+Load filename instead of the default user initialization file. (See
+the FILES section.) There is no special option to cause no user
+initialization file to be read, but on a Unix system "--userinit
+/dev/null" can be used to achieve the same effect.
.TP 3
.B --eval <command>
After executing any initialization file, but before starting the
-read-eval-print loop on standard input,
-evaluate the command given. More than
-one --eval option can be used, and all will be executed,
-in the order they appear on the command line.
+read-eval-print loop on standard input, evaluate the command given.
+More than one --eval option can be used, and all will be executed, in
+the order they appear on the command line.
.TP 3
.B --noprint
-When ordinarily the toplevel "read-eval-print loop" would be
-executed, execute a "read-eval loop" instead, i.e. don't print
-a prompt and don't echo results. (Combined with the --noinform
-runtime option, this makes it easier to write Lisp
-"scripts" which work in Unix pipelines.)
+When ordinarily the toplevel "read-eval-print loop" would be executed,
+execute a "read-eval loop" instead, i.e. don't print a prompt and
+don't echo results. Combined with the --noinform runtime option, this
+makes it easier to write Lisp "scripts" which work in Unix pipelines.
.TP 3
.B --noprogrammer
-Ordinarily the system initializes *DEBUG-IO* to *TERMINAL-IO*.
-When the --notty option is set, however, *DEBUG-IO* is instead
-set to a stream which sends its output to *ERROR-OUTPUT* and
-which raises an error on input. As a result, any attempt by the
-program to get programmer feedback through the debugger
-causes an error which abnormally terminates the entire
-Lisp environment. (This can be useful behavior for programs
-which are to run without programmer supervision.)
+By default, a Common Lisp system tries to ask the programmer for help
+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.
.PP
Regardless of the order in which --sysinit, --userinit, and --eval
commands such as SB-EXT:QUIT can cause execution to be terminated
before proceeding to subsequent steps.
-Note that when running SBCL from a core file created by a user call to
-the SB-EXT:SAVE-LISP-AND-DIE, the toplevel options may be under the
-control of user code passed as arguments to SB-EXT:SAVE-LISP-AND-DIE.
-For this purpose, the --end-toplevel-options option itself can be
-considered a toplevel option, i.e. the user core, at its option, may
-not support it.
+Note that when running SBCL with the --core option, using a core file
+created by a user call to the SB-EXT:SAVE-LISP-AND-DIE, the toplevel
+options may be under the control of user code passed as arguments to
+SB-EXT:SAVE-LISP-AND-DIE. For this purpose, the --end-toplevel-options
+option itself can be considered a toplevel option, i.e. the user core,
+at its option, may not support it.
In the standard SBCL startup sequence (i.e. with no user core
involved) toplevel options and any --end-toplevel-options option are
system and a C compiler, and all of its properties are specified by
the version of the source code that it was created from. (This clean
bootstrappability was the immediate motivation for forking off of the
-CMU CL development tree.)
-
-Many extensions supported by CMU CL, like Motif support,
-the Hemlock editor, search paths, the WIRE protocol, various
-user-level macros and functions (e.g. LETF, ITERATE, MEMQ,
+CMU CL development tree.) A variety of internal implementation
+differences are motivated by this.
+
+Maintenance work in SBCL since the fork has diverged in various
+details from the maintenance work in CMU CL. E.g. as of 2001-04-12,
+SBCL was more ANSI-compliant than CMU CL in various details such as
+support for PRINT-OBJECT and DESCRIBE-OBJECT, and SBCL's compiler was
+substantially better than CMU CL's at optimizing operations on
+non-simple vectors.
+
+Most extensions supported by CMU CL are not supported in SBCL,
+including Motif support, the Hemlock editor, search paths, the
+low-level Unix interface, the WIRE protocol, multithreading support,
+various user-level macros and functions (e.g. LETF, ITERATE, MEMQ,
REQUIRED-ARGUMENT), and many others.
-SBCL has retained some extensions of its parent CMU CL. Many
-of them are in three categories:
+SBCL has retained some extensions from parent CMU CL. Many of the
+retained extensions are in these categories:
.TP 3
\--
-hooks into the low level workings of the system which can be useful
-for debugging (e.g. a list of functions to be run whenever GC occurs,
-or an operator to cause a particular string to be compiled into a fasl
-file)
+things which might be in the new ANSI spec, e.g. weak pointers,
+finalization, foreign function interface to C, and Gray streams
.TP 3
\--
-non-portable performance hacks (e.g. PURIFY, which causes
-everything currently in existence to become immune to GC)
+things which are universally available in Unix scripting languages,
+e.g. RUN-PROGRAM and POSIX argv and getenv
+.TP 3
+\--
+hooks into the low level workings of the system which can be useful
+for debugging, e.g. a list of functions to be run whenever GC occurs,
+or parameters to modify compiler diagnostic output
.TP 3
\--
-things which might be in the new ANSI spec (e.g. weak pointers,
-finalization, foreign function interface to C, and Gray streams)
+unportable performance hacks, e.g. TRULY-THE, FREEZE-TYPE, and PURIFY
.PP
-There are also various retained extensions which don't fall into
+There are also a few retained extensions which don't fall into
any particular category, e.g.
.TP 3
\--
SAVE-LISP-AND-DIE instead of SAVE-LISP, and it supports fewer keyword
options than CMU CL's SAVE-LISP.
+(Why doesn't SBCL support more extensions? Why the hell did I (WHN)
+drop all those nice extensions from CMU CL when the code already
+exists? This is a frequently asked question on the mailing list. The
+answer is that they're hard to maintain, and I have enough on my hands
+already. Also, in the case of some big and unquestionably useful
+extensions, like sockets and Motif, I think that SBCL has done its job
+by supplying the FFI, and that people who need, and understand, and
+are motivated to maintain the functionality should supply it as a
+separate library, which I'd be happy to distribute or link to on the
+SBCL home page. Finally, in the case of multithreading, I do think it
+belongs in the new ANSI spec, and it'd be a good feature to have, but
+I didn't think the CMU CL implementation was sufficiently mature, and
+it's such a complicated and far-reaching extension that I thought that
+trying to fix it would interfere with the more urgent task of getting
+basic ANSI support up to speed.)
+
.SH THE COMPILER
SBCL inherits from CMU CL the "Python" native code compiler. This
the archives (available from the home page at
<http://sbcl.sourceforge.net/>) for information.
-As of version 0.6.8, SBCL requires on the order of 16Mb to run. In
+As of version 0.6.11, SBCL requires on the order of 16Mb to run. In
some future version, this number could shrink significantly, since
large parts of the system are far from execution bottlenecks and could
reasonably be stored in compact byte compiled form. (CMU CL does this
/etc/sbclrc and /usr/local/etc/sbclrc are the standard locations for
system-wide SBCL initialization files, unless overridden by the
-SBCL_HOME variable.
+SBCL_HOME variable or the --sysinit command line option.
+
$HOME/.sbclrc is the standard location for a user's SBCL
-initialization file.
+initialization file, unless overridden by the --userinit
+command line option.
.SH BUGS
-Too numerous to list, alas. This section attempts to list the most
-serious known bugs, and a reasonably representative sampling of
-others. For more information on bugs, see the BUGS file in the
-distribution.
+To report a bug, please send mail to sbcl-help@lists.sourceforge.net
+or sbcl-devel@lists.sourceforge.net. As with any software bug report,
+it's most helpful if you remember to describe the environment where
+the problem occurs (machine type, O/S name and version, etc.) and if
+you can provide enough information to reproduce the problem,
+preferably in compact form.
+
+This section attempts to list the most serious and long-standing bugs
+or surprising performance hits. For more detailed and current
+information on bugs, see the BUGS file in the distribution.
It is possible to get in deep trouble by exhausting
memory. To plagiarize a sadly apt description of a language not
processes to be killed randomly (!)
.PP
-The facility for dumping a running Lisp image to disk gets confused
-when run without the PURIFY option, and creates an unnecessarily large
-core file (apparently representing memory usage up to the previous
-high-water mark). Moreover, when the file is loaded, it confuses the
-GC, so that thereafter memory usage can never be reduced below that
-level.
-
The compiler is overaggressive about static typing, assuming that a
function's return type never changes. Thus compiling and loading a
file containing
then running (FOO 1) gives NOT-THIS-TIME, because the
never compiled code to check the declaration.
-The TRACE facility can't be used on some kinds of functions.
+The implementation of multidimensional arrays, especially
+multidimensional arrays of floating point numbers, is very
+inefficient.
-SYMBOL-FUNCTION is much slower than you'd expect, being implemented
-not as a slot access but as a search through the compiler/kernel
-"globaldb" database.
+SYMBOL-FUNCTION is much slower than you might expect, being
+implemented not as a slot access but as a search through the
+compiler/kernel "globaldb" database.
-CLOS (based on the PCL reference implementation) is quite slow.
+CLOS (based on the PCL reference implementation) is somewhat
+inefficient.
There are many nagging pre-ANSIisms, e.g.
.TP 3
\--
The DYNAMIC-EXTENT declaration is not implemented, and is simply
ignored. (This is allowed by the ANSI spec, but can have a large
-efficiency cost in some kinds of code.)
+efficiency cost in some kinds of code, e.g. code which uses a lot
+of upward closures or &REST lists.)
.TP 3
--
Compiling DEFSTRUCT in strange places (e.g. inside a DEFUN) doesn't
do anything like what it should.
.TP 3
\--
-The symbol * is the name of a type similar to T. (It's used as part
-of the implementation of compound types like (ARRAY * 1).)
+The symbol * is the name of a type similar to T. (It's used as part of
+the implementation of compound types like (ARRAY * 1) and (CONS * *).
+In a strict ANSI implementation, * would not be the name of a type,
+but instead just a symbol which is recognized and handled specially by
+certain type expanders.)
.PP
.SH SUPPORT
;;;(!def-debug-command "QUIT" ()
;;; (throw 'sb!impl::top-level-catcher nil))
-;;; CMU CL supported this GO debug command, but SBCL doesn't -- just
-;;; type the CONTINUE restart name.
+;;; CMU CL supported this GO debug command, but SBCL doesn't -- in
+;;; SBCL you just type the CONTINUE restart name instead (or "RESTART
+;;; CONTINUE", that's OK too).
+
;;;(!def-debug-command "GO" ()
;;; (continue *debug-condition*)
;;; (error "There is no restart named CONTINUE."))
;; desperate holdout is running this on a dumb terminal somewhere,
;; we tell him where to find the message stored as a string.
(format *debug-io*
- "~&~a~2%(The HELP string is stored in ~S.)~%"
+ "~&~A~2%(The HELP string is stored in ~S.)~%"
*debug-help-string*
'*debug-help-string*))
#+sb-doc
"Print a description of the object X."
(let ((stream (out-synonym-of stream-designator)))
- #+nil (fresh-line stream)
(pprint-logical-block (stream nil)
- (describe-object x stream)))
+ (fresh-line stream)
+ (describe-object x stream)
+ (fresh-line stream)))
(values))
\f
;;;; miscellaneous DESCRIBE-OBJECT methods
s
(type-specifier (sb-eval:interpreted-function-type x)))))
(when closure-p
- (format s "~@:_Its closure environment is:")
+ (format s "~@:_Its closure environment is:~%")
(pprint-logical-block (s nil)
(pprint-indent :current 2)
- (let ((clos (sb-eval:interpreted-function-closure x)))
- (dotimes (i (length clos))
- (format s "~@:_~S: ~S" i (svref clos i))))))
+ (let ((closure (sb-eval:interpreted-function-closure x)))
+ (dotimes (i (length closure))
+ (format s "~@:_~S: ~S" i (svref closure i))))))
(format s "~@:_Its definition is:~@:_ ~S" exp)))
;;; Print information from the debug-info about where CODE-OBJ was
(multiple-value-bind (symbol status)
(find-symbol (symbol-name x) package)
(declare (ignore symbol))
- (format s "~S is an ~(~A~) symbol in ~S."
+ (format s "~S is ~_an ~(~A~) symbol ~_in ~S."
x status (symbol-package x)))
- (format s "~S is an uninterned symbol." x)))
+ (format s "~S is ~_an uninterned symbol." x)))
;; TO DO: We could grovel over all packages looking for and
;; reporting other phenomena, e.g. IMPORT and SHADOW, or
;; availability in some package even after (SYMBOL-PACKAGE X) has
(format s "~@<Its current value is ~3I~:_~S.~:>"
(eval x))))
((boundp x)
- (format s "~@:_It is a ~A; its value is ~S." wot (symbol-value x)))
+ (format s "~@:_It is a ~A; its ~_value is ~S." wot (symbol-value x)))
((not (eq kind :global))
(format s "~@:_It is a ~A; no current value." wot)))
(when (eq (info :variable :where-from x) :declared)
- (format s "~@:_Its declared type is ~S."
+ (format s "~@:_Its declared type ~_is ~S."
(type-specifier (info :variable :type x))))
(%describe-doc x s 'variable kind))
;; TO DO: Print out other stuff from the INFO database:
;; * Does it name a type or class?
- ;; * Is it a structure accessor? (important since those are
+ ;; * Is it a structure accessor? (This is important since those are
;; magical in some ways, e.g. blasting the structure if you
- ;; redefine them)
+ ;; redefine them.)
;; Print other documentation.
(%describe-doc x s 'structure "Structure")
(*read-eval* t)
(*read-suppress* nil)
;; FIXME: It doesn't seem like a good idea to expose our
- ;; disaster-recovery *STANDARD-READTABLE* here. Perhaps we
- ;; should do a COPY-READTABLE? The consing would be unfortunate,
- ;; though.
+ ;; disaster-recovery *STANDARD-READTABLE* here. What if some
+ ;; enterprising user corrupts the disaster-recovery readtable
+ ;; by doing destructive readtable operations within
+ ;; WITH-STANDARD-IO-SYNTAX? Perhaps we should do a
+ ;; COPY-READTABLE? The consing would be unfortunate, though.
(*readtable* *standard-readtable*))
(funcall function)))
\f
slashification off."
(stringify-object object nil))
-;;; This produces the printed representation of an object as a string. The
-;;; few ...-TO-STRING functions above call this.
+;;; This produces the printed representation of an object as a string.
+;;; The few ...-TO-STRING functions above call this.
(defvar *string-output-streams* ())
(defun stringify-object (object &optional (*print-escape* *print-escape*))
(let ((stream (if *string-output-streams*
\f
;;;; circularity detection stuff
-;;; When *PRINT-CIRCLE* is T, this gets bound to a hash table that (eventually)
-;;; ends up with entries for every object printed. When we are initially
-;;; looking for circularities, we enter a T when we find an object for the
-;;; first time, and a 0 when we encounter an object a second time around.
-;;; When we are actually printing, the 0 entries get changed to the actual
-;;; marker value when they are first printed.
+;;; When *PRINT-CIRCLE* is T, this gets bound to a hash table that
+;;; (eventually) ends up with entries for every object printed. When
+;;; we are initially looking for circularities, we enter a T when we
+;;; find an object for the first time, and a 0 when we encounter an
+;;; object a second time around. When we are actually printing, the 0
+;;; entries get changed to the actual marker value when they are first
+;;; printed.
(defvar *circularity-hash-table* nil)
-;;; When NIL, we are just looking for circularities. After we have found them
-;;; all, this gets bound to 0. Then whenever we need a new marker, it is
-;;; incremented.
+;;; When NIL, we are just looking for circularities. After we have
+;;; found them all, this gets bound to 0. Then whenever we need a new
+;;; marker, it is incremented.
(defvar *circularity-counter* nil)
(defun check-for-circularity (object &optional assign)
(numberp object)
(characterp object)
(and (symbolp object) (symbol-package object) t))
- ;; If it a number, character, or interned symbol, we do not want
- ;; to check for circularity/sharing.
+ ;; If it a number, character, or interned symbol, we do not
+ ;; want to check for circularity/sharing.
(print-it stream))
((or *circularity-hash-table*
(consp object)
(typep object 'instance)
(typep object '(array t *)))
- ;; If we have already started circularity detection, this object
- ;; might be a sharded reference. If we have not, then if it is
- ;; a cons, a instance, or an array of element type t it might
- ;; contain a circular reference to itself or multiple shared
- ;; references.
+ ;; If we have already started circularity detection, this
+ ;; object might be a sharded reference. If we have not,
+ ;; then if it is a cons, a instance, or an array of element
+ ;; type t it might contain a circular reference to itself
+ ;; or multiple shared references.
(check-it stream))
(t
(print-it stream)))))
\f
;;;; symbols
-;;; Values of *PRINT-CASE* and (READTABLE-CASE *READTABLE*) the last time the
-;;; printer was called.
+;;; Values of *PRINT-CASE* and (READTABLE-CASE *READTABLE*) the last
+;;; time the printer was called.
(defvar *previous-case* nil)
(defvar *previous-readtable-case* nil)
-;;; This variable contains the current definition of one of three symbol
-;;; printers. SETUP-PRINTER-STATE sets this variable.
+;;; This variable contains the current definition of one of three
+;;; symbol printers. SETUP-PRINTER-STATE sets this variable.
(defvar *internal-symbol-output-function* nil)
;;; This function sets the internal global symbol
(output-symbol-name name stream))
(output-symbol-name (symbol-name object) stream nil)))
-;;; Output the string NAME as if it were a symbol name. In other words,
-;;; diddle its case according to *PRINT-CASE* and READTABLE-CASE.
+;;; Output the string NAME as if it were a symbol name. In other
+;;; words, diddle its case according to *PRINT-CASE* and
+;;; READTABLE-CASE.
(defun output-symbol-name (name stream &optional (maybe-quote t))
(declare (type simple-base-string name))
(setup-printer-state)
(when (zerop (aref *character-attributes* i))
(setf (aref *character-attributes* i) funny-attribute))))
-;;; For each character, the value of the corresponding element is the lowest
-;;; base in which that character is a digit.
+;;; For each character, the value of the corresponding element is the
+;;; lowest base in which that character is a digit.
(defvar *digit-bases*
(make-array char-code-limit
:element-type '(unsigned-byte 8)
TEST-SIGN ; At end, see whether it is a sign...
(return (not (test sign)))
- OTHER ; Not potential number, see whether funny chars...
+ OTHER ; not potential number, see whether funny chars...
(let ((mask (logxor (logior lowercase-attribute uppercase-attribute
funny-attribute)
letter-attribute)))
(when (test sign extension) (advance START-STUFF nil))
(return t)
- DOT-FOUND ; Leading dots...
+ DOT-FOUND ; leading dots...
(when (test letter) (advance START-DOT-MARKER nil))
(when (digitp) (advance DOT-DIGIT))
(when (test number other) (advance OTHER nil))
(when (char= current #\.) (advance DOT-FOUND))
(return t)
- START-STUFF ; Leading stuff before any dot or digit.
+ START-STUFF ; leading stuff before any dot or digit
(when (digitp)
(if (test letter)
(advance LAST-DIGIT-ALPHA)
(when (test sign extension slash) (advance START-STUFF nil))
(return t)
- START-MARKER ; Number marker in leading stuff...
+ START-MARKER ; number marker in leading stuff...
(when (test letter) (advance OTHER nil))
(go START-STUFF)
- START-DOT-STUFF ; Leading stuff containing dot w/o digit...
+ START-DOT-STUFF ; leading stuff containing dot w/o digit...
(when (test letter) (advance START-DOT-STUFF nil))
(when (digitp) (advance DOT-DIGIT))
(when (test sign extension dot slash) (advance START-DOT-STUFF nil))
(when (test number other) (advance OTHER nil))
(return t)
- START-DOT-MARKER ; Number marker in leading stuff w/ dot..
- ;; Leading stuff containing dot w/o digit followed by letter...
+ START-DOT-MARKER ; number marker in leading stuff w/ dot..
+ ;; leading stuff containing dot w/o digit followed by letter...
(when (test letter) (advance OTHER nil))
(go START-DOT-STUFF)
- DOT-DIGIT ; In a thing with dots...
+ DOT-DIGIT ; in a thing with dots...
(when (test letter) (advance DOT-MARKER))
(when (digitp) (advance DOT-DIGIT))
(when (test number other) (advance OTHER nil))
(when (test sign extension dot slash) (advance DOT-DIGIT))
(return t)
- DOT-MARKER ; Number maker in number with dot...
+ DOT-MARKER ; number marker in number with dot...
(when (test letter) (advance OTHER nil))
(go DOT-DIGIT)
- LAST-DIGIT-ALPHA ; Previous char is a letter digit...
+ LAST-DIGIT-ALPHA ; previous char is a letter digit...
(when (or (digitp) (test sign slash))
(advance ALPHA-DIGIT))
(when (test letter number other dot) (advance OTHER nil))
(return t)
- ALPHA-DIGIT ; Seen a digit which is a letter...
+ ALPHA-DIGIT ; seen a digit which is a letter...
(when (or (digitp) (test sign slash))
(if (test letter)
(advance LAST-DIGIT-ALPHA)
(when (test number other dot) (advance OTHER nil))
(return t)
- ALPHA-MARKER ; Number marker in number with alpha digit...
+ ALPHA-MARKER ; number marker in number with alpha digit...
(when (test letter) (advance OTHER nil))
(go ALPHA-DIGIT)
- DIGIT ; Seen only real numeric digits...
+ DIGIT ; seen only ordinary (non-alphabetic) numeric digits...
(when (digitp)
(if (test letter)
(advance ALPHA-DIGIT)
(when (char= current #\.) (advance DOT-DIGIT))
(return t)
- MARKER ; Number marker in a numeric number...
+ MARKER ; number marker in a numeric number...
(when (test letter) (advance OTHER nil))
(go DIGIT))))
\f
;;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION*
;;;;
;;;; Case hackery. These functions are stored in
-;;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION* according to the values of *PRINT-CASE*
-;;;; and READTABLE-CASE.
-
-;; Called when:
-;; READTABLE-CASE *PRINT-CASE*
-;; :UPCASE :UPCASE
-;; :DOWNCASE :DOWNCASE
-;; :PRESERVE any
+;;;; *INTERNAL-SYMBOL-OUTPUT-FUNCTION* according to the values of
+;;;; *PRINT-CASE* and READTABLE-CASE.
+
+;;; called when:
+;;; READTABLE-CASE *PRINT-CASE*
+;;; :UPCASE :UPCASE
+;;; :DOWNCASE :DOWNCASE
+;;; :PRESERVE any
(defun output-preserve-symbol (pname stream)
(declare (simple-string pname))
(write-string pname stream))
-;; Called when:
-;; READTABLE-CASE *PRINT-CASE*
-;; :UPCASE :DOWNCASE
+;;; called when:
+;;; READTABLE-CASE *PRINT-CASE*
+;;; :UPCASE :DOWNCASE
(defun output-lowercase-symbol (pname stream)
(declare (simple-string pname))
(dotimes (index (length pname))
(let ((char (schar pname index)))
(write-char (char-downcase char) stream))))
-;; Called when:
-;; READTABLE-CASE *PRINT-CASE*
-;; :DOWNCASE :UPCASE
+;;; called when:
+;;; READTABLE-CASE *PRINT-CASE*
+;;; :DOWNCASE :UPCASE
(defun output-uppercase-symbol (pname stream)
(declare (simple-string pname))
(dotimes (index (length pname))
(let ((char (schar pname index)))
(write-char (char-upcase char) stream))))
-;; Called when:
-;; READTABLE-CASE *PRINT-CASE*
-;; :UPCASE :CAPITALIZE
-;; :DOWNCASE :CAPITALIZE
+;;; called when:
+;;; READTABLE-CASE *PRINT-CASE*
+;;; :UPCASE :CAPITALIZE
+;;; :DOWNCASE :CAPITALIZE
(defun output-capitalize-symbol (pname stream)
(declare (simple-string pname))
(let ((prev-not-alpha t)
stream)
(setq prev-not-alpha (not (alpha-char-p char)))))))
-;; Called when:
-;; READTABLE-CASE *PRINT-CASE*
-;; :INVERT any
+;;; called when:
+;;; READTABLE-CASE *PRINT-CASE*
+;;; :INVERT any
(defun output-invert-symbol (pname stream)
(declare (simple-string pname))
(let ((all-upper t)
stream)))
\f
;;;; bignum printing
-;;;;
-;;;; written by Steven Handerson (based on Skef's idea)
-;;;;
-;;;; rewritten to remove assumptions about the length of fixnums for the
-;;;; MIPS port by William Lott
-;;; *BASE-POWER* holds the number that we keep dividing into the bignum for
-;;; each *print-base*. We want this number as close to *most-positive-fixnum*
-;;; as possible, i.e. (floor (log most-positive-fixnum *print-base*)).
+;;; *BASE-POWER* holds the number that we keep dividing into the
+;;; bignum for each *print-base*. We want this number as close to
+;;; *most-positive-fixnum* as possible, i.e. (floor (log
+;;; most-positive-fixnum *print-base*)).
(defparameter *base-power* (make-array 37 :initial-element nil))
-;;; *FIXNUM-POWER--1* holds the number of digits for each *print-base* that
-;;; fit in the corresponding *base-power*.
+;;; *FIXNUM-POWER--1* holds the number of digits for each *PRINT-BASE*
+;;; that fit in the corresponding *base-power*.
(defparameter *fixnum-power--1* (make-array 37 :initial-element nil))
-;;; Print the bignum to the stream. We first generate the correct value for
-;;; *base-power* and *fixnum-power--1* if we have not already. Then we call
-;;; bignum-print-aux to do the printing.
+;;; Print the bignum to the stream. We first generate the correct
+;;; value for *base-power* and *fixnum-power--1* if we have not
+;;; already. Then we call bignum-print-aux to do the printing.
(defun print-bignum (big stream)
(unless (aref *base-power* *print-base*)
(do ((power-1 -1 (1+ power-1))
(write-char #\) stream))
\f
;;;; float printing
-;;;;
-;;;; written by Bill Maddox
-;;; FLONUM-TO-STRING (and its subsidiary function FLOAT-STRING) does most of
-;;; the work for all printing of floating point numbers in the printer and in
-;;; FORMAT. It converts a floating point number to a string in a free or
-;;; fixed format with no exponent. The interpretation of the arguments is as
-;;; follows:
+;;; FLONUM-TO-STRING (and its subsidiary function FLOAT-STRING) does
+;;; most of the work for all printing of floating point numbers in the
+;;; printer and in FORMAT. It converts a floating point number to a
+;;; string in a free or fixed format with no exponent. The
+;;; interpretation of the arguments is as follows:
;;;
;;; X - The floating point number to convert, which must not be
;;; negative.
;;; POINT-POS - The position of the digit preceding the decimal
;;; point. Zero indicates point before first digit.
;;;
-;;; NOTE: FLONUM-TO-STRING goes to a lot of trouble to guarantee accuracy.
-;;; Specifically, the decimal number printed is the closest possible
-;;; approximation to the true value of the binary number to be printed from
-;;; among all decimal representations with the same number of digits. In
-;;; free-format output, i.e. with the number of digits unconstrained, it is
-;;; guaranteed that all the information is preserved, so that a properly-
-;;; rounding reader can reconstruct the original binary number, bit-for-bit,
-;;; from its printed decimal representation. Furthermore, only as many digits
-;;; as necessary to satisfy this condition will be printed.
+;;; NOTE: FLONUM-TO-STRING goes to a lot of trouble to guarantee
+;;; accuracy. Specifically, the decimal number printed is the closest
+;;; possible approximation to the true value of the binary number to
+;;; be printed from among all decimal representations with the same
+;;; number of digits. In free-format output, i.e. with the number of
+;;; digits unconstrained, it is guaranteed that all the information is
+;;; preserved, so that a properly- rounding reader can reconstruct the
+;;; original binary number, bit-for-bit, from its printed decimal
+;;; representation. Furthermore, only as many digits as necessary to
+;;; satisfy this condition will be printed.
;;;
-;;; FLOAT-STRING actually generates the digits for positive numbers. The
-;;; algorithm is essentially that of algorithm Dragon4 in "How to Print
-;;; Floating-Point Numbers Accurately" by Steele and White. The current
-;;; (draft) version of this paper may be found in [CMUC]<steele>tradix.press.
-;;; DO NOT EVEN THINK OF ATTEMPTING TO UNDERSTAND THIS CODE WITHOUT READING
-;;; THE PAPER!
+;;; FLOAT-STRING actually generates the digits for positive numbers.
+;;; The algorithm is essentially that of algorithm Dragon4 in "How to
+;;; Print Floating-Point Numbers Accurately" by Steele and White. The
+;;; current (draft) version of this paper may be found in
+;;; [CMUC]<steele>tradix.press. DO NOT EVEN THINK OF ATTEMPTING TO
+;;; UNDERSTAND THIS CODE WITHOUT READING THE PAPER!
(defvar *digits* "0123456789")
:fill-pointer 0
:adjustable t)))
;; Represent fraction as r/s, error bounds as m+/s and m-/s.
- ;; Rational arithmetic avoids loss of precision in subsequent calculations.
+ ;; Rational arithmetic avoids loss of precision in subsequent
+ ;; calculations.
(cond ((> exponent 0)
(setq r (ash fraction exponent))
(setq m- (ash 1 exponent))
(setq m+ m-))
((< exponent 0)
(setq s (ash 1 (- exponent)))))
- ;;adjust the error bounds m+ and m- for unequal gaps
+ ;; Adjust the error bounds m+ and m- for unequal gaps.
(when (= fraction (ash 1 precision))
(setq m+ (ash m+ 1))
(setq r (ash r 1))
(setq s (ash s 1)))
- ;;scale value by requested amount, and update error bounds
+ ;; Scale value by requested amount, and update error bounds.
(when scale
(if (minusp scale)
(let ((scale-factor (expt 10 (- scale))))
(setq r (* r scale-factor))
(setq m+ (* m+ scale-factor))
(setq m- (* m- scale-factor)))))
- ;;scale r and s and compute initial k, the base 10 logarithm of r
+ ;; Scale r and s and compute initial k, the base 10 logarithm of r.
(do ()
((>= r (ceiling s 10)))
(decf k)
((< (+ (ash r 1) m+) (ash s 1)))
(setq s (* s 10))
(incf k))
- ;;determine number of fraction digits to generate
+ ;; Determine number of fraction digits to generate.
(cond (fdigits
- ;;use specified number of fraction digits
+ ;; Use specified number of fraction digits.
(setq cutoff (- fdigits))
;;don't allow less than fmin fraction digits
(if (and fmin (> cutoff (- fmin))) (setq cutoff (- fmin))))
(width
- ;;use as many fraction digits as width will permit
- ;;but force at least fmin digits even if width will be exceeded
+ ;; Use as many fraction digits as width will permit but
+ ;; force at least fmin digits even if width will be
+ ;; exceeded.
(if (< k 0)
(setq cutoff (- 1 width))
(setq cutoff (1+ (- k width))))
(if (and fmin (> cutoff (- fmin))) (setq cutoff (- fmin)))))
- ;;If we decided to cut off digit generation before precision has
- ;;been exhausted, rounding the last digit may cause a carry propagation.
- ;;We can prevent this, preserving left-to-right digit generation, with
- ;;a few magical adjustments to m- and m+. Of course, correct rounding
- ;;is also preserved.
+ ;; If we decided to cut off digit generation before precision
+ ;; has been exhausted, rounding the last digit may cause a carry
+ ;; propagation. We can prevent this, preserving left-to-right
+ ;; digit generation, with a few magical adjustments to m- and
+ ;; m+. Of course, correct rounding is also preserved.
(when (or fdigits width)
(let ((a (- cutoff k))
(y s))
(setq m+ (max y m+))
(when (= m+ y) (setq roundup t))))
(when (< (+ (ash r 1) m+) (ash s 1)) (return)))
- ;;zero-fill before fraction if no integer part
+ ;; Zero-fill before fraction if no integer part.
(when (< k 0)
(setq decpnt digits)
(vector-push-extend #\. digit-string)
(dotimes (i (- k))
(incf digits) (vector-push-extend #\0 digit-string)))
- ;;generate the significant digits
+ ;; Generate the significant digits.
(do ()(nil)
(decf k)
(when (= k -1)
(if roundup
(setq high (>= (ash r 1) (- (ash s 1) m+)))
(setq high (> (ash r 1) (- (ash s 1) m+))))
- ;;stop when either precision is exhausted or we have printed as many
- ;;fraction digits as permitted
+ ;; Stop when either precision is exhausted or we have printed as
+ ;; many fraction digits as permitted.
(when (or low high (and cutoff (<= k cutoff))) (return))
(vector-push-extend (char *digits* u) digit-string)
(incf digits))
;; If cutoff occurred before first digit, then no digits are
;; generated at all.
(when (or (not cutoff) (>= k cutoff))
- ;;last digit may need rounding
+ ;; Last digit may need rounding
(vector-push-extend (char *digits*
(cond ((and low (not high)) u)
((and high (not low)) (1+ u))
(t (if (<= (ash r 1) s) u (1+ u)))))
digit-string)
(incf digits))
- ;;zero-fill after integer part if no fraction
+ ;; Zero-fill after integer part if no fraction.
(when (>= k 0)
(dotimes (i k) (incf digits) (vector-push-extend #\0 digit-string))
(vector-push-extend #\. digit-string)
(setq decpnt digits))
- ;;add trailing zeroes to pad fraction if fdigits specified
+ ;; Add trailing zeroes to pad fraction if fdigits specified.
(when fdigits
(dotimes (i (- fdigits (- digits decpnt)))
(incf digits)
(vector-push-extend #\0 digit-string)))
- ;;all done
+ ;; all done
(values digit-string (1+ digits) (= decpnt 0) (= decpnt digits) decpnt)))
-;;; Given a non-negative floating point number, SCALE-EXPONENT returns a new
-;;; floating point number Z in the range (0.1, 1.0] and an exponent E such
-;;; that Z * 10^E is (approximately) equal to the original number. There may
-;;; be some loss of precision due the floating point representation. The
-;;; scaling is always done with long float arithmetic, which helps printing of
-;;; lesser precisions as well as avoiding generic arithmetic.
+;;; Given a non-negative floating point number, SCALE-EXPONENT returns
+;;; a new floating point number Z in the range (0.1, 1.0] and an
+;;; exponent E such that Z * 10^E is (approximately) equal to the
+;;; original number. There may be some loss of precision due the
+;;; floating point representation. The scaling is always done with
+;;; long float arithmetic, which helps printing of lesser precisions
+;;; as well as avoiding generic arithmetic.
;;;
-;;; When computing our initial scale factor using EXPT, we pull out part of
-;;; the computation to avoid over/under flow. When denormalized, we must pull
-;;; out a large factor, since there is more negative exponent range than
-;;; positive range.
+;;; When computing our initial scale factor using EXPT, we pull out
+;;; part of the computation to avoid over/under flow. When
+;;; denormalized, we must pull out a large factor, since there is more
+;;; negative exponent range than positive range.
(defun scale-exponent (original-x)
(let* ((x (coerce original-x 'long-float)))
(multiple-value-bind (sig exponent) (decode-float x)
\f
;;;; entry point for the float printer
-;;; Entry point for the float printer as called by PRINT, PRIN1, PRINC,
-;;; etc. The argument is printed free-format, in either exponential or
+;;; the float printer as called by PRINT, PRIN1, PRINC, etc. The
+;;; argument is printed free-format, in either exponential or
;;; non-exponential notation, depending on its magnitude.
;;;
-;;; NOTE: When a number is to be printed in exponential format, it is scaled in
-;;; floating point. Since precision may be lost in this process, the
-;;; guaranteed accuracy properties of FLONUM-TO-STRING are lost. The
-;;; difficulty is that FLONUM-TO-STRING performs extensive computations with
-;;; integers of similar magnitude to that of the number being printed. For
-;;; large exponents, the bignums really get out of hand. If bignum arithmetic
-;;; becomes reasonably fast and the exponent range is not too large, then it
-;;; might become attractive to handle exponential notation with the same
-;;; accuracy as non-exponential notation, using the method described in the
+;;; NOTE: When a number is to be printed in exponential format, it is
+;;; scaled in floating point. Since precision may be lost in this
+;;; process, the guaranteed accuracy properties of FLONUM-TO-STRING
+;;; are lost. The difficulty is that FLONUM-TO-STRING performs
+;;; extensive computations with integers of similar magnitude to that
+;;; of the number being printed. For large exponents, the bignums
+;;; really get out of hand. If bignum arithmetic becomes reasonably
+;;; fast and the exponent range is not too large, then it might become
+;;; attractive to handle exponential notation with the same accuracy
+;;; as non-exponential notation, using the method described in the
;;; Steele and White paper.
;;; Print the appropriate exponent marker for X and the specified exponent.
(long-float #\L))
plusp exp))))
-;;; Write out an infinity using #. notation, or flame out if
-;;; *PRINT-READABLY* is true and *READ-EVAL* is false.
(defun output-float-infinity (x stream)
- (declare (type float x) (type stream stream))
+ (declare (float x) (stream stream))
(cond (*read-eval*
- (write-string "#." stream))
- (*print-readably*
- (error 'print-not-readable :object x))
- (t
- (write-string "#<" stream)))
- (write-string "EXT:" stream)
- (princ (float-format-name x) stream)
+ (write-string "#." stream))
+ (*print-readably*
+ (error 'print-not-readable :object x))
+ (t
+ (write-string "#<" stream)))
+ (write-string "SB-EXT:" stream)
+ (write-string (symbol-name (float-format-name x)) stream)
(write-string (if (plusp x) "-POSITIVE-" "-NEGATIVE-")
- stream)
+ stream)
(write-string "INFINITY" stream)
(unless *read-eval*
(write-string ">" stream)))
-;;; Output a #< NaN or die trying.
(defun output-float-nan (x stream)
(print-unreadable-object (x stream)
(princ (float-format-name x) stream)
;;;; bootstrapping the meta-braid
;;;;
-;;;; The code in this file takes the early definitions that have been saved
-;;;; up and actually builds those class objects. This work is largely driven
-;;;; off of those class definitions, but the fact that STANDARD-CLASS is the
-;;;; class of all metaclasses in the braid is built into this code pretty
-;;;; deeply.
+;;;; The code in this file takes the early definitions that have been
+;;;; saved up and actually builds those class objects. This work is
+;;;; largely driven off of those class definitions, but the fact that
+;;;; STANDARD-CLASS is the class of all metaclasses in the braid is
+;;;; built into this code pretty deeply.
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(setq *standard-method-combination* smc))))
;;; Initialize a class metaobject.
-;;;
-;;; FIXME: This and most stuff in this file is probably only needed at
-;;; init time.
(defun !bootstrap-initialize-class
(metaclass-name class name
class-eq-wrapper source direct-supers direct-subclasses cpl wrapper
(reverse (rest (class-precedence-list class)))))
(sb-kernel:register-layout layout :invalidate nil)
- ;; Subclasses of formerly forward-referenced-class may be unknown
- ;; to CL:FIND-CLASS and also anonymous. This functionality moved
- ;; here from (SETF FIND-CLASS).
+ ;; Subclasses of formerly forward-referenced-class may be
+ ;; unknown to CL:FIND-CLASS and also anonymous. This
+ ;; functionality moved here from (SETF FIND-CLASS).
(let ((name (class-name class)))
(setf (cl:find-class name) lclass
;; FIXME: It's nasty to use double colons. Perhaps the
;; messing with raw CLASS-%NAME)
(sb-kernel::class-%name lclass) name)))))
-(eval-when (:load-toplevel :execute)
-
- (clrhash *find-class*)
- (!bootstrap-meta-braid)
- (!bootstrap-accessor-definitions t)
- (!bootstrap-class-predicates t)
- (!bootstrap-accessor-definitions nil)
- (!bootstrap-class-predicates nil)
- (!bootstrap-built-in-classes)
-
- (dohash (name x *find-class*)
- (let* ((class (find-class-from-cell name x))
- (layout (class-wrapper class))
- (lclass (sb-kernel:layout-class layout))
- (lclass-pcl-class (sb-kernel:class-pcl-class lclass))
- (olclass (cl:find-class name nil)))
- (if lclass-pcl-class
- (aver (eq class lclass-pcl-class))
- (setf (sb-kernel:class-pcl-class lclass) class))
-
- (update-lisp-class-layout class layout)
-
- (cond (olclass
- (aver (eq lclass olclass)))
- (t
- (setf (cl:find-class name) lclass)))))
-
- (setq *boot-state* 'braid)
+(clrhash *find-class*)
+(!bootstrap-meta-braid)
+(!bootstrap-accessor-definitions t)
+(!bootstrap-class-predicates t)
+(!bootstrap-accessor-definitions nil)
+(!bootstrap-class-predicates nil)
+(!bootstrap-built-in-classes)
+
+(dohash (name x *find-class*)
+ (let* ((class (find-class-from-cell name x))
+ (layout (class-wrapper class))
+ (lclass (sb-kernel:layout-class layout))
+ (lclass-pcl-class (sb-kernel:class-pcl-class lclass))
+ (olclass (cl:find-class name nil)))
+ (if lclass-pcl-class
+ (aver (eq class lclass-pcl-class))
+ (setf (sb-kernel:class-pcl-class lclass) class))
+
+ (update-lisp-class-layout class layout)
+
+ (cond (olclass
+ (aver (eq lclass olclass)))
+ (t
+ (setf (cl:find-class name) lclass)))))
- ) ; EVAL-WHEN
+(setq *boot-state* 'braid)
(defmethod no-applicable-method (generic-function &rest args)
- ;; FIXME: probably could be ERROR instead of CERROR
- (cerror "Retry call to ~S."
- "There is no matching method for the generic function ~S~@
- when called with arguments ~S."
- generic-function
- args)
- (apply generic-function args))
+ (error "~@<There is no matching method for the generic function ~2I~_~S~
+ ~I~_when called with arguments ~2I~_~S.~:>"
+ generic-function
+ args))
"This is SBCL " SBCL_VERSION_STRING ", an implementation of ANSI Common Lisp.
SBCL is derived from the CMU CL system created at Carnegie Mellon University.
-Besides material created at Carnegie Mellon University, and material
-contributed by volunteers since its release into the public domain, CMU CL
-contained, and SBCL contains, material copyrighted by
- Massachusetts Institute of Technology, 1986;
- Symbolics, Inc., 1989, 1990, 1991, 1992; and
- Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990.
-More information about the origin of SBCL is available in the CREDITS file
-in the distribution.
+Besides software and documentation originally created at Carnegie Mellon
+University, SBCL contains some software originally from the Massachusetts
+Institute of Technology, Symbolics Incorporated, and Xerox Corporation, and
+material contributed by volunteers since the release of CMU CL into the
+public domain. See the CREDITS file in the distribution for more information.
SBCL is a free software system, provided as is, with absolutely no warranty.
-It is mostly public domain software, but also includes some software from
-MIT, Symbolics, and Xerox, used under BSD-style licenses which allow copying
-only under certain conditions. More information about copying SBCL is
-available in the COPYING file in the distribution.
+It is mostly in the public domain, but also includes some software copyrighted
+ Massachusetts Institute of Technology, 1986;
+ Symbolics, Inc., 1989, 1990, 1991, 1992; and
+ Xerox Corporation, 1985, 1986, 1987, 1988, 1989, 1990
+used under BSD-style licenses allowing copying only under certain conditions.
+See the COPYING file in the distribution for more information.
More information on SBCL is available at <http://sbcl.sourceforge.net/>.
");
;; (If you get a surprising failure here, maybe you were
;; just very unlucky; see the notes above.)
(error "bad SXHASH behavior for ~S ~S" i j))))
- #|
(dolist (i psxhash-tests)
(unless (typep (sb-int:psxhash i) '(and fixnum unsigned-byte))
(error "bad PSXHASH behavior for ~S" i))
;; (If you get a surprising failure here, maybe you were
;; just very unlucky; see the notes above.)
(error "bad PSXHASH behavior for ~S ~S" i j))))
- |#)))
+ )))
;;; success
(quit :unix-status 104)
--- /dev/null
+(in-package :cl-user)
+
+;;; We should be able to output X readably (at least when *READ-EVAL*).
+(defun assert-readable-output (x)
+ (assert (eql x
+ (let ((*read-eval* t))
+ (read-from-string (with-output-to-string (s)
+ (write x :stream s :readably t)))))))
+
+;;; Even when *READ-EVAL* is NIL, we should be able to output some
+;;; (not necessarily readable) representation without signalling an
+;;; error.
+(defun assert-unreadable-output (x)
+ (let ((*read-eval* nil))
+ (with-output-to-string (s) (write x :stream s :readably nil))))
+
+(defun assert-output (x)
+ (assert-readable-output x)
+ (assert-unreadable-output x))
+
+;;; Nathan Froyd reported that sbcl-0.6.11.34 screwed up output of
+;;; floating point infinities.
+(dolist (x (list short-float-positive-infinity short-float-negative-infinity
+ single-float-positive-infinity single-float-negative-infinity
+ double-float-positive-infinity double-float-negative-infinity
+ long-float-positive-infinity long-float-negative-infinity))
+ (assert-output x))
+
+;;; success
+(quit :unix-status 104)
;;; 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.34"
+"0.6.11.35"
projects / sbcl.git / commitdiff