From b0b168c08b31a748150f404398af754f26fd4813 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 15 Jan 2002 01:06:08 +0000 Subject: [PATCH] (I seem to've screwed up during the checkin of 0.pre7.131 before, so that it's log message got lost. So this checkin has two log messages, .131 for the changes in the previous checkin and .132 for the changes in this checkin.) 0.pre7.131: s/variable/var/ in... ...fun-variable ...symbol-variable ...find-variable ...variables*\* ...make-variable ...iteration-variable ...declare-variable ...when-it-variable ...named-variable ...1-variable ...compute-variable ...minimal-variable ...free-variable ...let-variable ...lexenv-variable ...(not set-variable because there's already a VAR slot for the SET structure type, gah, so try s/set-variable/setq-var/) ...convert-variable s/lexenv-functions/lexenv-funs/ Rename NAMED-VAR function to LOOP-NAMED-VAR, for consistency with other LOOP operators and with the LOOP comments which refer to LOOP-NAMED-VAR. 0.pre7.132: learning that I don't even get people's *names* right in CREDITS:-( addressed APD bug report 2001-01-13... ...made a BUGS entry for pretty-printing nested backquotes ...scattered references to compiler-only implementation through doc/sbcl.1 other corrections and tweaks in doc/sbcl.1 --- BUGS | 8 + CREDITS | 4 +- TODO | 5 +- doc/sbcl.1 | 426 +++++++++++++++++++++---------------- package-data-list.lisp-expr | 4 +- src/code/debug-info.lisp | 4 +- src/code/debug-int.lisp | 17 +- src/code/debug.lisp | 2 +- src/code/early-setf.lisp | 2 +- src/code/loop.lisp | 189 ++++++++-------- src/code/macroexpand.lisp | 2 +- src/compiler/debug-dump.lisp | 24 +-- src/compiler/debug.lisp | 7 +- src/compiler/early-c.lisp | 8 +- src/compiler/info-functions.lisp | 4 +- src/compiler/ir1-translators.lisp | 46 ++-- src/compiler/ir1tran.lisp | 56 +++-- src/compiler/ir1util.lisp | 7 +- src/compiler/lexenv.lisp | 12 +- src/compiler/macros.lisp | 2 +- src/compiler/main.lisp | 10 +- src/compiler/proclaim.lisp | 4 +- src/pcl/walk.lisp | 42 ++-- version.lisp-expr | 2 +- 24 files changed, 474 insertions(+), 413 deletions(-) diff --git a/BUGS b/BUGS index 51b93a6..5934e31 100644 --- a/BUGS +++ b/BUGS @@ -1233,6 +1233,14 @@ Error in function C::GET-LAMBDA-TO-COMPILE: T T +141: + Pretty-printing nested backquotes doesn't work right, as + reported by Alexey Dejneka sbcl-devel 2002-01-13: + * '``(FOO ,@',@S) + ``(FOO SB-IMPL::BACKQ-COMMA-AT S) + * (lisp-implementation-version) + "0.pre7.129" + KNOWN BUGS RELATED TO THE IR1 INTERPRETER diff --git a/CREDITS b/CREDITS index 51f0f9a..71f44f7 100644 --- a/CREDITS +++ b/CREDITS @@ -549,7 +549,7 @@ Bill Newman: updating documentation, and even, for better or worse, getting rid of various functionality (e.g. the byte interpreter). -Christopher Rhodes: +Christophe Rhodes: He has done various low-level work on SBCL, especially for the SPARC port (and for CPU-architecture-neutral things motivated by it, like *BACKEND-FEATURES*). He's also contributed miscellaneous @@ -587,5 +587,5 @@ APD Alexey Dejneka NJF Nathan Froyd RAM Robert MacLachlan WHN William ("Bill") Newman -CSR Christopher Rhodes +CSR Christophe Rhodes PVE Peter Van Eynde diff --git a/TODO b/TODO index 2eb9781..e95b95a 100644 --- a/TODO +++ b/TODO @@ -6,8 +6,8 @@ for 0.7.0: EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup: * more renaming in global external names: ** reserved DO-FOO-style names for iteration macros - ** finished s/FUNCTION/FUN/ ** 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". * pending patches and bug reports that go in (or else get handled @@ -26,6 +26,9 @@ for early 0.7.x: besides CLISPiosyncrasies, I'm reasonably motivated to do it. * urgent EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup: ** made inlining DEFUN inside MACROLET work again + ** (also, while working on INLINE anyway, it should be easy + to flush the old MAYBE-INLINE cruft entirely, + including e.g. on the man page) ** fixed bug 137 (more) * faster bootstrapping (both make.sh and slam.sh) ** added mechanisms for automatically finding dead code, and diff --git a/doc/sbcl.1 b/doc/sbcl.1 index acbf1c6..92eb13f 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -25,6 +25,179 @@ the free CMU CL programming environment. (The name is intended to acknowledge the connection: steel and banking are the industries where Carnegie and Mellon made the big bucks.) +It is free software, mostly in the public domain, but with some +subsystems under BSD-style licenses which allow modification and +reuse as long as credit is given. It is provided "as is", with no +warranty of any kind. + +For more information about license issues, see the COPYING file in +the distribution. For more information about history, see the +CREDITS file in the distribution. + +.SH RUNNING SBCL + +To run SBCL, type "sbcl" at the command line with no arguments. (SBCL +understands command line arguments, but you probably won't need to use +them unless you're a fairly advanced user, in which case you should +read the COMMAND LINE SYNTAX section, below.) You should see some +startup messages, then a prompt ("*"). Type a Lisp expression at the +prompt, and SBCL will read it, execute it, print the result, +give you another prompt, and wait for your next input. E.g. + * (+ 1 2 3) + 6 + * + +Many people like to run SBCL, like other Lisp systems, as a subprocess +under Emacs. The Emacs "ilisp" mode provides many convenient features, +like command line editing, tab completion, and various kinds of +coupling between Common Lisp source files and the interactive SBCL +subprocess. + +.SH OVERVIEW + +SBCL aims for but has not reached ANSI compliance. + +SBCL compiles Common Lisp to native code, and is essentially a +"compiler-only" implementation of the ANSI standard. (Unlike earlier +versions of SBCL, byte compilation is no longer supported, and there +is only a vestigial interpreter. Thus, in particular, +COMPILED-FUNCTION-P is always equal to FUNCTIONP.) + +SBCL uses a generational conservative garbage collector for some ports, +and a simple stop-and-copy garbage collector for other ports. + +SBCL also includes some non-ANSI extensions, notably + * Lispy extensions: + ** CMU-CL-style safe implementation of type declarations: + "Declarations are assertions." + ** source level debugger + ** profiler + ** saving the state of the running SBCL process, producing a + "core" file which can be restarted later + ** Gray streams (overloadable CLOS classes whose instances can + be used wherever ANSI streams can be used) + ** weak pointers and finalization (which have unfortunately + suffered from at least some code rot, e.g. weak hash tables + don't work) + * system interface extensions: + ** calling out to C code (a.k.a. FFI, foreign function interface) + ** some simple support for operations with a "scripting language" + flavor, e.g. reading POSIX argc and argv, or executing a + subprogram + +.SH DIFFERENCES FROM CMU CL + +SBCL can be built from scratch using a plain vanilla ANSI Common Lisp +system and a C compiler, and all of its properties are specified by +the version of the source code that it was created from. (This clean +bootstrappability was the immediate motivation for forking off of the +CMU CL development tree.) A variety of internal implementation +differences are motivated by this. + +Maintenance work in SBCL since the fork has diverged in various +details from the maintenance work in CMU CL. E.g. as of 2001-04-12, +SBCL was more ANSI-compliant than CMU CL in various details such as +support for PRINT-OBJECT and DESCRIBE-OBJECT, and SBCL's compiler was +substantially better than CMU CL's at optimizing operations on +non-simple vectors. + +Most extensions supported by CMU CL are not supported in SBCL, +including Motif support, the Hemlock editor, search paths, the +low-level Unix interface, the WIRE protocol, multithreading support, +various user-level macros and functions (e.g. LETF, ITERATE, MEMQ, +REQUIRED-ARGUMENT), and many others. + +SBCL has retained some extensions from parent CMU CL. Many of the +retained extensions are in these categories: +.TP 3 +\-- +things which might be in the new ANSI spec, e.g. weak pointers, +finalization, foreign function interface to C, and Gray streams +.TP 3 +\-- +things which are universally available in Unix scripting languages, +e.g. RUN-PROGRAM and POSIX argv and getenv +.TP 3 +\-- +hooks into the low level workings of the system which can be useful +for debugging, e.g. a list of functions to be run whenever GC occurs, +or parameters to modify compiler diagnostic output +.TP 3 +\-- +unportable performance hacks, e.g. TRULY-THE, FREEZE-TYPE, and PURIFY +.PP + +There are also a few retained extensions which don't fall into +any particular category, e.g. +.TP 3 +\-- +the ability to save running Lisp images as executable files +.PP + +Some of the retained extensions have new names and/or different +options than their CMU CL counterparts. For example, the SBCL function +which saves a Lisp image to disk and kills it is called +SAVE-LISP-AND-DIE instead of SAVE-LISP, and it supports fewer keyword +options than CMU CL's SAVE-LISP. + +(Why doesn't SBCL support more extensions? Why the hell did I (WHN) +drop all those nice extensions from CMU CL when the code already +exists? This is a frequently asked question on the mailing list. The +answer is that they're hard to maintain, and I have enough on my hands +already. Also, in the case of some big and unquestionably useful +extensions, like sockets and Motif, I think that SBCL has done its job +by supplying the FFI, and that people who need, and understand, and +are motivated to maintain the functionality should supply it as a +separate library, which I'd be happy to distribute or link to on the +SBCL home page. Finally, in the case of multithreading, I do think it +belongs in the new ANSI spec, and it'd be a good feature to have, but +I didn't think the CMU CL implementation was sufficiently mature, and +it's such a complicated and far-reaching extension that I thought that +trying to fix it would interfere with the more urgent task of getting +basic ANSI support up to speed.) + +.SH THE COMPILER + +As noted above, SBCL is essentially a compiler-only implementation of +Lisp, with all nontrivial code being implemented by compilation, even +when you type it interactively at the "interpreter" prompt. + +SBCL inherits from CMU CL the "Python" native code compiler. (Though +we've essentially dropped the name to avoid confusion with the +scripting language also called Python.) This compiler is very clever +about understanding the type system of Common Lisp and using it to +optimize code, and about producing notes to let the user know when the +compiler doesn't have enough type information to produce efficient +code. It also tries (almost always successfully) to follow the unusual +but very useful principle that "declarations are assertions", i.e. +type declarations should be checked at runtime unless the user +explicitly tells the system that speed is more important than safety. + +The CMU CL version of this compiler reportedly produces pretty good +code for modern CPU architectures which have lots of registers, but +its code for the X86 is marred by a lot of extra loads and stores to +stack-based temporary variables. Because of this, and because of the +extra levels of indirection in Common Lisp relative to C, the +performance of SBCL isn't going to impress people who are impressed by +small constant factors. However, even on the X86 it tends to be faster +than byte interpreted languages (and can be a lot faster). + +For more information about the compiler, see the user manual. + +.SH DOCUMENTATION + +Currently, the documentation for the system is +.TP 3 +\-- +this man page +.TP 3 +\-- +the user manual +.TP 3 +\-- +doc strings and online help built into the SBCL executable +.PP + .SH COMMAND LINE SYNTAX Command line syntax can be considered an advanced topic; for ordinary @@ -132,134 +305,14 @@ involved) toplevel options and any --end-toplevel-options option are stripped out of the command line argument list before user code gets a chance to see it. -.SH OVERVIEW - -SBCL aims for but has not reached ANSI compliance. - -SBCL compiles Lisp to native code. (Unlike earlier versions of SBCL, -byte compilation is no longer supported.) - -SBCL uses a generational conservative garbage collector for some ports, -and a simple stop-and-copy garbage collector for other ports. - -SBCL includes a source level debugger, as well as the ANSI TRACE -facility and a profiler. - -.SH DIFFERENCES FROM CMU CL - -SBCL can be built from scratch using a plain vanilla ANSI Common Lisp -system and a C compiler, and all of its properties are specified by -the version of the source code that it was created from. (This clean -bootstrappability was the immediate motivation for forking off of the -CMU CL development tree.) A variety of internal implementation -differences are motivated by this. - -Maintenance work in SBCL since the fork has diverged in various -details from the maintenance work in CMU CL. E.g. as of 2001-04-12, -SBCL was more ANSI-compliant than CMU CL in various details such as -support for PRINT-OBJECT and DESCRIBE-OBJECT, and SBCL's compiler was -substantially better than CMU CL's at optimizing operations on -non-simple vectors. - -Most extensions supported by CMU CL are not supported in SBCL, -including Motif support, the Hemlock editor, search paths, the -low-level Unix interface, the WIRE protocol, multithreading support, -various user-level macros and functions (e.g. LETF, ITERATE, MEMQ, -REQUIRED-ARGUMENT), and many others. - -SBCL has retained some extensions from parent CMU CL. Many of the -retained extensions are in these categories: -.TP 3 -\-- -things which might be in the new ANSI spec, e.g. weak pointers, -finalization, foreign function interface to C, and Gray streams -.TP 3 -\-- -things which are universally available in Unix scripting languages, -e.g. RUN-PROGRAM and POSIX argv and getenv -.TP 3 -\-- -hooks into the low level workings of the system which can be useful -for debugging, e.g. a list of functions to be run whenever GC occurs, -or parameters to modify compiler diagnostic output -.TP 3 -\-- -unportable performance hacks, e.g. TRULY-THE, FREEZE-TYPE, and PURIFY -.PP - -There are also a few retained extensions which don't fall into -any particular category, e.g. -.TP 3 -\-- -the ability to save running Lisp images as executable files -.PP - -Some of the retained extensions have new names and/or different -options than their CMU CL counterparts. For example, the SBCL function -which saves a Lisp image to disk and kills it is called -SAVE-LISP-AND-DIE instead of SAVE-LISP, and it supports fewer keyword -options than CMU CL's SAVE-LISP. - -(Why doesn't SBCL support more extensions? Why the hell did I (WHN) -drop all those nice extensions from CMU CL when the code already -exists? This is a frequently asked question on the mailing list. The -answer is that they're hard to maintain, and I have enough on my hands -already. Also, in the case of some big and unquestionably useful -extensions, like sockets and Motif, I think that SBCL has done its job -by supplying the FFI, and that people who need, and understand, and -are motivated to maintain the functionality should supply it as a -separate library, which I'd be happy to distribute or link to on the -SBCL home page. Finally, in the case of multithreading, I do think it -belongs in the new ANSI spec, and it'd be a good feature to have, but -I didn't think the CMU CL implementation was sufficiently mature, and -it's such a complicated and far-reaching extension that I thought that -trying to fix it would interfere with the more urgent task of getting -basic ANSI support up to speed.) - -.SH THE COMPILER - -SBCL inherits from CMU CL the "Python" native code compiler. This -compiler is very clever about understanding the type system of Common -Lisp and using it to produce efficient code, and about producing notes -to let the user know when the compiler doesn't have enough type -information to produce efficient code. It also tries (almost always -successfully) to follow the unusual but very useful principle that -type declarations should be checked at runtime unless the user -explicitly tells the system that speed is more important than safety. - -The CMU CL version of this compiler reportedly produces pretty good -code for modern machines which have lots of registers, but its code -for the X86 is marred by a lot of extra loads and stores to -stack-based temporary variables. Because of this, and because of the -extra levels of indirection in Common Lisp relative to C, we find a -typical performance decrease by a factor of perhaps 2 to 5 for small -programs coded in SBCL instead of GCC. - -For more information about the compiler, see the user manual. - -.SH DOCUMENTATION - -Currently, the documentation for the system is -.TP 3 -\-- -the user manual -.TP 3 -\-- -this man page -.TP 3 -\-- -doc strings and online help built into the SBCL executable -.PP - .SH SYSTEM REQUIREMENTS -Unlike its distinguished ancestor CMU CL, SBCL is currently on X86 -(Linux, FreeBSD, and OpenBSD) and Alpha (Linux). It would probably be -straightforward to port the CMU CL support for SPARC, or to port to -NetBSD. +Unlike its distinguished ancestor CMU CL, SBCL currently runs only on X86 +(Linux, FreeBSD, and OpenBSD) and Alpha (Linux). For information on +other ongoing ports, see the sbcl-devel mailing list, and/or the +web site. -As of version 0.6.13, SBCL requires on the order of 16Mb RAM to run -on X86 systems. +SBCL requires on the order of 16Mb RAM to run on X86 systems. .SH ENVIRONMENT @@ -284,23 +337,15 @@ variable. system-wide SBCL initialization files, unless overridden by the SBCL_HOME variable or the --sysinit command line option. - $HOME/.sbclrc is the standard location for a user's SBCL initialization file, unless overridden by the --userinit command line option. -.SH BUGS - -To report a bug, please send mail to sbcl-help@lists.sourceforge.net -or sbcl-devel@lists.sourceforge.net. As with any software bug report, -it's most helpful if you remember to describe the environment where -the problem occurs (machine type, O/S name and version, etc.) and if -you can provide enough information to reproduce the problem, -preferably in compact form. +.SH KNOWN BUGS -This section attempts to list the most serious and long-standing bugs -or surprising performance hits. For more detailed and current -information on bugs, see the BUGS file in the distribution. +This section attempts to list the most serious and long-standing bugs. +For more detailed and current information on bugs, see the BUGS file +in the distribution. It is possible to get in deep trouble by exhausting memory. To plagiarize a sadly apt description of a language not @@ -319,15 +364,6 @@ turns out to use more virtual memory than the system has available for it, other processes tend to be killed randomly (!). .PP -The compiler is overaggressive about static typing, assuming that a -function's return type never changes. Thus compiling and loading a -file containing -(DEFUN FOO (X) NIL) -(DEFUN BAR (X) (IF (FOO X) 1 2)) -(DEFUN FOO (X) (PLUSP X)) -then running (FOO 1) gives 2 (because the compiler "knew" -that FOO's return type is NULL). - The compiler's handling of function return values unnecessarily violates the "declarations are assertions" principle that it otherwise adheres to. Using PROCLAIM or DECLAIM to specify the return type of a @@ -339,24 +375,48 @@ compiling a file containing then running (FOO 1) gives NOT-THIS-TIME, because the never compiled code to check the declaration. -The implementation of multidimensional arrays, especially -multidimensional arrays of floating point numbers, is very -inefficient. - -SYMBOL-FUNCTION is much slower than you might expect, being -implemented not as a slot access but as a search through the -compiler/kernel "globaldb" database. - -CLOS (based on the PCL reference implementation) is somewhat -inefficient. +Some things are implemented very inefficiently. +.TP 3 +\-- +Multidimensional arrays are inefficient, especially +multidimensional arrays of floating point numbers +.TP 3 +\-- +The DYNAMIC-EXTENT declaration isn't implemented at all, not even +for &REST lists or upward closures, so such constructs always allocate +their temporary storage from the heap, causing GC overhead. +.TP 3 +\-- +CLOS isn't particularly efficient. (In part, CLOS is so dynamic +that it's slow for fundamental reasons, but beyond that, the +SBCL implementation of CLOS doesn't do some important known +optimizations.) +.TP 3 +\-- +SBCL, like most implementations of Common Lisp, has trouble +passing floating point numbers around efficiently, because +they're larger than a machine word. (Thus, they get "boxed" in +heap-allocated storage, causing GC overhead.) Within +a single compilation unit, +or when doing built-in operations like SQRT and AREF, +or some special operations like structure slot accesses, +this is avoidable: see the user manual for some +efficiency hints. But for general function calls across +the boundaries of compilation units, passing a floating point +number as a function argument (or returning a floating point +number as a function value) is a fundamentally slow operation. +.PP -There are many nagging pre-ANSIisms, e.g. +There are still some nagging pre-ANSIisms, notably .TP 3 \-- CLOS (based on the PCL reference implementation) is incompletely integrated into the system, so that e.g. SB-PCL::FIND-CLASS is a -different function than CL::FIND-CLASS. (This is less of a problem in -practice than the speed, but it's still distasteful.) +different function than CL::FIND-CLASS. (In practice, you need to +be a pretty advanced user before this is a serious problem, and +by then you can usually work around it, but it's still distasteful. +It's arguably the outstanding "This should be fixed by version 1.0" +issue.) .TP 3 -- The ANSI-recommended idiom for creating a function which is only @@ -368,35 +428,37 @@ doesn't do what you'd expect. (Instead, you have to declare the function as SB-EXT:MAYBE-INLINE to get the desired effect.) .TP 3 \-- -The DYNAMIC-EXTENT declaration is not implemented, and is simply -ignored. (This is allowed by the ANSI spec, but can have a large -efficiency cost in some kinds of code, e.g. code which uses a lot -of upward closures or &REST lists.) -.TP 3 --- -Compiling DEFSTRUCT in strange places (e.g. inside a DEFUN) doesn't -do anything like what it should. -.TP 3 -\-- -The symbol * is the name of a type similar to T. (It's used as part of -the implementation of compound types like (ARRAY * 1) and (CONS * *). -In a strict ANSI implementation, * would not be the name of a type, -but instead just a symbol which is recognized and handled specially by -certain type expanders.) +There are several nonconforming bits of type syntax. E.g. (1) The type +FOO is strictly equivalent to (FOO), so e.g. the type OR is treated as +the type (OR), i.e. the empty type. This is the way that the ancestral +code worked, and even though ANSI specifically forbids it, it hasn't +been fixed yet. (2) The symbol * is the name of a type similar to T. +(It's used as part of the implementation of compound types like (ARRAY +* 1) and (CONS * *). In a strict ANSI implementation, * would not be +the name of a type, but instead just a symbol which is recognized and +handled specially by certain type expanders.) .PP +.SH REPORTING BUGS + +To report a bug, please send mail to sbcl-help@lists.sourceforge.net +or sbcl-devel@lists.sourceforge.net. + +As with any software bug report, it's most helpful if you can provide +enough information to reproduce the symptoms reliably, and if you say +clearly what the symptoms are. E.g. "There seems to be something wrong +with TAN of very small negative arguments. When I execute +(TAN LEAST-NEGATIVE-SINGLE-FLOAT) interactively on sbcl-1.2.3 on my Linux +4.5 X86 box, I get an UNBOUND-VARIABLE error." + .SH SUPPORT Various information about SBCL is available at . The mailing lists there are the recommended place to look for support. -.SH DISTRIBUTION - -SBCL is a free implementation of Common Lisp derived from CMU CL. Both -sources and executables are freely available; this software is "as -is", and has no warranty of any kind. CMU and the authors assume no -responsibility for the consequences of any use of this software. See -the CREDITS file in the distribution for more information about -history, contributors and permissions. +.SH AUTHORS +Dozens of people have made substantial contributions to SBCL and its +subsystems, and to the CMU CL system on which it was based, over the +years. See the CREDITS file in the distribution. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index dd272f8..c2b2403 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -369,7 +369,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "DEBUG-FUN" "DEBUG-FUN-FUN" "DEBUG-FUN-KIND" "DEBUG-FUN-LAMBDA-LIST" "DEBUG-FUN-NAME" "DEBUG-FUN-P" "DEBUG-FUN-START-LOCATION" - "DEBUG-FUN-SYMBOL-VARIABLES" + "DEBUG-FUN-SYMBOL-VARS" "DEBUG-SOURCE-ROOT-NUMBER" "DEBUG-VAR" "DEBUG-VAR-ID" "DEBUG-VAR-INFO-AVAILABLE" "DEBUG-VAR-SYMBOL-NAME" "DEBUG-VAR-P" "DEBUG-VAR-PACKAGE-NAME" @@ -377,7 +377,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "DEBUG-VAR-VALIDITY" "DEBUG-VAR-VALUE" "DELETE-BREAKPOINT" "DO-BLOCKS" "DO-DEBUG-BLOCK-LOCATIONS" "DO-DEBUG-FUN-BLOCKS" - "DO-DEBUG-FUN-VARIABLES" + "DO-DEBUG-FUN-VARS" "FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES" "FRAME-CODE-LOCATION" "FRAME-DEBUG-FUN" "FRAME-DOWN" diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 760e594..02a19c4 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -31,7 +31,7 @@ ;;; FIXME: old CMU CL representation follows: ;;; Compiled debug variables are in a packed binary representation in the -;;; DEBUG-FUN-VARIABLES: +;;; DEBUG-FUN-VARS: ;;; single byte of boolean flags: ;;; uninterned name ;;; packaged name @@ -118,7 +118,7 @@ ;; * the variable ID, when it has one ;; * SC-offset of primary location, if it has one ;; * SC-offset of save location, if it has one - (variables nil :type (or simple-vector null)) + (vars nil :type (or simple-vector null)) ;; a vector of the packed binary representation of the ;; COMPILED-DEBUG-BLOCKs in this function, in the order that the ;; blocks were emitted. The first block is the start of the diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 46c9ff3..6987328 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -1123,8 +1123,7 @@ ;;; nil). This may iterate over only some of DEBUG-FUN's variables or ;;; none depending on debug policy; for example, possibly the ;;; compilation only preserved argument information. -(defmacro do-debug-fun-variables ((var debug-fun &optional result) - &body body) +(defmacro do-debug-fun-vars ((var debug-fun &optional result) &body body) (let ((vars (gensym)) (i (gensym))) `(let ((,vars (debug-fun-debug-vars ,debug-fun))) @@ -1227,7 +1226,7 @@ ;;; as symbol. The result of this function is limited to the ;;; availability of variable information in DEBUG-FUN; for ;;; example, possibly DEBUG-FUN only knows about its arguments. -(defun debug-fun-symbol-variables (debug-fun symbol) +(defun debug-fun-symbol-vars (debug-fun symbol) (let ((vars (ambiguous-debug-vars debug-fun (symbol-name symbol))) (package (and (symbol-package symbol) (package-name (symbol-package symbol))))) @@ -1252,7 +1251,7 @@ (if variables (let* ((len (length variables)) (prefix-len (length name-prefix-string)) - (pos (find-variable name-prefix-string variables len)) + (pos (find-var name-prefix-string variables len)) (res nil)) (when pos ;; Find names from pos to variable's len that contain prefix. @@ -1271,9 +1270,9 @@ (setq res (nreverse res))) res)))) -;;; This returns a position in variables for one containing name as an -;;; initial substring. End is the length of variables if supplied. -(defun find-variable (name variables &optional end) +;;; This returns a position in VARIABLES for one containing NAME as an +;;; initial substring. END is the length of VARIABLES if supplied. +(defun find-var (name variables &optional end) (declare (simple-vector variables) (simple-string name)) (let ((name-len (length name))) @@ -1596,7 +1595,7 @@ (defun parse-compiled-debug-vars (debug-fun) (let* ((cdebug-fun (compiled-debug-fun-compiler-debug-fun debug-fun)) - (packed-vars (sb!c::compiled-debug-fun-variables cdebug-fun)) + (packed-vars (sb!c::compiled-debug-fun-vars cdebug-fun)) (args-minimal (eq (sb!c::compiled-debug-fun-arguments cdebug-fun) :minimal))) (when packed-vars @@ -2671,7 +2670,7 @@ (debug-signal 'no-debug-vars :debug-fun fun)) (sb!int:collect ((binds) (specs)) - (do-debug-fun-variables (var fun) + (do-debug-fun-vars (var fun) (let ((validity (debug-var-validity var loc))) (unless (eq validity :invalid) (let* ((sym (debug-var-symbol var)) diff --git a/src/code/debug.lisp b/src/code/debug.lisp index ba7e75b..f3564e8 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -828,7 +828,7 @@ reset to ~S." (sb!xc:defmacro define-var-operation (ref-or-set &optional value-var) `(let* ((temp (etypecase name - (symbol (sb!di:debug-fun-symbol-variables + (symbol (sb!di:debug-fun-symbol-vars (sb!di:frame-debug-fun *current-frame*) name)) (simple-string (sb!di:ambiguous-debug-vars diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index 709ba8e..4ee0528 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -47,7 +47,7 @@ ;; Local functions inhibit global SETF methods. ((and environment (let ((name (car form))) - (dolist (x (sb!c::lexenv-functions environment)) + (dolist (x (sb!c::lexenv-funs environment)) (when (and (eq (car x) name) (not (sb!c::defined-fun-p (cdr x)))) (return t))))) diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 3e413fc..d003809 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -423,36 +423,36 @@ code to be loaded. (defvar *loop-macro-environment*) ;;; This holds variable names specified with the USING clause. -;;; See LOOP-NAMED-VARIABLE. -(defvar *loop-named-variables*) +;;; See LOOP-NAMED-VAR. +(defvar *loop-named-vars*) ;;; LETlist-like list being accumulated for one group of parallel bindings. -(defvar *loop-variables*) +(defvar *loop-vars*) -;;; list of declarations being accumulated in parallel with *LOOP-VARIABLES* +;;; list of declarations being accumulated in parallel with *LOOP-VARS* (defvar *loop-declarations*) ;;; This is used by LOOP for destructuring binding, if it is doing -;;; that itself. See LOOP-MAKE-VARIABLE. +;;; that itself. See LOOP-MAKE-VAR. (defvar *loop-desetq-crocks*) ;;; list of wrapping forms, innermost first, which go immediately ;;; inside the current set of parallel bindings being accumulated in -;;; *LOOP-VARIABLES*. The wrappers are appended onto a body. E.g., +;;; *LOOP-VARS*. The wrappers are appended onto a body. E.g., ;;; this list could conceivably have as its value ;;; ((WITH-OPEN-FILE (G0001 G0002 ...))), -;;; with G0002 being one of the bindings in *LOOP-VARIABLES* (This is +;;; with G0002 being one of the bindings in *LOOP-VARS* (This is ;;; why the wrappers go inside of the variable bindings). (defvar *loop-wrappers*) -;;; This accumulates lists of previous values of *LOOP-VARIABLES* and +;;; This accumulates lists of previous values of *LOOP-VARS* and ;;; the other lists above, for each new nesting of bindings. See ;;; LOOP-BIND-BLOCK. (defvar *loop-bind-stack*) ;;; This is simply a list of LOOP iteration variables, used for ;;; checking for duplications. -(defvar *loop-iteration-variables*) +(defvar *loop-iteration-vars*) ;;; list of prologue forms of the loop, accumulated in reverse order (defvar *loop-prologue*) @@ -490,14 +490,14 @@ code to be loaded. ;;; If not NIL, this is a temporary bound around the loop for holding ;;; the temporary value for "it" in things like "when (f) collect it". ;;; It may be used as a supertemporary by some other things. -(defvar *loop-when-it-variable*) +(defvar *loop-when-it-var*) ;;; Sometimes we decide we need to fold together parts of the loop, ;;; but some part of the generated iteration code is different for the ;;; first and remaining iterations. This variable will be the ;;; temporary which is the flag used in the loop to tell whether we ;;; are in the first or remaining iterations. -(defvar *loop-never-stepped-variable*) +(defvar *loop-never-stepped-var*) ;;; list of all the value-accumulation descriptor structures in the ;;; loop. See LOOP-GET-COLLECTION-INFO. @@ -524,7 +524,7 @@ code to be loaded. (defvar *loop-duplicate-code* nil) -(defvar *loop-iteration-flag-variable* +(defvar *loop-iteration-flag-var* (make-symbol "LOOP-NOT-FIRST-TIME")) (defun loop-code-duplication-threshold (env) @@ -613,7 +613,7 @@ code to be loaded. (push (pop rafter) then) (when (eq rbefore (cdr lastdiff)) (return))) (unless flagvar - (push `(setq ,(setq flagvar *loop-iteration-flag-variable*) + (push `(setq ,(setq flagvar *loop-iteration-flag-var*) t) else)) (push `(if ,flagvar ,(pify (psimp then)) ,(pify (psimp else))) @@ -772,9 +772,9 @@ code to be loaded. *loop-universe*) (let ((*loop-original-source-code* *loop-source-code*) (*loop-source-context* nil) - (*loop-iteration-variables* nil) - (*loop-variables* nil) - (*loop-named-variables* nil) + (*loop-iteration-vars* nil) + (*loop-vars* nil) + (*loop-named-vars* nil) (*loop-declarations* nil) (*loop-desetq-crocks* nil) (*loop-bind-stack* nil) @@ -788,8 +788,8 @@ code to be loaded. (*loop-after-epilogue* nil) (*loop-final-value-culprit* nil) (*loop-inside-conditional* nil) - (*loop-when-it-variable* nil) - (*loop-never-stepped-variable* nil) + (*loop-when-it-var* nil) + (*loop-never-stepped-var* nil) (*loop-names* nil) (*loop-collection-cruft* nil)) (loop-iteration-driver) @@ -976,58 +976,57 @@ code to be loaded. ;;;; loop variables (defun loop-bind-block () - (when (or *loop-variables* *loop-declarations* *loop-wrappers*) - (push (list (nreverse *loop-variables*) + (when (or *loop-vars* *loop-declarations* *loop-wrappers*) + (push (list (nreverse *loop-vars*) *loop-declarations* *loop-desetq-crocks* *loop-wrappers*) *loop-bind-stack*) - (setq *loop-variables* nil + (setq *loop-vars* nil *loop-declarations* nil *loop-desetq-crocks* nil *loop-wrappers* nil))) -(defun loop-make-variable (name initialization dtype - &optional iteration-variable-p) +(defun loop-make-var (name initialization dtype &optional iteration-var-p) (cond ((null name) (cond ((not (null initialization)) (push (list (setq name (gensym "LOOP-IGNORE-")) initialization) - *loop-variables*) + *loop-vars*) (push `(ignore ,name) *loop-declarations*)))) ((atom name) - (cond (iteration-variable-p - (if (member name *loop-iteration-variables*) + (cond (iteration-var-p + (if (member name *loop-iteration-vars*) (loop-error "duplicated LOOP iteration variable ~S" name) - (push name *loop-iteration-variables*))) - ((assoc name *loop-variables*) + (push name *loop-iteration-vars*))) + ((assoc name *loop-vars*) (loop-error "duplicated variable ~S in LOOP parallel binding" name))) (unless (symbolp name) (loop-error "bad variable ~S somewhere in LOOP" name)) - (loop-declare-variable name dtype) + (loop-declare-var name dtype) ;; We use ASSOC on this list to check for duplications (above), ;; so don't optimize out this list: (push (list name (or initialization (loop-typed-init dtype))) - *loop-variables*)) + *loop-vars*)) (initialization (let ((newvar (gensym "LOOP-DESTRUCTURE-"))) - (loop-declare-variable name dtype) - (push (list newvar initialization) *loop-variables*) + (loop-declare-var name dtype) + (push (list newvar initialization) *loop-vars*) ;; *LOOP-DESETQ-CROCKS* gathered in reverse order. (setq *loop-desetq-crocks* (list* name newvar *loop-desetq-crocks*)))) (t (let ((tcar nil) (tcdr nil)) (if (atom dtype) (setq tcar (setq tcdr dtype)) (setq tcar (car dtype) tcdr (cdr dtype))) - (loop-make-variable (car name) nil tcar iteration-variable-p) - (loop-make-variable (cdr name) nil tcdr iteration-variable-p)))) + (loop-make-var (car name) nil tcar iteration-var-p) + (loop-make-var (cdr name) nil tcdr iteration-var-p)))) name) -(defun loop-make-iteration-variable (name initialization dtype) - (loop-make-variable name initialization dtype t)) +(defun loop-make-iteration-var (name initialization dtype) + (loop-make-var name initialization dtype t)) -(defun loop-declare-variable (name dtype) +(defun loop-declare-var (name dtype) (cond ((or (null name) (null dtype) (eq dtype t)) nil) ((symbolp name) (unless (sb!xc:subtypep t dtype) @@ -1038,16 +1037,16 @@ code to be loaded. (push `(type ,dtype ,name) *loop-declarations*)))) ((consp name) (cond ((consp dtype) - (loop-declare-variable (car name) (car dtype)) - (loop-declare-variable (cdr name) (cdr dtype))) - (t (loop-declare-variable (car name) dtype) - (loop-declare-variable (cdr name) dtype)))) + (loop-declare-var (car name) (car dtype)) + (loop-declare-var (cdr name) (cdr dtype))) + (t (loop-declare-var (car name) dtype) + (loop-declare-var (cdr name) dtype)))) (t (error "invalid LOOP variable passed in: ~S" name)))) (defun loop-maybe-bind-form (form data-type) (if (loop-constantp form) form - (loop-make-variable (gensym "LOOP-BIND-") form data-type))) + (loop-make-var (gensym "LOOP-BIND-") form data-type))) (defun loop-do-if (for negatep) (let ((form (loop-get-form)) (*loop-inside-conditional* t) (it-p nil)) @@ -1064,7 +1063,7 @@ code to be loaded. (setq *loop-source-code* (cons (or it-p (setq it-p - (loop-when-it-variable))) + (loop-when-it-var))) (cdr *loop-source-code*)))) (cond ((or (not (setq data (loop-lookup-keyword key (loop-universe-keywords *loop-universe*)))) @@ -1191,7 +1190,7 @@ code to be loaded. (let ((tempvars (loop-collector-tempvars lc))) (unless tempvars (setf (loop-collector-tempvars lc) - (setq tempvars (list (loop-make-variable + (setq tempvars (list (loop-make-var (or (loop-collector-name lc) (gensym "LOOP-SUM-")) nil (loop-collector-dtype lc))))) @@ -1242,8 +1241,8 @@ code to be loaded. ;;; Under ANSI this is not permitted to appear under conditionalization. (defun loop-do-thereis (restrictive) (when restrictive (loop-disallow-conditional)) - (loop-emit-body `(when (setq ,(loop-when-it-variable) ,(loop-get-form)) - ,(loop-construct-return *loop-when-it-variable*)))) + (loop-emit-body `(when (setq ,(loop-when-it-var) ,(loop-get-form)) + ,(loop-construct-return *loop-when-it-var*)))) (defun loop-do-while (negate kwd &aux (form (loop-get-form))) (loop-disallow-conditional kwd) @@ -1258,7 +1257,7 @@ code to be loaded. (loop-pop-source) (loop-get-form)) (t nil))) - (loop-make-variable var val dtype) + (loop-make-var var val dtype) (if (loop-tequal (car *loop-source-code*) :and) (loop-pop-source) (return (loop-bind-block))))) @@ -1361,19 +1360,17 @@ code to be loaded. (multiple-value-bind (number constantp value) (loop-constant-fold-if-possible form type) (cond ((and constantp (<= value 1)) `(t () () () ,(<= value 0) () () ())) - (t (let ((var (loop-make-variable (gensym "LOOP-REPEAT-") - number - type))) + (t (let ((var (loop-make-var (gensym "LOOP-REPEAT-") number type))) (if constantp `((not (plusp (setq ,var (1- ,var)))) () () () () () () ()) `((minusp (setq ,var (1- ,var))) () () ())))))))) -(defun loop-when-it-variable () - (or *loop-when-it-variable* - (setq *loop-when-it-variable* - (loop-make-variable (gensym "LOOP-IT-") nil nil)))) +(defun loop-when-it-var () + (or *loop-when-it-var* + (setq *loop-when-it-var* + (loop-make-var (gensym "LOOP-IT-") nil nil)))) ;;;; various FOR/AS subdispatches @@ -1383,7 +1380,7 @@ code to be loaded. ;;; is present. I.e., the first initialization occurs in the loop body ;;; (first-step), not in the variable binding phase. (defun loop-ansi-for-equals (var val data-type) - (loop-make-iteration-variable var nil data-type) + (loop-make-iteration-var var nil data-type) (cond ((loop-tequal (car *loop-source-code*) :then) ;; Then we are the same as "FOR x FIRST y THEN z". (loop-pop-source) @@ -1393,23 +1390,23 @@ code to be loaded. `(() (,var ,val) () ())))) (defun loop-for-across (var val data-type) - (loop-make-iteration-variable var nil data-type) + (loop-make-iteration-var var nil data-type) (let ((vector-var (gensym "LOOP-ACROSS-VECTOR-")) (index-var (gensym "LOOP-ACROSS-INDEX-"))) (multiple-value-bind (vector-form constantp vector-value) (loop-constant-fold-if-possible val 'vector) - (loop-make-variable + (loop-make-var vector-var vector-form (if (and (consp vector-form) (eq (car vector-form) 'the)) (cadr vector-form) 'vector)) - (loop-make-variable index-var 0 'fixnum) + (loop-make-var index-var 0 'fixnum) (let* ((length 0) (length-form (cond ((not constantp) (let ((v (gensym "LOOP-ACROSS-LIMIT-"))) (push `(setq ,v (length ,vector-var)) *loop-prologue*) - (loop-make-variable v 0 'fixnum))) + (loop-make-var v 0 'fixnum))) (t (setq length (length vector-value))))) (first-test `(>= ,index-var ,length-form)) (other-test first-test) @@ -1444,9 +1441,7 @@ code to be loaded. ((and (consp stepper) (eq (car stepper) 'function)) (list (cadr stepper) listvar)) (t - `(funcall ,(loop-make-variable (gensym "LOOP-FN-") - stepper - 'function) + `(funcall ,(loop-make-var (gensym "LOOP-FN-") stepper 'function) ,listvar))))) (defun loop-for-on (var val data-type) @@ -1454,9 +1449,9 @@ code to be loaded. (loop-constant-fold-if-possible val) (let ((listvar var)) (cond ((and var (symbolp var)) - (loop-make-iteration-variable var list data-type)) - (t (loop-make-variable (setq listvar (gensym)) list 'list) - (loop-make-iteration-variable var nil data-type))) + (loop-make-iteration-var var list data-type)) + (t (loop-make-var (setq listvar (gensym)) list 'list) + (loop-make-iteration-var var nil data-type))) (let ((list-step (loop-list-step listvar))) (let* ((first-endtest ;; mysterious comment from original CMU CL sources: @@ -1481,8 +1476,8 @@ code to be loaded. (multiple-value-bind (list constantp list-value) (loop-constant-fold-if-possible val) (let ((listvar (gensym "LOOP-LIST-"))) - (loop-make-iteration-variable var nil data-type) - (loop-make-variable listvar list 'list) + (loop-make-iteration-var var nil data-type) + (loop-make-var listvar list 'list) (let ((list-step (loop-list-step listvar))) (let* ((first-endtest `(endp ,listvar)) (other-endtest first-endtest) @@ -1523,7 +1518,7 @@ code to be loaded. (setf (gethash (symbol-name name) ht) lp)) lp)) -;;; Note: path functions are allowed to use loop-make-variable, hack +;;; Note: Path functions are allowed to use LOOP-MAKE-VAR, hack ;;; the prologue, etc. (defun loop-for-being (var val data-type) ;; FOR var BEING each/the pathname prep-phrases using-stuff... each/the = @@ -1563,8 +1558,8 @@ code to be loaded. (setq stuff (if inclusive (apply fun var data-type preps :inclusive t user-data) (apply fun var data-type preps user-data)))) - (when *loop-named-variables* - (loop-error "Unused USING variables: ~S." *loop-named-variables*)) + (when *loop-named-vars* + (loop-error "Unused USING vars: ~S." *loop-named-vars*)) ;; STUFF is now (bindings prologue-forms . stuff-to-pass-back). ;; Protect the system from the user and the user from himself. (unless (member (length stuff) '(6 10)) @@ -1572,21 +1567,21 @@ code to be loaded. path)) (do ((l (car stuff) (cdr l)) (x)) ((null l)) (if (atom (setq x (car l))) - (loop-make-iteration-variable x nil nil) - (loop-make-iteration-variable (car x) (cadr x) (caddr x)))) + (loop-make-iteration-var x nil nil) + (loop-make-iteration-var (car x) (cadr x) (caddr x)))) (setq *loop-prologue* (nconc (reverse (cadr stuff)) *loop-prologue*)) (cddr stuff))) -(defun named-variable (name) - (let ((tem (loop-tassoc name *loop-named-variables*))) +(defun loop-named-var (name) + (let ((tem (loop-tassoc name *loop-named-vars*))) (declare (list tem)) (cond ((null tem) (values (gensym) nil)) - (t (setq *loop-named-variables* (delete tem *loop-named-variables*)) + (t (setq *loop-named-vars* (delete tem *loop-named-vars*)) (values (cdr tem) t))))) (defun loop-collect-prepositional-phrases (preposition-groups &optional - USING-allowed + using-allowed initial-phrases) (flet ((in-group-p (x group) (car (loop-tmember x group)))) (do ((token nil) @@ -1617,7 +1612,7 @@ code to be loaded. (cons this-group used-prepositions))) (loop-pop-source) (push (list this-prep (loop-get-form)) prepositional-phrases)) - ((and USING-allowed (loop-tequal token 'using)) + ((and using-allowed (loop-tequal token 'using)) (loop-pop-source) (do ((z (loop-pop-source) (loop-pop-source)) (tem)) (nil) (when (or (atom z) @@ -1627,12 +1622,12 @@ code to be loaded. (and (cadr z) (not (symbolp (cadr z))))) (loop-error "~S bad variable pair in path USING phrase" z)) (when (cadr z) - (if (setq tem (loop-tassoc (car z) *loop-named-variables*)) + (if (setq tem (loop-tassoc (car z) *loop-named-vars*)) (loop-error "The variable substitution for ~S occurs twice in a USING phrase,~@ with ~S and ~S." (car z) (cadr z) (cadr tem)) - (push (cons (car z) (cadr z)) *loop-named-variables*))) + (push (cons (car z) (cadr z)) *loop-named-vars*))) (when (or (null *loop-source-code*) (symbolp (car *loop-source-code*))) (return nil)))) @@ -1645,7 +1640,7 @@ code to be loaded. sequence-variable sequence-type step-hack default-top prep-phrases) - (let ((endform nil) ; Form (constant or variable) with limit value + (let ((endform nil) ; form (constant or variable) with limit value (sequencep nil) ; T if sequence arg has been provided (testfn nil) ; endtest function (test nil) ; endtest form @@ -1661,20 +1656,20 @@ code to be loaded. (limit-constantp nil) (limit-value nil) ) - (when variable (loop-make-iteration-variable variable nil variable-type)) + (when variable (loop-make-iteration-var variable nil variable-type)) (do ((l prep-phrases (cdr l)) (prep) (form) (odir)) ((null l)) (setq prep (caar l) form (cadar l)) (case prep ((:of :in) (setq sequencep t) - (loop-make-variable sequence-variable form sequence-type)) + (loop-make-var sequence-variable form sequence-type)) ((:from :downfrom :upfrom) (setq start-given t) (cond ((eq prep :downfrom) (setq dir ':down)) ((eq prep :upfrom) (setq dir ':up))) (multiple-value-setq (form start-constantp start-value) (loop-constant-fold-if-possible form indexv-type)) - (loop-make-iteration-variable indexv form indexv-type)) + (loop-make-iteration-var indexv form indexv-type)) ((:upto :to :downto :above :below) (cond ((loop-tequal prep :upto) (setq inclusive-iteration (setq dir ':up))) @@ -1688,15 +1683,15 @@ code to be loaded. (loop-constant-fold-if-possible form indexv-type)) (setq endform (if limit-constantp `',limit-value - (loop-make-variable + (loop-make-var (gensym "LOOP-LIMIT-") form indexv-type)))) (:by (multiple-value-setq (form stepby-constantp stepby) (loop-constant-fold-if-possible form indexv-type)) (unless stepby-constantp - (loop-make-variable (setq stepby (gensym "LOOP-STEP-BY-")) - form - indexv-type))) + (loop-make-var (setq stepby (gensym "LOOP-STEP-BY-")) + form + indexv-type))) (t (loop-error "~S invalid preposition in sequencing or sequence path;~@ maybe invalid prepositions were specified in iteration path descriptor?" @@ -1708,7 +1703,7 @@ code to be loaded. (loop-error "missing OF or IN phrase in sequence path")) ;; Now fill in the defaults. (unless start-given - (loop-make-iteration-variable + (loop-make-iteration-var indexv (setq start-constantp t start-value (or (loop-typed-init indexv-type) 0)) @@ -1716,9 +1711,9 @@ code to be loaded. (cond ((member dir '(nil :up)) (when (or limit-given default-top) (unless limit-given - (loop-make-variable (setq endform - (gensym "LOOP-SEQ-LIMIT-")) - nil indexv-type) + (loop-make-var (setq endform (gensym "LOOP-SEQ-LIMIT-")) + nil + indexv-type) (push `(setq ,endform ,default-top) *loop-prologue*)) (setq testfn (if inclusive-iteration '> '>=))) (setq step (if (eql stepby 1) `(1+ ,indexv) `(+ ,indexv ,stepby)))) @@ -1764,8 +1759,8 @@ code to be loaded. size-function sequence-type element-type) - (multiple-value-bind (indexv) (named-variable 'index) - (let ((sequencev (named-variable 'sequence))) + (multiple-value-bind (indexv) (loop-named-var 'index) + (let ((sequencev (named-var 'sequence))) (list* nil nil ; dummy bindings and prologue (loop-sequencer indexv 'fixnum @@ -1796,16 +1791,16 @@ code to be loaded. (dummy-predicate-var nil) (post-steps nil)) (multiple-value-bind (other-var other-p) - (named-variable (ecase which + (loop-named-var (ecase which (:hash-key 'hash-value) (:hash-value 'hash-key))) - ;; @@@@ NAMED-VARIABLE returns a second value of T if the name + ;; @@@@ LOOP-NAMED-VAR returns a second value of T if the name ;; was actually specified, so clever code can throw away the ;; GENSYM'ed-up variable if it isn't really needed. The ;; following is for those implementations in which we cannot put ;; dummy NILs into MULTIPLE-VALUE-SETQ variable lists. (setq other-p t - dummy-predicate-var (loop-when-it-variable)) + dummy-predicate-var (loop-when-it-var)) (let ((key-var nil) (val-var nil) (bindings `((,variable nil ,data-type) @@ -1851,7 +1846,7 @@ code to be loaded. () () () - (not (multiple-value-setq (,(loop-when-it-variable) + (not (multiple-value-setq (,(loop-when-it-var) ,variable) (,next-fn))) ()))) diff --git a/src/code/macroexpand.lisp b/src/code/macroexpand.lisp index 8f467e5..b1049bd 100644 --- a/src/code/macroexpand.lisp +++ b/src/code/macroexpand.lisp @@ -54,7 +54,7 @@ t) (values form nil)))) ((symbolp form) - (let* ((venv (when env (sb!c::lexenv-variables env))) + (let* ((venv (when env (sb!c::lexenv-vars env))) (local-def (cdr (assoc form venv)))) (if (and (consp local-def) (eq (car local-def) 'macro)) diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 612524f..8e264a9 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -71,7 +71,7 @@ (when (and (lambda-var-p leaf) (or (not (member (tn-kind tn) '(:environment :debug-environment))) - (rassoc leaf (lexenv-variables (node-lexenv node)))) + (rassoc leaf (lexenv-vars (node-lexenv node)))) (or (null spilled) (not (member tn spilled)))) (let ((num (gethash leaf var-locs))) @@ -313,7 +313,7 @@ ;;; environment live and is an argument. If a :DEBUG-ENVIRONMENT TN, ;;; then we also exclude set variables, since the variable is not ;;; guaranteed to be live everywhere in that case. -(defun dump-1-variable (fun var tn id minimal buffer) +(defun dump-1-var (fun var tn id minimal buffer) (declare (type lambda-var var) (type (or tn null) tn) (type index id) (type clambda fun)) (let* ((name (leaf-debug-name var)) @@ -348,12 +348,12 @@ (vector-push-extend (tn-sc-offset save-tn) buffer))) (values)) -;;; Return a vector suitable for use as the DEBUG-FUN-VARIABLES +;;; Return a vector suitable for use as the DEBUG-FUN-VARS ;;; of FUN. LEVEL is the current DEBUG-INFO quality. VAR-LOCS is a ;;; hash table in which we enter the translation from LAMBDA-VARS to ;;; the relative position of that variable's location in the resulting ;;; vector. -(defun compute-variables (fun level var-locs) +(defun compute-vars (fun level var-locs) (declare (type clambda fun) (type hash-table var-locs)) (collect ((vars)) (labels ((frob-leaf (leaf tn gensym-p) @@ -390,18 +390,18 @@ (incf id)) (t (setq id 0 prev-name name))) - (dump-1-variable fun var (cdr x) id nil buffer) + (dump-1-var fun var (cdr x) id nil buffer) (setf (gethash var var-locs) i)) (incf i)) (coerce buffer 'simple-vector)))) -;;; Return a vector suitable for use as the DEBUG-FUN-VARIABLES of +;;; Return a vector suitable for use as the DEBUG-FUN-VARS of ;;; FUN, representing the arguments to FUN in minimal variable format. -(defun compute-minimal-variables (fun) +(defun compute-minimal-vars (fun) (declare (type clambda fun)) (let ((buffer (make-array 0 :fill-pointer 0 :adjustable t))) (dolist (var (lambda-vars fun)) - (dump-1-variable fun var (leaf-info var) 0 t buffer)) + (dump-1-var fun var (leaf-info var) 0 t buffer)) (coerce buffer 'simple-vector))) ;;; Return VAR's relative position in the function's variables (determined @@ -498,12 +498,12 @@ (let ((od (lambda-optional-dispatch fun))) (or (not od) (not (eq (optional-dispatch-main-entry od) fun))))) - (setf (compiled-debug-fun-variables dfun) - (compute-minimal-variables fun)) + (setf (compiled-debug-fun-vars dfun) + (compute-minimal-vars fun)) (setf (compiled-debug-fun-arguments dfun) :minimal)) (t - (setf (compiled-debug-fun-variables dfun) - (compute-variables fun level var-locs)) + (setf (compiled-debug-fun-vars dfun) + (compute-vars fun level var-locs)) (setf (compiled-debug-fun-arguments dfun) (compute-arguments fun var-locs)))) diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index 7553f5d..e83428b 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -70,8 +70,7 @@ ;;; Check everything that we can think of for consistency. When a ;;; definite inconsistency is detected, we BARF. Possible problems ;;; just cause us to BURP. Our argument is a list of components, but -;;; we also look at the *FREE-VARIABLES*, *FREE-FUNS* and -;;; *CONSTANTS*. +;;; we also look at the *FREE-VARS*, *FREE-FUNS* and *CONSTANTS*. ;;; ;;; First we do a pre-pass which finds all the CBLOCKs and CLAMBDAs, ;;; testing that they are linked together properly and entering them @@ -123,13 +122,13 @@ (and (global-var-p v) (member (global-var-kind v) '(:global :special)))) - (barf "strange *FREE-VARIABLES* entry: ~S" v)) + (barf "strange *FREE-VARS* entry: ~S" v)) (dolist (n (leaf-refs v)) (check-node-reached n)) (when (basic-var-p v) (dolist (n (basic-var-sets v)) (check-node-reached n)))) - *free-variables*) + *free-vars*) (maphash (lambda (k v) (declare (ignore k)) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index acf0085..1e3f616 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -73,12 +73,12 @@ (defvar *lexenv*) (declaim (type lexenv *lexenv*)) -;;; *FREE-VARIABLES* translates from the names of variables referenced +;;; *FREE-VARS* translates from the names of variables referenced ;;; globally to the LEAF structures for them. *FREE-FUNS* is like -;;; *FREE-VARIABLES*, only it deals with function names. -(defvar *free-variables*) +;;; *FREE-VARS*, only it deals with function names. +(defvar *free-vars*) (defvar *free-funs*) -(declaim (type hash-table *free-variables* *free-funs*)) +(declaim (type hash-table *free-vars* *free-funs*)) ;;; We use the same CONSTANT structure to represent all equal anonymous ;;; constants. This hashtable translates from constants to the LEAFs that diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index fa435c7..b9dfd71 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -151,7 +151,7 @@ else returns NIL. If ENV is unspecified or NIL, use the global environment only." (declare (symbol symbol)) - (let* ((fenv (when env (sb!c::lexenv-functions env))) + (let* ((fenv (when env (sb!c::lexenv-funs env))) (local-def (cdr (assoc symbol fenv)))) (cond (local-def (if (and (consp local-def) (eq (car local-def) 'MACRO)) @@ -194,7 +194,7 @@ definition, or declared NOTINLINE, NIL is returned. Can be set with SETF." (let ((found (and env - (cdr (assoc name (sb!c::lexenv-functions env) + (cdr (assoc name (sb!c::lexenv-funs env) :test #'equal))))) (unless (eq (cond ((sb!c::defined-fun-p found) (sb!c::defined-fun-inlinep found)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 50efcc3..971550f 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -244,7 +244,7 @@ definitions fun) (declare (type function definitionize-fun fun)) - (declare (type (member :variables :functions) definitionize-keyword)) + (declare (type (member :vars :funs) definitionize-keyword)) (declare (type list definitions)) (unless (= (length definitions) (length (remove-duplicates definitions :key #'first))) @@ -278,7 +278,7 @@ `(lambda (,whole ,environment) ,@local-decls (block ,name ,body)))))))) - :functions + :funs definitions fun)) @@ -304,7 +304,7 @@ "The local symbol macro name ~S is not a symbol." name)) `(,name . (MACRO . ,expansion)))) - :variables + :vars definitions fun)) @@ -514,8 +514,8 @@ ;;; variables are marked as such. Context is the name of the form, for ;;; error reporting purposes. (declaim (ftype (function (list symbol) (values list list list)) - extract-let-variables)) -(defun extract-let-variables (bindings context) + extract-let-vars)) +(defun extract-let-vars (bindings context) (collect ((vars) (vals) (names)) @@ -551,7 +551,7 @@ Value forms. The variables are bound in parallel after all of the Values are evaluated." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) - (multiple-value-bind (vars values) (extract-let-variables bindings 'let) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let) (let* ((*lexenv* (process-decls decls vars nil cont)) (fun-cont (make-continuation)) (fun (ir1-convert-lambda-body @@ -566,7 +566,7 @@ Similar to LET, but the variables are bound sequentially, allowing each Value form to reference any of the previous Vars." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) - (multiple-value-bind (vars values) (extract-let-variables bindings 'let*) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let*) (let ((*lexenv* (process-decls decls vars nil cont))) (ir1-convert-aux-bindings start cont forms vars values))))) @@ -599,9 +599,8 @@ ;;; ;;; The function names are checked for legality. CONTEXT is the name ;;; of the form, for error reporting. -(declaim (ftype (function (list symbol) (values list list)) - extract-flet-variables)) -(defun extract-flet-variables (definitions context) +(declaim (ftype (function (list symbol) (values list list)) extract-flet-vars)) +(defun extract-flet-vars (definitions context) (collect ((names) (defs)) (dolist (def definitions) @@ -627,7 +626,7 @@ the lexically apparent function definition in the enclosing environment." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) (multiple-value-bind (names defs) - (extract-flet-variables definitions 'flet) + (extract-flet-vars definitions 'flet) (let* ((fvars (mapcar (lambda (n d) (ir1-convert-lambda d :source-name n @@ -636,7 +635,7 @@ names defs)) (*lexenv* (make-lexenv :default (process-decls decls nil fvars cont) - :functions (pairlis names fvars)))) + :funs (pairlis names fvars)))) (ir1-convert-progn-body start cont forms))))) (def-ir1-translator labels ((definitions &body body) start cont) @@ -647,7 +646,7 @@ each other." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) (multiple-value-bind (names defs) - (extract-flet-variables definitions 'labels) + (extract-flet-vars definitions 'labels) (let* (;; dummy LABELS functions, to be used as placeholders ;; during construction of real LABELS functions (placeholder-funs (mapcar (lambda (name) @@ -662,8 +661,7 @@ ;; the real LABELS functions, compiled in a LEXENV which ;; includes the dummy LABELS functions (real-funs - (let ((*lexenv* (make-lexenv - :functions placeholder-fenv))) + (let ((*lexenv* (make-lexenv :funs placeholder-fenv))) (mapcar (lambda (name def) (ir1-convert-lambda def :source-name name @@ -685,7 +683,7 @@ ;; placeholder used earlier) so that if the ;; lexical environment is used for inline ;; expansion we'll get the right functions. - :functions (pairlis names real-funs)))) + :funs (pairlis names real-funs)))) (ir1-convert-progn-body start cont forms)))))) ;;;; the THE special operator, and friends @@ -774,17 +772,17 @@ ;;;; SETQ -;;; If there is a definition in LEXENV-VARIABLES, just set that, -;;; otherwise look at the global information. If the name is for a -;;; constant, then error out. +;;; If there is a definition in LEXENV-VARS, just set that, otherwise +;;; look at the global information. If the name is for a constant, +;;; then error out. (def-ir1-translator setq ((&whole source &rest things) start cont) (let ((len (length things))) (when (oddp len) (compiler-error "odd number of args to SETQ: ~S" source)) (if (= len 2) (let* ((name (first things)) - (leaf (or (lexenv-find name variables) - (find-free-variable name)))) + (leaf (or (lexenv-find name vars) + (find-free-var name)))) (etypecase leaf (leaf (when (constant-p leaf) @@ -799,7 +797,7 @@ (compiler-style-warn "~S is being set even though it was declared to be ignored." name))) - (set-variable start cont leaf (second things))) + (setq-var start cont leaf (second things))) (cons (aver (eq (car leaf) 'MACRO)) (ir1-convert start cont `(setf ,(cdr leaf) ,(second things)))) @@ -814,7 +812,7 @@ ;;; This is kind of like REFERENCE-LEAF, but we generate a SET node. ;;; This should only need to be called in SETQ. -(defun set-variable (start cont var value) +(defun setq-var (start cont var value) (declare (type continuation start cont) (type basic-var var)) (let ((dest (make-continuation))) (setf (continuation-asserted-type dest) (leaf-type var)) @@ -880,7 +878,7 @@ ;;; function and smashes it to a :CLEANUP function, as well as ;;; referencing it. (def-ir1-translator %cleanup-fun ((name) start cont) - (let ((fun (lexenv-find name functions))) + (let ((fun (lexenv-find name funs))) (aver (lambda-p fun)) (setf (functional-kind fun) :cleanup) (reference-leaf start cont fun))) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index ebe7d6a..241e8a0 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -154,7 +154,7 @@ ;;; definition of NAME. (declaim (ftype (function (t string) leaf) find-lexically-apparent-fun)) (defun find-lexically-apparent-fun (name context) - (let ((var (lexenv-find name functions :test #'equal))) + (let ((var (lexenv-find name funs :test #'equal))) (cond (var (unless (leaf-p var) (aver (and (consp var) (eq (car var) 'macro))) @@ -164,22 +164,21 @@ (find-free-fun name context))))) ;;; Return the LEAF node for a global variable reference to NAME. If -;;; NAME is already entered in *FREE-VARIABLES*, then we just return -;;; the corresponding value. Otherwise, we make a new leaf using +;;; NAME is already entered in *FREE-VARS*, then we just return the +;;; corresponding value. Otherwise, we make a new leaf using ;;; information from the global environment and enter it in -;;; *FREE-VARIABLES*. If the variable is unknown, then we emit a -;;; warning. -(defun find-free-variable (name) +;;; *FREE-VARS*. If the variable is unknown, then we emit a warning. +(defun find-free-var (name) (declare (values (or leaf heap-alien-info))) (unless (symbolp name) (compiler-error "Variable name is not a symbol: ~S." name)) - (or (gethash name *free-variables*) + (or (gethash name *free-vars*) (let ((kind (info :variable :kind name)) (type (info :variable :type name)) (where-from (info :variable :where-from name))) (when (and (eq where-from :assumed) (eq kind :global)) (note-undefined-reference name :variable)) - (setf (gethash name *free-variables*) + (setf (gethash name *free-vars*) (case kind (:alien (info :variable :alien-info name)) @@ -448,14 +447,14 @@ (cons form *current-path*)))) (if (atom form) (cond ((and (symbolp form) (not (keywordp form))) - (ir1-convert-variable start cont form)) + (ir1-convert-var start cont form)) ((leaf-p form) (reference-leaf start cont form)) (t (reference-constant start cont form))) (let ((opname (car form))) (cond ((symbolp opname) - (let ((lexical-def (lexenv-find opname functions))) + (let ((lexical-def (lexenv-find opname funs))) (typecase lexical-def (null (ir1-convert-global-functoid start cont form)) (functional @@ -547,12 +546,12 @@ (use-continuation res cont))) ;;; Convert a reference to a symbolic constant or variable. If the -;;; symbol is entered in the LEXENV-VARIABLES we use that definition, +;;; symbol is entered in the LEXENV-VARS we use that definition, ;;; otherwise we find the current global definition. This is also ;;; where we pick off symbol macro and alien variable references. -(defun ir1-convert-variable (start cont name) +(defun ir1-convert-var (start cont name) (declare (type continuation start cont) (symbol name)) - (let ((var (or (lexenv-find name variables) (find-free-variable name)))) + (let ((var (or (lexenv-find name vars) (find-free-var name)))) (etypecase var (leaf (when (lambda-var-p var) @@ -853,8 +852,8 @@ (dolist (var-name (rest decl)) (let* ((bound-var (find-in-bindings vars var-name)) (var (or bound-var - (lexenv-find var-name variables) - (find-free-variable var-name)))) + (lexenv-find var-name vars) + (find-free-var var-name)))) (etypecase var (leaf (let* ((old-type (or (lexenv-find var type-restrictions) @@ -885,7 +884,7 @@ (if (or (restr) (new-vars)) (make-lexenv :default res :type-restrictions (restr) - :variables (new-vars)) + :vars (new-vars)) res)))) ;;; This is somewhat similar to PROCESS-TYPE-DECL, but handles @@ -942,7 +941,7 @@ (unless (assoc name (new-venv) :test #'eq) (new-venv (cons name (specvar-for-binding name)))))))) (if (new-venv) - (make-lexenv :default res :variables (new-venv)) + (make-lexenv :default res :vars (new-venv)) res))) ;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP. @@ -985,7 +984,7 @@ new-fenv))))))) (if new-fenv - (make-lexenv :default res :functions new-fenv) + (make-lexenv :default res :funs new-fenv) res))) ;;; Like FIND-IN-BINDINGS, but looks for #'foo in the fvars. @@ -1104,7 +1103,7 @@ ;;; anonymous GLOBAL-VAR. (defun specvar-for-binding (name) (cond ((not (eq (info :variable :where-from name) :assumed)) - (let ((found (find-free-variable name))) + (let ((found (find-free-var name))) (when (heap-alien-info-p found) (compiler-error "~S is an alien variable and so can't be declared special." @@ -1143,7 +1142,7 @@ (compiler-error "The name of the lambda-variable ~S is a constant." name)) (cond ((eq kind :special) - (let ((specvar (find-free-variable name))) + (let ((specvar (find-free-var name))) (make-lambda-var :%source-name name :type (leaf-type specvar) :where-from (leaf-where-from specvar) @@ -1361,8 +1360,8 @@ ;;; Create a lambda node out of some code, returning the result. The ;;; bindings are specified by the list of VAR structures VARS. We deal -;;; with adding the names to the LEXENV-VARIABLES for the conversion. -;;; The result is added to the NEW-FUNS in the *CURRENT-COMPONENT* and +;;; with adding the names to the LEXENV-VARS for the conversion. The +;;; result is added to the NEW-FUNS in the *CURRENT-COMPONENT* and ;;; linked to the component head and tail. ;;; ;;; We detect special bindings here, replacing the original VAR in the @@ -1422,7 +1421,7 @@ (note-lexical-binding (leaf-source-name var)) (new-venv (cons (leaf-source-name var) var)))))) - (let ((*lexenv* (make-lexenv :variables (new-venv) + (let ((*lexenv* (make-lexenv :vars (new-venv) :lambda lambda :cleanup nil))) (setf (bind-lambda bind) lambda) @@ -1940,12 +1939,11 @@ :default (process-decls decls nil nil (make-continuation) (make-null-lexenv)) - :variables (copy-list symbol-macros) - :functions - (mapcar (lambda (x) - `(,(car x) . - (macro . ,(coerce (cdr x) 'function)))) - macros) + :vars (copy-list symbol-macros) + :funs (mapcar (lambda (x) + `(,(car x) . + (macro . ,(coerce (cdr x) 'function)))) + macros) :policy (lexenv-policy *lexenv*)))) (ir1-convert-lambda `(lambda ,@body) :source-name source-name diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 6c1b5e0..987c24a 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -386,8 +386,7 @@ ;;; slot values. Values for the alist slots are NCONCed to the ;;; beginning of the current value, rather than replacing it entirely. (defun make-lexenv (&key (default *lexenv*) - functions variables blocks tags type-restrictions - options + funs vars blocks tags type-restrictions options (lambda (lexenv-lambda default)) (cleanup (lexenv-cleanup default)) (policy (lexenv-policy default))) @@ -397,8 +396,8 @@ (nconc ,var old) old)))) (internal-make-lexenv - (frob functions lexenv-functions) - (frob variables lexenv-variables) + (frob funs lexenv-funs) + (frob vars lexenv-vars) (frob blocks lexenv-blocks) (frob tags lexenv-tags) (frob type-restrictions lexenv-type-restrictions) diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 0726e52..0b1f956 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -19,14 +19,14 @@ (def!struct (lexenv (:constructor make-null-lexenv ()) (:constructor internal-make-lexenv - (functions variables blocks tags type-restrictions - lambda cleanup policy options))) + (funs vars blocks tags type-restrictions + lambda cleanup policy options))) ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a ;; local function), a DEFINED-FUN, representing an ;; INLINE/NOTINLINE declaration, or a list (MACRO . ) (a ;; local macro, with the specifier expander). Note that NAME may be ;; a (SETF ) list, not necessarily a single symbol. - (functions nil :type list) + (funs nil :type list) ;; an alist translating variable names to LEAF structures. A special ;; binding is indicated by a :SPECIAL GLOBAL-VAR leaf. Each special ;; binding within the code gets a distinct leaf structure, as does @@ -36,7 +36,7 @@ ;; ;; If the CDR is (MACRO . ), then is the expansion of a ;; symbol macro. - (variables nil :type list) + (vars nil :type list) ;; BLOCKS and TAGS are alists from block and go-tag names to 2-lists ;; of the form ( ), where is the ;; continuation to exit to, and is the corresponding ENTRY node. @@ -85,5 +85,5 @@ ;; by LAMBDA, but this implementation doesn't try. (and (null (lexenv-blocks lexenv)) (null (lexenv-tags lexenv)) - (null (lexenv-variables lexenv)) - (null (lexenv-functions lexenv)))) + (null (lexenv-vars lexenv)) + (null (lexenv-funs lexenv)))) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index 444960c..1141310 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -694,7 +694,7 @@ ;;; Bind the hashtables used for keeping track of global variables, ;;; functions, etc. Also establish condition handlers. (defmacro with-ir1-namespace (&body forms) - `(let ((*free-variables* (make-hash-table :test 'eq)) + `(let ((*free-vars* (make-hash-table :test 'eq)) (*free-funs* (make-hash-table :test 'equal)) (*constants* (make-hash-table :test 'equal)) (*source-paths* (make-hash-table :test 'eq))) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 82faea7..0fc8dc0 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -14,7 +14,7 @@ (in-package "SB!C") ;;; FIXME: Doesn't this belong somewhere else, like early-c.lisp? -(declaim (special *constants* *free-variables* *component-being-compiled* +(declaim (special *constants* *free-vars* *component-being-compiled* *code-vector* *next-location* *result-fixups* *free-funs* *source-paths* *seen-blocks* *seen-funs* *list-conflicts-table* @@ -507,7 +507,7 @@ ;;;; global data structures entirely when possible and consing up the ;;;; others from scratch instead of clearing and reusing them? -;;; Clear the INFO in constants in the *FREE-VARIABLES*, etc. In +;;; Clear the INFO in constants in the *FREE-VARS*, etc. In ;;; addition to allowing stuff to be reclaimed, this is required for ;;; correct assignment of constant offsets, since we need to assign a ;;; new offset for each component. We don't clear the FUNCTIONAL-INFO @@ -522,7 +522,7 @@ (declare (ignore k)) (when (constant-p v) (setf (leaf-info v) nil))) - *free-variables*) + *free-vars*) (values)) ;;; Blow away the REFS for all global variables, and let COMPONENT @@ -541,7 +541,7 @@ x)) (here-p (x) (eq (node-component x) component))) - (blast *free-variables*) + (blast *free-vars*) (blast *free-funs*) (blast *constants*)) (values)) @@ -557,7 +557,7 @@ ;; Clear global tables. (when (boundp '*free-funs*) (clrhash *free-funs*) - (clrhash *free-variables*) + (clrhash *free-vars*) (clrhash *constants*)) ;; Clear debug counters and tables. diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index acea779..0a62a5c 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -19,7 +19,7 @@ (defvar *undefined-warnings*) (declaim (list *undefined-warnings*)) -;;; Look up some symbols in *FREE-VARIABLES*, returning the var +;;; Look up some symbols in *FREE-VARS*, returning the var ;;; structures for any which exist. If any of the names aren't ;;; symbols, we complain. (declaim (ftype (function (list) list) get-old-vars)) @@ -28,7 +28,7 @@ (dolist (name names (vars)) (unless (symbolp name) (compiler-error "The name ~S is not a symbol." name)) - (let ((old (gethash name *free-variables*))) + (let ((old (gethash name *free-vars*))) (when old (vars old)))))) ;;; Return a new POLICY containing the policy information represented diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp index a29e048..0589bd1 100644 --- a/src/pcl/walk.lisp +++ b/src/pcl/walk.lisp @@ -75,13 +75,12 @@ ;;; In SBCL, as in CMU CL before it, the environment is represented ;;; with a structure that holds alists for the functional things, -;;; variables, blocks, etc. -;;; Except for SYMBOL-MACROLET, only the SB-C::LEXENV-FUNCTIONS slot -;;; is relevant. It holds: Alist (Name . What), where What is either -;;; a functional (a local function) or a list (MACRO . ) (a -;;; local macro, with the specifier expander.) Note that Name may be a -;;; (SETF ) function. -;;; Accessors are defined below, eg (ENV-WALK-FUNCTION ENV). +;;; variables, blocks, etc. Except for SYMBOL-MACROLET, only the +;;; SB-C::LEXENV-FUNS slot is relevant. It holds: Alist (Name . What), +;;; where What is either a functional (a local function) or a list +;;; (MACRO . ) (a local macro, with the specifier expander.) +;;; Note that Name may be a (SETF ) function. Accessors are +;;; defined below, eg (ENV-WALK-FUNCTION ENV). ;;; ;;; If WITH-AUGMENTED-ENVIRONMENT is called from WALKER-ENVIRONMENT-BIND ;;; this code hides the WALKER version of an environment @@ -138,7 +137,7 @@ (declare (type function bogo-fun)) (funcall bogo-fun *bogo-fun-magic-tag*)) -(defun with-augmented-environment-internal (env functions macros) +(defun with-augmented-environment-internal (env funs macros) ;; Note: In order to record the correct function definition, we ;; would have to create an interpreted closure, but the ;; WITH-NEW-DEFINITION macro down below makes no distinction between @@ -149,28 +148,29 @@ (let ((lexenv (sb-kernel::coerce-to-lexenv env))) (sb-c::make-lexenv :default lexenv - :functions - (append (mapcar (lambda (f) - (cons (car f) (sb-c::make-functional :lexenv lexenv))) - functions) - (mapcar (lambda (m) - (list* (car m) - 'sb-c::macro - (if (eq (car m) *key-to-walker-environment*) - (walker-info-to-bogo-fun (cadr m)) - (coerce (cadr m) 'function)))) - macros))))) + :funs (append (mapcar (lambda (f) + (cons (car f) + (sb-c::make-functional :lexenv lexenv))) + funs) + (mapcar (lambda (m) + (list* (car m) + 'sb-c::macro + (if (eq (car m) + *key-to-walker-environment*) + (walker-info-to-bogo-fun (cadr m)) + (coerce (cadr m) 'function)))) + macros))))) (defun environment-function (env fn) (when env - (let ((entry (assoc fn (sb-c::lexenv-functions env) :test #'equal))) + (let ((entry (assoc fn (sb-c::lexenv-funs env) :test #'equal))) (and entry (sb-c::functional-p (cdr entry)) (cdr entry))))) (defun environment-macro (env macro) (when env - (let ((entry (assoc macro (sb-c::lexenv-functions env) :test #'eq))) + (let ((entry (assoc macro (sb-c::lexenv-funs env) :test #'eq))) (and entry (eq (cadr entry) 'sb-c::macro) (if (eq macro *key-to-walker-environment*) diff --git a/version.lisp-expr b/version.lisp-expr index afaec7c..cb6b650 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.130" +"0.pre7.132" -- 1.7.10.4