[Sbcl-commits] CVS: sbcl/src/compiler/generic genesis.lisp, 1.152, 1.153 objdef.lisp, 1.64, 1.65 target-core.lisp, 1.21, 1.22

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv31988/src/compiler/generic

Modified Files:
	genesis.lisp objdef.lisp target-core.lisp 
Log Message:
1.0.29.24: preserve docstrings for local and anonymous functions

  Based on patch by Lessie Polzer: 

* Rename SIMPLE-FUN-XREFS to SIMPLE-FUN-INFO. Slot holds the docstring
  and/or XREF vector for the function. This saves space in the common
  case of no dostring -- the patch actually ends up shrinking
  sbcl.core a bit.

* Teach the compiler how to grab the docstrings from LAMBDAs and how
  to preserve them for the lambdas constructed for FLET and LABELS
  functions.

* Store COMPILER-MACRO documentation in the COMPILER-MACRO-FUNCTION.

* Store macro documentation in the MACRO-FUNCTION.

* Nuke (INFO :FUNCTION :DOCUMENTATION).


Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.152
retrieving revision 1.153
diff -u -d -r1.152 -r1.153
--- genesis.lisp	6 May 2009 16:28:03 -0000	1.152
+++ genesis.lisp	21 Jun 2009 10:26:25 -0000	1.153
@@ -2492,7 +2492,7 @@
     (write-wordindexed code slot value)))
 
 (define-cold-fop (fop-fun-entry)
-  (let* ((xrefs (pop-stack))
+  (let* ((info (pop-stack))
          (type (pop-stack))
          (arglist (pop-stack))
          (name (pop-stack))
@@ -2550,7 +2550,7 @@
     (write-wordindexed fn sb!vm:simple-fun-name-slot name)
     (write-wordindexed fn sb!vm:simple-fun-arglist-slot arglist)
     (write-wordindexed fn sb!vm:simple-fun-type-slot type)
-    (write-wordindexed fn sb!vm::simple-fun-xrefs-slot xrefs)
+    (write-wordindexed fn sb!vm::simple-fun-info-slot info)
     fn))
 
 (define-cold-fop (fop-foreign-fixup)

Index: objdef.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/objdef.lisp,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- objdef.lisp	8 May 2009 19:08:08 -0000	1.64
+++ objdef.lisp	21 Jun 2009 10:26:25 -0000	1.65
@@ -14,9 +14,6 @@
 ;;;; KLUDGE: The primitive objects here may look like self-contained
 ;;;; definitions, but in general they're not. In particular, if you
 ;;;; try to add a slot to them, beware of the following:
-;;;;   * (mysterious crashes which occur after changing the length
-;;;;     of SIMPLE-FUN, just adding a new slot not even doing anything
-;;;;     with it, still dunno why)
 ;;;;   * The GC scavenging code (and for all I know other GC code too)
 ;;;;     is not automatically generated from these layouts, but instead
 ;;;;     was hand-written to correspond to them. The offsets are
@@ -214,11 +211,13 @@
         :ref-trans %simple-fun-type
         :set-known (unsafe)
         :set-trans (setf %simple-fun-type))
-  (xrefs :init :null
-         :ref-trans %simple-fun-xrefs
-         :ref-known (flushable)
-         :set-trans (setf %simple-fun-xrefs)
-         :set-known ())
+  ;; NIL for empty, STRING for a docstring, SIMPLE-VECTOR for XREFS, and (CONS
+  ;; STRING SIMPLE-VECTOR) for both.
+  (info :init :null
+        :ref-trans %simple-fun-info
+        :ref-known (flushable)
+        :set-trans (setf %simple-fun-info)
+        :set-known (unsafe))
   ;; the SB!C::DEBUG-FUN object corresponding to this object, or NIL for none
   #+nil ; FIXME: doesn't work (gotcha, lowly maintenoid!) See notes on bug 137.
   (debug-fun :ref-known (flushable)

Index: target-core.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/target-core.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- target-core.lisp	1 Dec 2008 19:32:33 -0000	1.21
+++ target-core.lisp	21 Jun 2009 10:26:25 -0000	1.22
@@ -41,7 +41,7 @@
       (setf (%simple-fun-name res) (entry-info-name entry-info))
       (setf (%simple-fun-arglist res) (entry-info-arguments entry-info))
       (setf (%simple-fun-type res) (entry-info-type entry-info))
-      (setf (%simple-fun-xrefs res) (entry-info-xref entry-info))
+      (setf (%simple-fun-info res) (entry-info-info entry-info))
 
       (note-fun entry-info res object))))