protruding rusty nails and snipped off the trailing razor wire,
leaving some filing for later:-) from the monster
EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup:
-* more renaming in global external names:
+* more renaming (esp. for global as opposed to lexical names):
** reserved DO-FOO-style names for iteration macros
- ** s/VARIABLE/VAR/
** s/ARGUMENT/ARG/
** perhaps s/DEF-FROB/DEF/ or s/DEF-FROB/DEFINE/
* Perhaps rename "cold" stuff (e.g. SB-COLD and src/cold/) to "boot".
<sect1 id="non-conformance"><title>Non-Conformance with the &ANSI; Standard</>
-<para>&SBCL; is derived from code which was written before the &ANSI;
-standard, and some incompatibilities remain.</para>
-
-<para>The &ANSI; standard defines constructs like
-<function>defstruct</>, <function>defun</>, and <function>declaim</>
-so that they can be implemented as macros which expand into ordinary
-code wrapped in <function>eval-when</> forms. However, the pre-&ANSI;
-&CMUCL; implementation handled these (and some related functions like
-<function>proclaim</>) as special cases in the compiler, with subtly
-(or sometimes not-so-subtly) different semantics. Much of this
-weirdness has been removed in the years since the &ANSI; standard was
-released, but bits and pieces remain, so that e.g., as of &SBCL; 0.6.3
-compiling the function
-
-<programlisting>(defun foo () (defstruct bar))</>
-
-will cause the class <type>BAR</> to be defined, even when the
-function is not executed. These remaining nonconforming behaviors are
-considered bugs, and clean patches will be gratefully accepted, but as
-long as they don't cause as many problems in practice as other known
-issues, they tend not to be actively fixed.</para>
-
-<para>More than any other &Lisp; system I am aware of, &SBCL; (and its
-parent &CMUCL;) store and use a lot of compile-time static type
-information. By and large they conform to the standard in doing so,
-but in one regard they do not — they consider <function>defun</>s to,
-in effect, implicitly <function>proclaim</> type information about the
-signature of the function being defined. Thus, if you compile and load
-
-<programlisting>(defun foo-p (x)
- (error "stub, foo-p ~s isn't implemented yet!" x))
-(defun foolike-p (x)
- (or (foo-p x) (foo-p (car x))))</programlisting>
-
-everything will appear to work correctly, but if you subsequently
-redefine <function>foo-p</>
-
-<programlisting>(defun foo-p (x) (or (null x) (symbolp (car x))))</>
-
-and call
-
-<programlisting>(foolike-p nil)</>
-
-you will not get the correct result, but an error,
-
-<screen>debugger invoked on SB-DEBUG:*DEBUG-CONDITION* of type
-SB-KERNEL:SIMPLE-CONTROL-ERROR:
- A function with declared result type NIL returned:
- FOO-P</screen>
-
-because when &SBCL; compiled <function>foolike-p</>, &SBCL; thought it
-knew that <function>foo-p</> would never return. More insidious
-problems are quite possible when &SBCL; thinks it can optimize away e.g.
-particular branches of a <function>case</> because of what it's proved
-to itself about the function's return type. This will probably be
-fixed in the foreseeable future, either with a quick fix, or ideally
-in conjunction with some related fixes to generalize the principle
-that declarations are assertions (see below). But for now it remains a
-gross violation of the &ANSI; spec (and reasonable user
-expectations).</para>
-
-<para>The &CMUCL; <function>defstruct</> implementation treated
-structure accessors and other <function>defstruct</>-related functions
-(e.g. predicates) as having some special properties, not quite like
-ordinary functions. This specialness has been reduced in &SBCL;, but
-some still remains. In particular, redefining a structure accessor
-function may magically cause the entire structure class to be deleted.
-This, too, will probably be fixed in the foreseeable future.</para>
-
-<para>The CLOS implementation used in &SBCL; is based on the
-<application>Portable Common Loops</> (PCL) reference implementation
-from Xerox. Unfortunately, PCL seems never to have quite conformed to
-the final CLOS specification. Moreover, despite the "Portable" in its
-name, it wasn't quite portable. Various implementation-specific hacks
-were made to make it run on &CMUCL;, and then more hacks were added to
-make it less inefficient. The result is a system with mostly tolerable
-performance which mostly conforms to the standard, but which has a few
-remaining weirdnesses which seem to be hard to fix. The most important
-remaining weirdness is that the <type>CL:CLASS</> class is not the
-same as the <type>SB-PCL:CLASS</> type used internally in PCL; and
-there are several other symbols maintained in parallel (e.g.
-<type>SB-PCL:FIND-CLASS</> vs. <type>CL:FIND-CLASS</>). So far, any
-problems this has caused have had workarounds involving consistently
-using the SB-PCL versions or the CL versions of the class hierarchy.
-This is admittedly ugly, but it may not be fixed in the foreseeable
-future, since the required cleanup looks nontrivial, and we don't have
-anyone sufficiently motivated to do it.</para>
+<para>
+This section is essentially a placeholder. There is are
+important areas of non-conformance, like the difference
+between <function>sb-pcl:find-class</> and <function>cl:class</>,
+but progress is made
+and the list changes and I've tired of trying to keep
+the information here up to date. For information on the
+highlights, try the bugs sections of the Unix man page.
+For more detailed information, try the BUGS file in the
+system distribution.
+</para>
</sect1>
compiler from quite satisfying this principle, are discussed in the
<link linkend="compiler">chapter on the compiler</link>.</para>
-<note><para>It's not an idiosyncrasy yet, since we haven't done
-it, but someday soon &SBCL; may become a compiler-only implementation.
-That is, essentially, <function>eval</> will be defined to create
-a lambda expression, call <function>compile</> on the lambda
-expression to create a compiled function, and then
-<function>funcall</> the resulting function. This would allow
-a variety of simplifications in the implementation, while introducing
-some other complexities. It remains to be seen when it will be
-possible to try this, or whether it will work well when it's tried,
-but it looks appealing right now.</para></note>
+<para>&SBCL; is essentially a compiler-only implementation of
+&CommonLisp;. That is, for all but a few special cases,
+<function>eval</> creates a
+lambda expression, calls <function>compile</> on the lambda
+expression to create a compiled function, and then calls
+<function>funcall</> on the resulting function object. This
+is explicitly allowed by the &ANSI; standard, but leads to some
+oddities, e.g. collapsing <function>functionp</> and
+<function>compiled-function-p</> into the same predicate.
+</para>
</sect1>
<sect1 id="extensions"><title>Extensions</>
-<para>&SBCL; is derived from &CMUCL;, which implements many extensions to the
-&ANSI; standard. &SBCL; doesn't support as many extensions as &CMUCL;, but
-it still has quite a few.</para>
+<para>&SBCL; is derived from &CMUCL;, which implements many extensions
+to the &ANSI; standard. &SBCL; doesn't support as many extensions as
+&CMUCL;, but it still has quite a few.</para>
<sect2><title>Things Which Might Be in the Next &ANSI; Standard</>
hooks are available to cause code to be executed when an object is
GCed.</para> <!-- FIXME: Actually documenting these would be good.:-| -->
-<para>&SBCL; does not currently provide Gray streams, but may do so in
-the near future. (It has unmaintained code inherited from &CMUCL; to
-do so.) <!-- FIXME: Add citation to Gray streams.-->
-</para>
+<para>&SBCL; supports Gray streams, user-overloadable CLOS classes
+whose instances can be used as Lisp streams (e.g. passed as the
+first argument to <function>format</>).</para>
</sect2>
specific to &SBCL;, not on behavior which is common to all
implementations of &ANSI; &CommonLisp;.</para>
-<sect1><title>More Information on &CommonLisp; in General</>
+<sect1 id="more-cl-info">
+<title>Where To Go For More Information on &CommonLisp; in General</title>
-<para>If you are an experienced programmer in general but need
-information on using &CommonLisp; in particular, <emphasis>ANSI Common
-Lisp</>, by Paul Graham, is a good place to start. <emphasis>Paradigms
-Of Artificial Intelligence Programming</>, by Peter Norvig, also has
-some good information on general &CommonLisp; programming, and many
-nontrivial examples. For CLOS in particular, <emphasis>Object-Oriented
-Programming In Common Lisp</> by Sonya Keene is useful.</para>
-
-<para>Two very useful resources for working with any implementation of
+<para>Regardless of your ability level, two very useful resources
+for working with any implementation of
&CommonLisp; are the
<ulink url="http://ilisp.cons.org"><application>ILISP</></ulink>
package for <application>Emacs</> and
<ulink url="http://www.harlequin.com/books/HyperSpec">the &CommonLisp;
HyperSpec</>.</para>
+<para>If you're not a programmer and you're trying to learn,
+many introductory Lisp books are available. However, we don't have any
+standout favorites. If you can't decide, try checking the Usenet
+comp.lang.lisp FAQ for recent recommendations.</para>
+
+<para>If you are an experienced programmer in other languages
+but need to learn about Lisp, three books stand out.
+<itemizedlist>
+ <listitem><para><emphasis>ANSI Common Lisp</>, by Paul Graham,
+ will teach you about most of the language. (And later it might
+ also be worth checking out <emphasis>On Lisp</>, by the same
+ author.)</para></listitem>
+ <listitem><para><emphasis>Paradigms Of Artificial Intelligence
+ Programming</>, by Peter Norvig, also has some good information
+ on general &CommonLisp; programming, and many nontrivial examples.
+ Whether or not your work is AI, it's a very good book to look
+ at.</para></listitem>
+ <listitem><para>
+ Neither of the books above emphasizes CLOS, but
+ <emphasis>Object-Oriented Programming In Common Lisp</> by Sonya Keene
+ does. Even if you're very knowledgeable about object oriented
+ programming in the abstract, it's worth looking at this book
+ if you want to do any OO in &CommonLisp;. Some abstractions
+ in CLOS (especially multiple dispatch) go beyond anything
+ you'll see in most OO systems, and there are a number of lesser
+ differences as well. This book tends to help with the culture shock.
+ </para></listitem>
+ <listitem><para></para></listitem>
+</itemizedlist>
+</para>
+
</sect1>
-<sect1><title>More Information on SBCL</title>
+<sect1>
+<title>Where To Go For More Information On &SBCL;</title>
+
+<para>Before you read this user manual, you should probably read
+two other things.
+<itemizedlist>
+ <listitem><para>You should know how to program in &CommonLisp;.
+ If you don't already know how, you should probably read a
+ <link linkend="more-cl-info">book on it</>.</para></listitem>
+ <listitem><para>The Unix <quote>man page</> for &SBCL; will tell you
+ how to start the &SBCL; environment, so you can get to the
+ classic <quote>hello, world</quote> level of knowledge. It's the file
+ called <filename>sbcl.1</> in the &SBCL; distribution. If &SBCL; is
+ installed on your system, you can read a formatted copy by
+ executing the command <command>man sbcl</>.</para></listitem>
+</itemizedlist>
+</para>
-<para>Besides this manual, some other &SBCL;-specific information is
-available:
+<para>Besides this user manual and the Unix man page, some
+other &SBCL;-specific information is available:
<itemizedlist>
- <listitem><para>There is a Unix <quote>man page</> file
- <filename>sbcl.1</> in the &SBCL; distribution,
- describing command options and other usage information
- for the Unix <function>sbcl</> command which invokes
- the &SBCL; system.</para></listitem>
+ <listitem><para>The <ulink url="http://sbcl.sourceforge.net/">
+ &SBCL; home page</ulink> has some general
+ information, plus links to mailing lists devoted to &SBCL;,
+ and to archives of these mailing lists.</para></listitem>
<listitem><para>Documentation for non-&ANSI; extensions for
various commands is available online from the &SBCL; executable
itself. The extensions for functions which have their own
command prompts (e.g. the debugger, and <function>inspect</>)
are documented in text available by typing <userinput>help</>
at their command prompts. The extensions for functions which
- don't have their own command prompt (e.g. <function>trace</>)
- are described in their documentation strings,
+ don't have their own command prompt (like <function>trace</>
+ does) are described in their documentation strings,
unless your &SBCL was compiled with an option not
to include documentation strings, in which case the doc strings
are only readable in the source code.</para></listitem>
- <listitem><para>The <ulink url="http://sbcl.sourceforge.net/">
- &SBCL; home page</ulink> has some general
- information, plus links to mailing lists devoted to &SBCL;,
- and to archives of these mailing lists.</para></listitem>
<listitem><para>Some low-level information describing the
programming details of the conversion from &CMUCL; to &SBCL;
is available in the <filename>doc/FOR-CMUCL-DEVELOPERS</>
</sect1>
-<sect1 id="implementation"><title>System Implementation and History</>
+<sect1 id="implementation">
+<title>Overview Of SBCL, How It Works And Where It Came From</>
-<para>You can work productively with SBCL without understanding
-anything about how it was and is implemented, but a little knowledge
-can be helpful in order to better understand error messages,
-troubleshoot problems, to understand why some parts of the system are
-better debugged than others, and to anticipate which known bugs, known
-performance problems, and missing extensions are likely to be fixed,
-tuned, or added.</para>
+<para>You can work productively with SBCL without knowing anything
+understanding anything about where it came from, how it is implemented,
+or how it extends the &ANSI; &CommonLisp; standard. However,
+a little knowledge can be helpful in order to understand error
+messages, to troubleshoot problems, to understand why some parts of
+the system are better debugged than others, and to anticipate which
+known bugs, known performance problems, and missing extensions are
+likely to be fixed, tuned, or added. </para>
<para>&SBCL; is descended from &CMUCL;, which is itself descended from
Spice Lisp. Early implementations for the Mach operating system on the
for performance. These are discussed in <link linkend="efficiency">
another chapter</link>.</para>
-<para>The direct ancestor of &SBCL; is the X86 port of &CMUCL;.
-This port is in some ways the least mature of any in the &CMUCL;
-system, and some things (like profiling and backtracing)
-do not work particularly well there. &SBCL; should be able
-to improve in these areas, but it may take a while.</para>
+<para>&SBCL; has diverged from &CMUCL; in that &SBCL; is now
+essentially a <quote>compiler-only implementation</quote> of
+&CommonLisp;. A &CommonLisp; implementation is permitted to implement
+both a compiler and an interpreter, and there's some special support
+in the standard (e.g. the distinction between <function>functionp</>
+and <function>compiled-function-p</>) to help support that. But &SBCL;
+has only a vestigial, rudimentary true interpreter. In &SBCL;, the
+<function>eval</> function only truly <quote>interprets</quote> a few
+special classes of forms, such as symbols which are
+<function>boundp</>. More complicated forms are evaluated by calling
+<function>compile</> and then calling <function>funcall</> on the
+returned result.
+<para>
+
+<para>The direct ancestor of &SBCL; is the X86 port of &CMUCL;. This
+port was in some ways the most cobbled-together of all the &CMUCL;
+ports, since a number of strange changes had to be made to support the
+register-poor X86 architecture. Some things (like tracing and
+debugging) do not work particularly well there. &SBCL; should be able
+to improve in these areas (and has already improved in some other
+areas), but it takes a while.</para>
<para>The &SBCL; GC, like the GC on the X86 port of &CMUCL;, is
<emphasis>conservative</>. This means that it doesn't maintain a
#!/bin/sh
+# Where is Jade? (i.e. James Clark's implementation of DSSSL, or
+# something offsprung)
if [ "" != "$JADE" ]; then
# The user has told us where to find jade, good.
- echo using $JADE
-elif which openjade; then
+ echo using JADE=$JADE
+elif which openjade > /dev/null; then
# OpenJade is the version of Jade which comes with OpenBSD 2.9,
# and I started using it in sbcl-0.pre7.x. -- WHN
JADE=openjade
-elif which jade; then
+elif which jade > /dev/null; then
# I used the original Jade until sbcl-0.pre7.x. It might still
# work. -- WHN
JADE=jade
exit 1
fi
+# Since Jade has strange ideas about the name of the top level output
+# file, use a symlink as a workaround to provide a reasonable entry
+# point.
+#
+# (KLUDGE: Why does the output always come out in book1.htm? According
+# to the docs of OpenJade 1.3, it should be coming out in
+# user-manual.htm by default, I think. And it should respect the -o
+# option. But experimentally that seems not to be. -- WHN 2002-01-15)
rm -f book1.htm
$JADE -t sgml -ihtml -d sbcl-html.dsl\#html user-manual.sgml
ln -sf book1.htm user-manual.html
;;; This value should be incremented when the system changes in such
;;; a way that it will no longer work reliably with old fasl files.
-(defconstant +fasl-file-version+ 21)
+(defconstant +fasl-file-version+ 22)
;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC.
;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot.
;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
;;; renamed, changes in globaldb representation of constants
;;; and inline functions, and change in the value of
;;; INTERNAL-TIME-UNITS-PER-SECOND
+;;; 22 = about a zillion changes between sbcl-0.pre7.62 and
+;;; sbcl-0.pre7.133, during which time it seemed too much
+;;; trouble to increment the counter
;;; the conventional file extension for our fasl files
(declaim (type simple-string *fasl-file-type*))
;;; Define NAME as a fasl operation, with op-code FOP-CODE. PUSHP
;;; describes what the body does to the fop stack:
-;;; :NOPE
-;;; The body neither pushes or pops the fop stack.
;;; T
;;; The body might pop the fop stack. The result of the body is
;;; pushed on the fop stack.
;;; NIL
;;; The body might pop the fop stack. The result of the body is
;;; discarded.
-;;;
-;;; FIXME: Make PUSHP into a &KEY argument accepting a booleana value.
-;;; Handle the :PUSHP :NOPE case with a separate :STACKP NIL argument,
-;;; meaning "the body doesn't interact with the FOP stack."
-(defmacro define-fop ((name fop-code &optional (pushp t)) &rest forms)
+;;; STACKP describes whether or not the body interacts with the fop stack.
+(defmacro define-fop ((name fop-code &key (pushp t) (stackp t)) &rest forms)
`(progn
(defun ,name ()
- ,(if (eq pushp :nope)
- `(progn ,@forms)
- `(with-fop-stack ,pushp ,@forms)))
+ ,(if stackp
+ `(with-fop-stack ,pushp ,@forms)
+ `(progn ,@forms)))
(%define-fop ',name ,fop-code)))
(defun %define-fop (name code)
;;; Some of this logic is already in DUMP-FOP*, but that still requires the
;;; caller to know that it's a 1-byte-arg/4-byte-arg cloned fop pair, and to
;;; know both the 1-byte-arg and the 4-byte-arg fop names. -- WHN 19990902
-(defmacro define-cloned-fops ((name code &optional (pushp t))
+(defmacro define-cloned-fops ((name code &key (pushp t) (stackp t))
(small-name small-code) &rest forms)
- (aver (member pushp '(nil t :nope)))
+ (aver (member pushp '(nil t)))
+ (aver (member stackp '(nil t)))
`(progn
(macrolet ((clone-arg () '(read-arg 4)))
- (define-fop (,name ,code ,pushp) ,@forms))
+ (define-fop (,name ,code :pushp ,pushp :stackp ,stackp) ,@forms))
(macrolet ((clone-arg () '(read-arg 1)))
- (define-fop (,small-name ,small-code ,pushp) ,@forms))))
+ (define-fop (,small-name ,small-code :pushp ,pushp :stackp stackp) ,@forms))))
;;; a helper function for reading string values from FASL files: sort
;;; of like READ-SEQUENCE specialized for files of (UNSIGNED-BYTE 8),
;;; into fasl files for debugging purposes. There's no shortage of
;;; unused fop codes, so we add this second NOP, which reads 4
;;; arbitrary bytes and discards them.
-(define-fop (fop-nop4 137 :nope)
+(define-fop (fop-nop4 137 :stackp nil)
(let ((arg (read-arg 4)))
(declare (ignorable arg))
#!+sb-show
(when *show-fop-nop4-p*
(format *debug-io* "~&/FOP-NOP4 ARG=~W=#X~X~%" arg arg))))
-(define-fop (fop-nop 0 :nope))
-(define-fop (fop-pop 1 nil) (push-fop-table (pop-stack)))
+(define-fop (fop-nop 0 :stackp nil))
+(define-fop (fop-pop 1 :pushp nil) (push-fop-table (pop-stack)))
(define-fop (fop-push 2) (svref *current-fop-table* (read-arg 4)))
(define-fop (fop-byte-push 3) (svref *current-fop-table* (read-arg 1)))
(name (pop-stack)))
(find-and-init-or-check-layout name length inherits depthoid)))
-(define-fop (fop-end-group 64 :nope)
+(define-fop (fop-end-group 64 :stackp nil)
(/show0 "THROWing FASL-GROUP-END")
(throw 'fasl-group-end t))
;;; In the normal loader, we just ignore these. GENESIS overwrites
;;; FOP-MAYBE-COLD-LOAD with something that knows whether to revert to
;;; cold-loading or not.
-(define-fop (fop-normal-load 81 :nope))
-(define-fop (fop-maybe-cold-load 82 :nope))
+(define-fop (fop-normal-load 81 :stackp nil))
+(define-fop (fop-maybe-cold-load 82 :stackp nil))
-(define-fop (fop-verify-table-size 62 :nope)
+(define-fop (fop-verify-table-size 62 :stackp nil)
(let ((expected-index (read-arg 4)))
(unless (= *current-fop-table-index* expected-index)
(error "internal error: fasl table of improper size"))))
-(define-fop (fop-verify-empty-stack 63 :nope)
+(define-fop (fop-verify-empty-stack 63 :stackp nil)
(unless (= *fop-stack-pointer* *fop-stack-pointer-on-entry*)
(error "internal error: fasl stack not empty when it should be")))
\f
;; fasl loading.
result))
-(define-fop (fop-eval-for-effect 54 nil)
+(define-fop (fop-eval-for-effect 54 :pushp nil)
(let ((result (eval (pop-stack))))
;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL.
(declare (ignore result))
((zerop n) (apply (pop-stack) args))
(declare (type index n))))))
-(define-fop (fop-funcall-for-effect 56 nil)
+(define-fop (fop-funcall-for-effect 56 :pushp nil)
(let ((arg (read-arg 1)))
(if (zerop arg)
(funcall (pop-stack))
\f
;;;; fops for fixing up circularities
-(define-fop (fop-rplaca 200 nil)
+(define-fop (fop-rplaca 200 :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4))
(val (pop-stack)))
(setf (car (nthcdr idx obj)) val)))
-(define-fop (fop-rplacd 201 nil)
+(define-fop (fop-rplacd 201 :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4))
(val (pop-stack)))
(setf (cdr (nthcdr idx obj)) val)))
-(define-fop (fop-svset 202 nil)
+(define-fop (fop-svset 202 :pushp nil)
(let* ((obi (read-arg 4))
(obj (svref *current-fop-table* obi))
(idx (read-arg 4))
(setf (%instance-ref obj idx) val)
(setf (svref obj idx) val))))
-(define-fop (fop-structset 204 nil)
+(define-fop (fop-structset 204 :pushp nil)
(setf (%instance-ref (svref *current-fop-table* (read-arg 4))
(read-arg 4))
(pop-stack)))
-(define-fop (fop-nthcdr 203 t)
+;;; In the original CMUCL code, this actually explicitly declared PUSHP
+;;; to be T, even though that's what it defaults to in DEFINE-FOP.
+(define-fop (fop-nthcdr 203)
(nthcdr (read-arg 4) (pop-stack)))
\f
;;;; fops for loading functions
;;; putting the implementation and version in required fields in the
;;; fasl file header.)
-(define-fop (fop-code 58 :nope)
+(define-fop (fop-code 58 :stackp nil)
(load-code (read-arg 4) (read-arg 4)))
-(define-fop (fop-small-code 59 :nope)
+(define-fop (fop-small-code 59 :stackp nil)
(load-code (read-arg 1) (read-arg 2)))
(define-fop (fop-fdefinition 60)
(sb!vm:sanctify-for-execution component)
component))
-(define-fop (fop-fset 74 nil)
+(define-fop (fop-fset 74 :pushp nil)
;; Ordinary, not-for-cold-load code shouldn't need to mess with this
;; at all, since it's only used as part of the conspiracy between
;; the cross-compiler and GENESIS to statically link FDEFINITIONs
(setf (fdefinition name) fn)))
;;; Modify a slot in a CONSTANTS object.
-(define-cloned-fops (fop-alter-code 140 nil) (fop-byte-alter-code 141)
+(define-cloned-fops (fop-alter-code 140 :pushp nil) (fop-byte-alter-code 141)
(let ((value (pop-stack))
(code (pop-stack)))
(setf (code-header-ref code (clone-arg)) value)
;; DEFINE-FOP) instead of creating a code, and
;;; (2) stores its definition in the *COLD-FOP-FUNS* vector,
;;; instead of storing in the *FOP-FUNS* vector.
-(defmacro define-cold-fop ((name &optional (pushp t)) &rest forms)
- (aver (member pushp '(nil t :nope)))
+(defmacro define-cold-fop ((name &key (pushp t) (stackp t)) &rest forms)
+ (aver (member pushp '(nil t)))
+ (aver (member stackp '(nil t)))
(let ((code (get name 'fop-code))
(fname (symbolicate "COLD-" name)))
(unless code
(error "~S is not a defined FOP." name))
`(progn
(defun ,fname ()
- ,@(if (eq pushp :nope)
- forms
- `((with-fop-stack ,pushp ,@forms))))
+ ,@(if stackp
+ `((with-fop-stack ,pushp ,@forms))
+ forms))
(setf (svref *cold-fop-funs* ,code) #',fname))))
-(defmacro clone-cold-fop ((name &optional (pushp t)) (small-name) &rest forms)
- (aver (member pushp '(nil t :nope)))
+(defmacro clone-cold-fop ((name &key (pushp t) (stackp t)) (small-name) &rest forms)
+ (aver (member pushp '(nil t)))
+ (aver (member stackp '(nil t)))
`(progn
(macrolet ((clone-arg () '(read-arg 4)))
- (define-cold-fop (,name ,pushp) ,@forms))
+ (define-cold-fop (,name :pushp ,pushp :stackp ,stackp) ,@forms))
(macrolet ((clone-arg () '(read-arg 1)))
- (define-cold-fop (,small-name ,pushp) ,@forms))))
+ (define-cold-fop (,small-name :pushp ,pushp :stackp ,stackp) ,@forms))))
;;; Cause a fop to be undefined in cold load.
(defmacro not-cold-fop (name)
(define-cold-fop (fop-empty-list) *nil-descriptor*)
(define-cold-fop (fop-truth) (cold-intern t))
-(define-cold-fop (fop-normal-load :nope)
+(define-cold-fop (fop-normal-load :stackp nil)
(setq *fop-funs* *normal-fop-funs*))
-(define-fop (fop-maybe-cold-load 82 :nope)
+(define-fop (fop-maybe-cold-load 82 :stackp nil)
(when *cold-load-filename*
(setq *fop-funs* *cold-fop-funs*)))
-(define-cold-fop (fop-maybe-cold-load :nope))
+(define-cold-fop (fop-maybe-cold-load :stackp nil))
(clone-cold-fop (fop-struct)
(fop-small-struct)
;;;; cold fops for loading numbers
(defmacro define-cold-number-fop (fop)
- `(define-cold-fop (,fop :nope)
+ `(define-cold-fop (,fop :stackp nil)
;; Invoke the ordinary warm version of this fop to push the
;; number.
(,fop)
*load-time-value-counter*
sb!vm:simple-vector-widetag)))
-(define-cold-fop (fop-funcall-for-effect nil)
+(define-cold-fop (fop-funcall-for-effect :pushp nil)
(if (= (read-arg 1) 0)
(cold-push (pop-stack)
*current-reversed-cold-toplevels*)
\f
;;;; cold fops for fixing up circularities
-(define-cold-fop (fop-rplaca nil)
+(define-cold-fop (fop-rplaca :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4)))
(write-memory (cold-nthcdr idx obj) (pop-stack))))
-(define-cold-fop (fop-rplacd nil)
+(define-cold-fop (fop-rplacd :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4)))
(write-wordindexed (cold-nthcdr idx obj) 1 (pop-stack))))
-(define-cold-fop (fop-svset nil)
+(define-cold-fop (fop-svset :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4)))
(write-wordindexed obj
(#.sb!vm:other-pointer-lowtag 2)))
(pop-stack))))
-(define-cold-fop (fop-structset nil)
+(define-cold-fop (fop-structset :pushp nil)
(let ((obj (svref *current-fop-table* (read-arg 4)))
(idx (read-arg 4)))
(write-wordindexed obj (1+ idx) (pop-stack))))
-(define-cold-fop (fop-nthcdr t)
+;;; In the original CMUCL code, this actually explicitly declared PUSHP
+;;; to be T, even though that's what it defaults to in DEFINE-COLD-FOP.
+(define-cold-fop (fop-nthcdr)
(cold-nthcdr (read-arg 4) (pop-stack)))
(defun cold-nthcdr (index obj)
;; (SETF CAR).
(make-hash-table :test 'equal))
-(define-cold-fop (fop-fset nil)
+(define-cold-fop (fop-fset :pushp nil)
(let* ((fn (pop-stack))
(cold-name (pop-stack))
(warm-name (warm-fun-name cold-name)))
(define-cold-code-fop fop-small-code (read-arg 1) (read-arg 2))
-(clone-cold-fop (fop-alter-code nil)
+(clone-cold-fop (fop-alter-code :pushp nil)
(fop-byte-alter-code)
(let ((slot (clone-arg))
(value (pop-stack))
\f
(defstruct (offs-hook (:copier nil))
(offset 0 :type offset)
- (function (missing-arg) :type function)
+ (fun (missing-arg) :type function)
(before-address nil :type (member t nil)))
(defstruct (segment (:conc-name seg-)
(fun-hooks nil :type list)
;; alist of (address . label-number), popped as it's used
- (cur-labels nil :type list) ;
- ;; list of offs-hook, popped as it's used
+ (cur-labels nil :type list)
+ ;; OFFS-HOOKs, popped as they're used
(cur-offs-hooks nil :type list)
;; for the current location
((null fun))
(let ((offset (code-offs-to-segment-offs (fun-offset fun) segment)))
(when (<= 0 offset length)
- (push (make-offs-hook :offset offset :function #'fun-header-hook)
+ (push (make-offs-hook :offset offset :fun #'fun-header-hook)
(seg-hooks segment))))))
\f
;;; A SAP-MAKER is a no-argument function that returns a SAP.
(let ((last-block-pc -1))
(flet ((add-hook (pc fun &optional before-address)
(push (make-offs-hook
- :offset pc ;; ##### FIX to account for non-zero offs in code
- :function fun
+ :offset pc ;; ### FIX to account for non-zero offs in code
+ :fun fun
:before-address before-address)
(seg-hooks segment))))
(handler-case
(storage-info-for-debug-fun debug-fun))
(add-source-tracking-hooks segment debug-fun sfcache)
(let ((kind (sb!di:debug-fun-kind debug-fun)))
- (flet ((anh (n)
+ (flet ((add-new-hook (n)
(push (make-offs-hook
:offset 0
- :function (lambda (stream dstate)
- (declare (ignore stream))
- (note n dstate)))
+ :fun (lambda (stream dstate)
+ (declare (ignore stream))
+ (note n dstate)))
(seg-hooks segment))))
(case kind
(:external)
((nil)
- (anh "no-arg-parsing entry point"))
+ (add-new-hook "no-arg-parsing entry point"))
(t
- (anh (lambda (stream)
- (format stream "~S entry point" kind)))))))))
+ (add-new-hook (lambda (stream)
+ (format stream "~S entry point" kind)))))))))
\f
;;; Return a list of the segments of memory containing machine code
;;; instructions for FUNCTION.
(class-name (class-of proto-method))
'standard-method)
initargs-form
- (getf (getf initargs ':plist)
- ':pv-table-symbol))))))))
+ (getf (getf initargs :plist)
+ :pv-table-symbol))))))))
(defun interned-symbol-p (x)
(and (symbolp x) (symbol-package x)))
`(,(car specl) ,(eval (cadr specl)))
specl))
specializers))
- (mname `(,(if (eq (cadr initargs-form) ':function)
+ (mname `(,(if (eq (cadr initargs-form) :function)
'method 'fast-method)
,name ,@qualifiers ,specls))
(mname-sym (intern (let ((*print-pretty* nil)
(next-method-p-p nil)) ; flag indicating that NEXT-METHOD-P
; should be in the method definition
(flet ((walk-function (form context env)
- (cond ((not (eq context ':eval)) form)
+ (cond ((not (eq context :eval)) form)
;; FIXME: Jumping to a conclusion from the way it's used
;; above, perhaps CONTEXT should be called SITUATION
;; (after the term used in the ANSI specification of
(defun load-defmethod
(class name quals specls ll initargs &optional pv-table-symbol)
(setq initargs (copy-tree initargs))
- (let ((method-spec (or (getf initargs ':method-spec)
+ (let ((method-spec (or (getf initargs :method-spec)
(make-method-spec name quals specls))))
- (setf (getf initargs ':method-spec) method-spec)
+ (setf (getf initargs :method-spec) method-spec)
(load-defmethod-internal class name quals specls
ll initargs pv-table-symbol)))
(method-class gf-spec qualifiers specializers lambda-list
initargs pv-table-symbol)
(when pv-table-symbol
- (setf (getf (getf initargs ':plist) :pv-table-symbol)
+ (setf (getf (getf initargs :plist) :pv-table-symbol)
pv-table-symbol))
(when (and (eq *boot-state* 'complete)
(fboundp gf-spec))
`(method ,gf-spec ,@qualifiers ,unparsed-specializers))
(defun initialize-method-function (initargs &optional return-function-p method)
- (let* ((mf (getf initargs ':function))
- (method-spec (getf initargs ':method-spec))
- (plist (getf initargs ':plist))
- (pv-table-symbol (getf plist ':pv-table-symbol))
+ (let* ((mf (getf initargs :function))
+ (method-spec (getf initargs :method-spec))
+ (plist (getf initargs :plist))
+ (pv-table-symbol (getf plist :pv-table-symbol))
(pv-table nil)
- (mff (getf initargs ':fast-function)))
+ (mff (getf initargs :fast-function)))
(flet ((set-mf-property (p v)
(when mf
(setf (method-function-get mf p) v))
(setq lambda-list (gf-lambda-list gf)))
(when (or lambda-list-p
(and first-p
- (eq (arg-info-lambda-list arg-info) ':no-lambda-list)))
+ (eq (arg-info-lambda-list arg-info) :no-lambda-list)))
(multiple-value-bind (nreq nopt keysp restp allow-other-keys-p keywords)
(analyze-lambda-list lambda-list)
(when (and methods (not first-p))
(let ((arg-info (if (eq *boot-state* 'complete)
(gf-arg-info gf)
(early-gf-arg-info gf))))
- (if (eq ':no-lambda-list (arg-info-lambda-list arg-info))
+ (if (eq :no-lambda-list (arg-info-lambda-list arg-info))
(let ((methods (if (eq *boot-state* 'complete)
(generic-function-methods gf)
(early-gf-methods gf))))
parsed ()))
(list :early-method ;This is an early method dammit!
- (getf initargs ':function)
- (getf initargs ':fast-function)
+ (getf initargs :function)
+ (getf initargs :fast-function)
parsed ;The parsed specializers. This is used
;by early-method-specializers to cache
;; that they will now update directly to NWRAPPER. This
;; corresponds to a kind of transitivity of wrapper updates.
(dolist (previous (gethash owrapper *previous-nwrappers*))
- (when (eq state ':obsolete)
- (setf (car previous) ':obsolete))
+ (when (eq state :obsolete)
+ (setf (car previous) :obsolete))
(setf (cadr previous) nwrapper)
(push previous new-previous))
(method (car cm-args)))
(when method
(if (if (listp method)
- (eq (car method) ':early-method)
+ (eq (car method) :early-method)
(method-p method))
(if method-alist-p
t
gf (car next-methods)
(list* (cdr next-methods) (cdr cm-args))
fmf-p method-alist wrappers))
- (arg-info (method-function-get fmf ':arg-info)))
+ (arg-info (method-function-get fmf :arg-info)))
(make-fast-method-call :function fmf
:pv-cell pv-cell
:next-method-call next
(gf method cm-args fmf-p &optional method-alist wrappers)
(when method
(if (if (listp method)
- (eq (car method) ':early-method)
+ (eq (car method) :early-method)
(method-p method))
(make-emf-from-method method cm-args gf fmf-p method-alist wrappers)
(if (and (consp method) (eq (car method) 'make-method))
(dolist (option options)
(if (not (listp option))
(error "~S is not a legal defclass option." option)
- (when (eq (car option) ':metaclass)
+ (when (eq (car option) :metaclass)
(unless (legal-class-name-p (cadr option))
(error "The value of the :metaclass option (~S) is not a~%~
legal class name."
(setq key (pop tail)
val (pop tail))
(push ``(,',key ,,(make-initfunction val) ,',val) canonical))
- `(':direct-default-initargs (list ,@(nreverse canonical))))))
+ `(:direct-default-initargs (list ,@(nreverse canonical))))))
(:documentation
`(',(car option) ',(cadr option)))
(otherwise
(let ((fmf (if (listp method)
(third method)
(method-fast-function method))))
- (method-function-get fmf ':slot-name-lists)))
+ (method-function-get fmf :slot-name-lists)))
;; KLUDGE: As of sbcl-0.6.4, it's very important for
;; efficiency to know the type of the sequence argument to
;; quantifiers (SOME/NOTANY/etc.) at compile time, but
(return nil))
(setq key (eval (pop initargs-tail)))
(setq value (pop initargs-tail))
- (when (eq ':allow-other-keys key)
+ (when (eq :allow-other-keys key)
(setq allow-other-keys-p value))
(push key keys))))
(let* ((class (eval class))
(walk-form form env
(lambda (subform context env)
(declare (ignore env))
- (or (and (eq context ':eval)
+ (or (and (eq context :eval)
(consp subform)
(eq (car subform) 'make-instance)
(expand-make-instance-form subform))
(cached-name (intern (format nil "~A-CACHED-~A" type name))))
`(defmacro ,reader-name (info)
`(let ((value (,',cached-name ,info)))
- (if (eq value ':unknown)
+ (if (eq value :unknown)
(progn
(,',trap ,info ',',name)
(,',cached-name ,info))
(defmacro reset-initialize-info-internal (info)
`(progn
,@(mapcar (lambda (cname)
- `(setf (,cname ,info) ':unknown))
+ `(setf (,cname ,info) :unknown))
',cached-names)))
(defun initialize-info-bound-slots (info)
(let ((slots nil))
,@(mapcar (lambda (name cached-name)
- `(unless (eq ':unknown (,cached-name info))
+ `(unless (eq :unknown (,cached-name info))
(push ',name slots)))
*initialize-info-cached-slots* cached-names)
slots))
(eq (car (method-specializers meth))
*the-class-slot-object*)
(and (null (cdr quals))
- (or (eq (car quals) ':before)
- (eq (car quals) ':after)))))))
+ (or (eq (car quals) :before)
+ (eq (car quals) :after)))))))
(and (every #'check-meth initialize-instance-methods)
(every #'check-meth shared-initialize-methods))))
(return-from get-make-instance-function nil))
(defun complicated-instance-creation-method (m)
(let ((qual (method-qualifiers m)))
(if qual
- (not (and (null (cdr qual)) (eq (car qual) ':after)))
+ (not (and (null (cdr qual)) (eq (car qual) :after)))
(let ((specl (car (method-specializers m))))
(or (not (classp specl))
(not (eq 'slot-object (class-name specl))))))))
(wrapper (class-wrapper class))
(constants (when simple-p
(make-list (wrapper-no-of-instance-slots wrapper)
- ':initial-element +slot-unbound+)))
+ :initial-element +slot-unbound+)))
(slots (class-slots class))
(slot-names (mapcar #'slot-definition-name slots))
(slots-key (mapcar (lambda (slot)
`((instance-write-internal pv slots ,(const pv-offset) value
,default
,(typecase location
- (fixnum ':instance)
- (cons ':class)
- (t ':default)))))))
+ (fixnum :instance)
+ (cons :class)
+ (t :default)))))))
(skip-when-instance-boundp
(let* ((pv-offset (cadr form))
(location (pvref pv pv-offset))
pv slots ,(const pv-offset)
,default
,(typecase (pvref pv pv-offset)
- (fixnum ':instance)
- (cons ':class)
- (t ':default))))
+ (fixnum :instance)
+ (cons :class)
+ (t :default))))
,@(let ((sforms (cons nil nil)))
(dotimes-fixnum (i (cadddr form) (car sforms))
(add-forms (first-form-to-lisp forms cvector pv)
meth generic-function))))
(cddr form)))
(default (car (last list))))
- (list (list* ':mcase mp (nbutlast list))
+ (list (list* :mcase mp (nbutlast list))
(cdr default))))
(t
(default-constant-converter form))))))
(defun convert-table (constant method-alist wrappers)
(cond ((and (consp constant)
- (eq (car constant) ':mcase))
+ (eq (car constant) :mcase))
(let ((alist (mapcar (lambda (k+m)
(cons (car k+m)
(convert-methods (cdr k+m)
`(,name ,(class-name class) ,(slot-definition-name slotd)))))
(defun make-internal-reader-method-function (class-name slot-name)
- (list* ':method-spec `(internal-reader-method ,class-name ,slot-name)
+ (list* :method-spec `(internal-reader-method ,class-name ,slot-name)
(make-method-function
(lambda (instance)
(let ((wrapper (get-instance-wrapper-or-nil instance)))
(instance-read-internal
.pv. instance-slots 1
(slot-value instance slot-name))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(reader-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(reader-method ,class-name ,slot-name)
initargs)))
(defun make-std-writer-method-function (class-name slot-name)
(instance-write-internal
.pv. instance-slots 1 nv
(setf (slot-value instance slot-name) nv))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list nil (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(writer-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(writer-method ,class-name ,slot-name)
initargs)))
(defun make-std-boundp-method-function (class-name slot-name)
(instance-boundp-internal
.pv. instance-slots 1
(slot-boundp instance slot-name))))))))
- (setf (getf (getf initargs ':plist) ':slot-name-lists)
+ (setf (getf (getf initargs :plist) :slot-name-lists)
(list (list nil slot-name)))
- (setf (getf (getf initargs ':plist) ':pv-table-symbol) pv-table-symbol)
- (list* ':method-spec `(boundp-method ,class-name ,slot-name)
+ (setf (getf (getf initargs :plist) :pv-table-symbol) pv-table-symbol)
+ (list* :method-spec `(boundp-method ,class-name ,slot-name)
initargs)))
(defun initialize-internal-slot-gfs (slot-name &optional type)
(sb-sys:without-interrupts
(update-lisp-class-layout class nwrapper)
(setf (slot-value class 'wrapper) nwrapper)
- (invalidate-wrapper owrapper ':flush nwrapper))))))
+ (invalidate-wrapper owrapper :flush nwrapper))))))
(defun flush-cache-trap (owrapper nwrapper instance)
(declare (ignore owrapper))
(sb-sys:without-interrupts
(update-lisp-class-layout class nwrapper)
(setf (slot-value class 'wrapper) nwrapper)
- (invalidate-wrapper owrapper ':obsolete nwrapper)
+ (invalidate-wrapper owrapper :obsolete nwrapper)
class)))
(defmethod make-instances-obsolete ((class symbol))
(defmacro instance-read-internal (pv slots pv-offset default &optional type)
(unless (member type '(nil :instance :class :default))
(error "illegal type argument to ~S: ~S" 'instance-read-internal type))
- (if (eq type ':default)
+ (if (eq type :default)
default
(let* ((index (gensym))
(value index))
`(locally (declare #.*optimize-speed*)
(let ((,index (pvref ,pv ,pv-offset)))
(setq ,value (typecase ,index
- ,@(when (or (null type) (eq type ':instance))
+ ,@(when (or (null type) (eq type :instance))
`((fixnum (clos-slots-ref ,slots ,index))))
- ,@(when (or (null type) (eq type ':class))
+ ,@(when (or (null type) (eq type :class))
`((cons (cdr ,index))))
(t +slot-unbound+)))
(if (eq ,value +slot-unbound+)
`(instance-read-internal .pv. ,(slot-vector-symbol position)
,pv-offset (accessor-slot-value ,parameter ,slot-name)
,(if (generate-fast-class-slot-access-p class slot-name)
- ':class ':instance))))
+ :class :instance))))
(defmacro instance-reader (pv-offset parameter position gf-name class)
(declare (ignore class))
&optional type)
(unless (member type '(nil :instance :class :default))
(error "illegal type argument to ~S: ~S" 'instance-write-internal type))
- (if (eq type ':default)
+ (if (eq type :default)
default
(let* ((index (gensym)))
`(locally (declare #.*optimize-speed*)
(let ((,index (pvref ,pv ,pv-offset)))
(typecase ,index
- ,@(when (or (null type) (eq type ':instance))
+ ,@(when (or (null type) (eq type :instance))
`((fixnum (setf (clos-slots-ref ,slots ,index)
,new-value))))
- ,@(when (or (null type) (eq type ':class))
+ ,@(when (or (null type) (eq type :class))
`((cons (setf (cdr ,index) ,new-value))))
(t ,default)))))))
,pv-offset ,new-value
(accessor-set-slot-value ,parameter ,slot-name ,new-value)
,(if (generate-fast-class-slot-access-p class slot-name)
- ':class ':instance))))
+ :class :instance))))
(defmacro instance-writer (pv-offset
parameter
&optional type)
(unless (member type '(nil :instance :class :default))
(error "illegal type argument to ~S: ~S" 'instance-boundp-internal type))
- (if (eq type ':default)
+ (if (eq type :default)
default
(let* ((index (gensym)))
`(locally (declare #.*optimize-speed*)
(let ((,index (pvref ,pv ,pv-offset)))
(typecase ,index
- ,@(when (or (null type) (eq type ':instance))
+ ,@(when (or (null type) (eq type :instance))
`((fixnum (not (and ,slots
(eq (clos-slots-ref ,slots ,index)
+slot-unbound+))))))
- ,@(when (or (null type) (eq type ':class))
+ ,@(when (or (null type) (eq type :class))
`((cons (not (eq (cdr ,index) +slot-unbound+)))))
(t ,default)))))))
`(instance-boundp-internal .pv. ,(slot-vector-symbol position)
,pv-offset (accessor-slot-boundp ,parameter ,slot-name)
,(if (generate-fast-class-slot-access-p class slot-name)
- ':class ':instance))))
+ :class :instance))))
;;; This magic function has quite a job to do indeed.
;;;
(when (eq arg '&aux) (return nil))
(incf nreq)(push arg args))
(setq args (nreverse args))
- (setf (getf (getf initargs ':plist) ':arg-info) (cons nreq restp))
+ (setf (getf (getf initargs :plist) :arg-info) (cons nreq restp))
(make-method-initargs-form-internal1
initargs (cddr lmf) args lmf-params restp)))))
(defun method-function-from-fast-function (fmf)
(declare (type function fmf))
(let* ((method-function nil) (pv-table nil)
- (arg-info (method-function-get fmf ':arg-info))
+ (arg-info (method-function-get fmf :arg-info))
(nreq (car arg-info))
(restp (cdr arg-info)))
(setq method-function
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.132"
+"0.pre7.133"
projects / sbcl.git / commitdiff