From: William Harold Newman Date: Tue, 15 Jan 2002 19:00:54 +0000 (+0000) Subject: 0.pre7.133: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f6a2be77637d025bfded9430f02863c28f74f77a;p=sbcl.git 0.pre7.133: NJF patch I from sbcl-devel 2002-01-14: "Keywords are self-evaluating, right? They don't need to be quoted? Then I wonder why the writers of PCL felt it necessary to do so. This patch fixes that." NJF patch II from sbcl-devel 2002-01-14: "This patch does away with the strange business of the PUSHP argument to DEFINE-FOP (and DEFINE-COLD-FOP) being (MEMBER '(T NIL :NONE)) and implements the suggestion at the top of src/code/fop.lisp for fixing it." chased down ramifications of s/offs-hook-function/offs-hook-fun/, as per Alexei Dejneka broken disassembler bug report sbcl-devel 2001-01-14 the poor neglected user manual... ...added some information about compiler-only-ness in the introduction ...removed some "I'm sorry about this bug, give me time" stuff, since time has passed, and the bugs are gone:-) belatedly incremented fasl file version --- diff --git a/TODO b/TODO index e95b95a..da854a5 100644 --- a/TODO +++ b/TODO @@ -4,9 +4,8 @@ for 0.7.0: 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". diff --git a/doc/beyond-ansi.sgml b/doc/beyond-ansi.sgml index ff1cce5..4dbaa71 100644 --- a/doc/beyond-ansi.sgml +++ b/doc/beyond-ansi.sgml @@ -4,93 +4,17 @@ 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> @@ -101,24 +25,24 @@ principle, and its implications, and the bugs which still keep the 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</> @@ -132,10 +56,9 @@ maintained without keeping them from being GCed. And "finalization" 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> diff --git a/doc/intro.sgml b/doc/intro.sgml index 2f33f5f..67d3d54 100644 --- a/doc/intro.sgml +++ b/doc/intro.sgml @@ -5,50 +5,86 @@ 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 -If you are an experienced programmer in general but need -information on using &CommonLisp; in particular, ANSI Common -Lisp, by Paul Graham, is a good place to start. 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, Object-Oriented -Programming In Common Lisp by Sonya Keene is useful. - -Two very useful resources for working with any implementation of +Regardless of your ability level, two very useful resources +for working with any implementation of &CommonLisp; are the ILISP package for Emacs and the &CommonLisp; HyperSpec. +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. + +If you are an experienced programmer in other languages +but need to learn about Lisp, three books stand out. + + ANSI Common Lisp, by Paul Graham, + will teach you about most of the language. (And later it might + also be worth checking out On Lisp, by the same + author.) + 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. + + Neither of the books above emphasizes CLOS, but + 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. + + + + + -More Information on SBCL + +Where To Go For More Information On &SBCL; + +Before you read this user manual, you should probably read +two other things. + + You should know how to program in &CommonLisp;. + If you don't already know how, you should probably read a + book on it. + The Unix man page for &SBCL; will tell you + how to start the &SBCL; environment, so you can get to the + classic hello, world level of knowledge. It's the file + called sbcl.1 in the &SBCL; distribution. If &SBCL; is + installed on your system, you can read a formatted copy by + executing the command man sbcl. + + -Besides this manual, some other &SBCL;-specific information is -available: +Besides this user manual and the Unix man page, some +other &SBCL;-specific information is available: - There is a Unix man page file - sbcl.1 in the &SBCL; distribution, - describing command options and other usage information - for the Unix sbcl command which invokes - the &SBCL; system. + The + &SBCL; home page has some general + information, plus links to mailing lists devoted to &SBCL;, + and to archives of these mailing lists. 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 inspect) are documented in text available by typing help at their command prompts. The extensions for functions which - don't have their own command prompt (e.g. trace) - are described in their documentation strings, + don't have their own command prompt (like 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. - The - &SBCL; home page has some general - information, plus links to mailing lists devoted to &SBCL;, - and to archives of these mailing lists. Some low-level information describing the programming details of the conversion from &CMUCL; to &SBCL; is available in the doc/FOR-CMUCL-DEVELOPERS @@ -58,15 +94,17 @@ available: -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 @@ -100,11 +138,27 @@ collector (<quote>GC</>), which has various implications (mostly good) 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 diff --git a/doc/make-doc.sh b/doc/make-doc.sh index 4be93f8..eead940 100644 --- a/doc/make-doc.sh +++ b/doc/make-doc.sh @@ -1,13 +1,15 @@ #!/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 @@ -16,6 +18,14 @@ else 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 diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index a6259db..4c1fa80 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -38,7 +38,7 @@ ;;; 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 @@ -86,6 +86,9 @@ ;;; 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*)) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 417a12c..f2ec21c 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -4,24 +4,19 @@ ;;; 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) @@ -62,14 +57,15 @@ ;;; 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), @@ -105,15 +101,15 @@ ;;; 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))) @@ -152,21 +148,21 @@ (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"))) @@ -528,7 +524,7 @@ ;; 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)) @@ -546,7 +542,7 @@ ((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)) @@ -557,19 +553,19 @@ ;;;; 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)) @@ -578,12 +574,14 @@ (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))) ;;;; fops for loading functions @@ -595,10 +593,10 @@ ;;; 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) @@ -609,7 +607,7 @@ (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 @@ -631,7 +629,7 @@ bug.~:@>") (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) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index fa0dc2f..2a19595 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1706,26 +1706,28 @@ ;; 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) @@ -1758,14 +1760,14 @@ (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) @@ -2025,7 +2027,7 @@ ;;;; 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) @@ -2192,7 +2194,7 @@ *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*) @@ -2200,17 +2202,17 @@ ;;;; 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 @@ -2220,12 +2222,14 @@ (#.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) @@ -2243,7 +2247,7 @@ ;; (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))) @@ -2323,7 +2327,7 @@ (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)) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 8e042ee..0a6fa38 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -252,7 +252,7 @@ (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-) @@ -314,8 +314,8 @@ (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 @@ -858,7 +858,7 @@ ((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)))))) ;;; A SAP-MAKER is a no-argument function that returns a SAP. @@ -1236,8 +1236,8 @@ (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 @@ -1303,20 +1303,20 @@ (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))))))))) ;;; Return a list of the segments of memory containing machine code ;;; instructions for FUNCTION. diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 4c4de8d..284defd 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -328,8 +328,8 @@ bootstrapping. (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))) @@ -364,7 +364,7 @@ bootstrapping. `(,(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) @@ -1073,7 +1073,7 @@ bootstrapping. (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 @@ -1193,9 +1193,9 @@ bootstrapping. (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))) @@ -1203,7 +1203,7 @@ bootstrapping. (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)) @@ -1240,12 +1240,12 @@ bootstrapping. `(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)) @@ -1489,7 +1489,7 @@ bootstrapping. (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)) @@ -1722,7 +1722,7 @@ bootstrapping. (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)))) @@ -1830,8 +1830,8 @@ bootstrapping. 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 diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index 1f4af30..275b0ac 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -420,8 +420,8 @@ ;; 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)) diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp index 8ca68ca..6ab148a 100644 --- a/src/pcl/combin.lisp +++ b/src/pcl/combin.lisp @@ -74,7 +74,7 @@ (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 @@ -129,7 +129,7 @@ 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 @@ -143,7 +143,7 @@ (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)) diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index ea26bbf..4162031 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -53,7 +53,7 @@ (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." @@ -221,7 +221,7 @@ (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 diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index 0b7e01b..51c4b97 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -421,7 +421,7 @@ And so, we are saved. (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 diff --git a/src/pcl/fast-init.lisp b/src/pcl/fast-init.lisp index c3d28ab..fbd507d 100644 --- a/src/pcl/fast-init.lisp +++ b/src/pcl/fast-init.lisp @@ -51,7 +51,7 @@ (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)) @@ -88,7 +88,7 @@ (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)) @@ -141,7 +141,7 @@ (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)) @@ -180,12 +180,12 @@ (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)) @@ -391,8 +391,8 @@ (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)) @@ -431,7 +431,7 @@ (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)))))))) @@ -619,7 +619,7 @@ (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) @@ -856,9 +856,9 @@ `((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)) @@ -878,9 +878,9 @@ 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) diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index e65ce45..091c514 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -1204,7 +1204,7 @@ 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)))))) @@ -1224,7 +1224,7 @@ (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) diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index bad2c3a..9fc23ba 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -310,7 +310,7 @@ `(,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))) @@ -352,10 +352,10 @@ (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) @@ -369,10 +369,10 @@ (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) @@ -386,10 +386,10 @@ (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) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 8d16817..6b9f967 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -1040,7 +1040,7 @@ (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)) @@ -1060,7 +1060,7 @@ (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)) diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index 7dda26a..7008ec1 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -660,16 +660,16 @@ (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+) @@ -682,7 +682,7 @@ `(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)) @@ -695,16 +695,16 @@ &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))))))) @@ -720,7 +720,7 @@ ,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 @@ -742,17 +742,17 @@ &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))))))) @@ -762,7 +762,7 @@ `(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. ;;; @@ -1022,7 +1022,7 @@ (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))))) @@ -1063,7 +1063,7 @@ (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 diff --git a/version.lisp-expr b/version.lisp-expr index cb6b650..17d6b06 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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"