added various /SHOW0-ish statements to help when debugging internal

error handling

The MAKE-SPECIALIZABLE-ARRAY call in DEFUN INTERNAL-ERROR-ARGUMENTS
can become MAKE-ARRAY, since M-S-A is something to make it easier to
build parts of the cross-compiler under the cross-compilation host,
and DEFUN INTERNAL-ERROR-ARGUMENTS is in x86-vm.lisp, which is not
part of the cross-compiler, and so is never compiled by the
cross-compilation host.

changed MAKE-VALID-LISP-OBJ from a MACROLET macro to a global
function, for clarity and easier debugging

deleted unused SET-VALUE macro from MACROLET in DEFERR

deleted code marked REMOVEME, accidentally left over from previous
debugging exercises

changed CONTEXT-PC-ADDR, CONTEXT-PC, CONTEXT-REGISTER-ADDR, and
CONTEXT-REGISTER functions to use unsigned representations instead of
signed representations, to conform to implicit assumptions in the
debug-int code inherited from CMU CL. (Without this, new type errors
are generated in infinite regress when we try to handle errors
involving negative fixnums, e.g. (BUTLAST NIL -1).)

tweaked stuff in test/ directory a little bit in anticipation of
setting up real regression tests

diff --git a/INSTALL b/INSTALL
index ddc79bd..728f6db 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -83,6 +83,13 @@ making it run on more systems, would be appreciated.
        problem with quotas, I don't know.)
 
 To build the system binaries:
        problem with quotas, I don't know.)
 
 To build the system binaries:

+  0. If you want to be on the bleeding edge, you can update your
+     sources to the latest development snapshot (or any previous
+     development snapshot, for that matter) by using anonymous CVS
+     to SourceForge. (This is not recommended if you're just using SBCL
+     as a tool for other work, but if you're interested in working on 
+     SBCL itself, it's a good idea.) Follow the "CVS Repository" link on
+     <http://sourceforge.net/projects/sbcl> for instructions.

   1. Make sure that you have enough RAM+swap to build SBCL, as
      per the CAUTION note above. (As of version 0.6.0, the most
      memory-intensive operation in make.sh is the second call to
   1. Make sure that you have enough RAM+swap to build SBCL, as
      per the CAUTION note above. (As of version 0.6.0, the most
      memory-intensive operation in make.sh is the second call to

@@ -93,7 +100,7 @@ To build the system binaries:
   2. If the GNU make command is not available under the name "gmake",
      then define the environment variable GNUMAKE to a name where it can
      be found.
   2. If the GNU make command is not available under the name "gmake",
      then define the environment variable GNUMAKE to a name where it can
      be found.

-  3. If you like, you can edit the base-features.lisp-expr file
+  3. If you like, you can edit the base-target-features.lisp-expr file

      to customize the resulting Lisp system. By enabling or disabling
      features in this file, you can create a smaller system, or one
      with extra code for debugging output or error-checking or other things.
      to customize the resulting Lisp system. By enabling or disabling
      features in this file, you can create a smaller system, or one
      with extra code for debugging output or error-checking or other things.

diff --git a/NEWS b/NEWS
index 7d0c0ed..ef34065 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -466,15 +466,16 @@ changes in sbcl-0.6.7 relative to sbcl-0.6.6:
 
 changes in sbcl-0.6.8 relative to sbcl-0.6.7:
 
 
 changes in sbcl-0.6.8 relative to sbcl-0.6.7:
 

-?? The system is now under CVS at SourceForge (instead of the
+* The system is now under CVS at SourceForge (instead of the

   CVS repository on my home machine).
   CVS repository on my home machine).

-?? The INSTALL file has been updated with some information 
-  about using anonymous CVS to download the most recent version
-  from SourceForge.
-?? There's now code in the tests/ subdirectory to run the system
-  through the clocc/ansi-tests/ suite, and to run additional
-  SBCL-specific regression tests as well. (It's not particularly
-  mature right now, but it's a start.)
+* The new signal handling code has been tweaked to treat register
+  contents as (UNSIGNED-BYTE 32), as the old CMU CL code did,
+  instead of (SIGNED-BYTE 32), as the C header files have it. (Code 
+  downstream, e.g. in debug-int.lisp, has implicit dependencies
+  on the unsignedness of integer representation of machine words, 
+  and that caused the system to bomb out with infinite regress
+  when trying to recover from type errors involving signed values,
+  e.g. (BUTLAST '(1 2 3) -1).)

 ?? The system now uses code based on Colin Walters' O(N)
   implementation of MAP (from the cmucl-imp@cons.org mailing
   list, 2 September 2000) when it can't use a DEFTRANSFORM to
 ?? The system now uses code based on Colin Walters' O(N)
   implementation of MAP (from the cmucl-imp@cons.org mailing
   list, 2 September 2000) when it can't use a DEFTRANSFORM to

@@ -489,13 +490,6 @@ changes in sbcl-0.6.8 relative to sbcl-0.6.7:
   CREDITS file.)
 ?? The debugger now flushes standard output streams before it begins
   its output ("debugger invoked" and so forth).
   CREDITS file.)
 ?? The debugger now flushes standard output streams before it begins
   its output ("debugger invoked" and so forth).

-?? The two problem cases reported by Peter Van Eynde on 8 Sep 2000, 
-  (BUTLAST '(1 2 3) -1) and (MAKE-LIST -1), now work, and test cases
-  have now been added to the regression test suite to keep them
-  from appearing again. (This was a repeat appearance, alas!)
-  As the regression test system gets more mature, I intend to add
-  most future fixed bugs to it, but at this point I'm still playing
-  with it.

 ?? The patch for the SUBSEQ bug reported on the cmucl-imp mailing
   list 12 September 2000 has been applied to SBCL.
 ?? Martin Atzmueller's versions of two CMU CL patches, as posted on 
 ?? The patch for the SUBSEQ bug reported on the cmucl-imp mailing
   list 12 September 2000 has been applied to SBCL.
 ?? Martin Atzmueller's versions of two CMU CL patches, as posted on 

diff --git a/TODO b/TODO
index 8aceeeb..e3a1964 100644 (file)
--- a/TODO
+++ b/TODO
@@ -30,7 +30,7 @@ FIX:
 PROBLEM:
            As long as I'm working on the batch-related command-line options,
        it would be reasonable to add one more option to "do what I'd want",
 PROBLEM:
            As long as I'm working on the batch-related command-line options,
        it would be reasonable to add one more option to "do what I'd want",

-       testing standard input for TTY-ness and running in no-programmer
+       testing standard input for non-TTY-ness and running in no-programmer

        mode if so.
 FIX:
        ?? Do it.
        mode if so.
 FIX:
        ?? Do it.

@@ -48,6 +48,11 @@ PROBLEM:
        some functions, and I never realized that there's a wrapper-based
        facility too until I was wading through the source code for SBCL.
            Yes, I know I should have RTFM, but there is a lot of M..
        some functions, and I never realized that there's a wrapper-based
        facility too until I was wading through the source code for SBCL.
            Yes, I know I should have RTFM, but there is a lot of M..

+           (By the way, it would also be nice to have tracing behave
+       better with generic functions. TRACEing a generic function probably
+       shouldn't prevent DEFMETHOD from being used to redefine its
+       methods, and should perhaps trace each of its methods as well
+       as the generic function itself.)

 FIX:
        ?? possibility 1: Add error-handling code in ntrace.lisp to
          catch failure to set breakpoints and retry using 
 FIX:
        ?? possibility 1: Add error-handling code in ntrace.lisp to
          catch failure to set breakpoints and retry using 

@@ -75,7 +80,8 @@ FIX:
        ??
 -------------------------------------------------------------------------------
 PROBLEM:
        ??
 -------------------------------------------------------------------------------
 PROBLEM:

-           My system of parallel build directories doesn't seem to add value.
+           My system of parallel build directories seems to add
+       complexity without adding value.

 FIX:
        ?? Replace it with a system where fasl output files live in the 
          same directories as the sources and have names a la
 FIX:
        ?? Replace it with a system where fasl output files live in the 
          same directories as the sources and have names a la

@@ -121,17 +127,6 @@ PROBLEM:
            The hashing code is new and should be tested.
 FIX:
        ?? Enable the existing test code.
            The hashing code is new and should be tested.
 FIX:
        ?? Enable the existing test code.

--------------------------------------------------------------------------------
-PROBLEM:
-           My ad hoc system of revision control is looking pretty clunky,
-       and I've pretty much stopped doing stuff to confuse CVS (like moving
-       directories around).
-FIX:
-       ?? Check into CVS. 
-       ?? Make sure that the tags in FILE-COMMENTs expand correctly.
-       ?? See about automatically propagating version information 
-          from CVS into the runtime.c banner message and the 
-          LISP-IMPLEMENTATION-VERSION string.

 ===============================================================================
 other known issues with no particular target date:
 
 ===============================================================================
 other known issues with no particular target date:
 

diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr
index 5a15461..43e1009 100644 (file)
--- a/base-target-features.lisp-expr
+++ b/base-target-features.lisp-expr
@@ -97,7 +97,7 @@
  ;; If you want to be able to use the extra debugging information,
  ;; therefore, be sure to keep the sources around, and run with the
  ;; readtable configured so that the system sources can be read.
  ;; If you want to be able to use the extra debugging information,
  ;; therefore, be sure to keep the sources around, and run with the
  ;; readtable configured so that the system sources can be read.

- ; :sb-show
+ ;:sb-show

 
  ;; Enable extra debugging output in the assem.lisp assembler/scheduler
  ;; code. (This is the feature which was called :DEBUG in the
 
  ;; Enable extra debugging output in the assem.lisp assembler/scheduler
  ;; code. (This is the feature which was called :DEBUG in the

diff --git a/make-target-2.sh b/make-target-2.sh
index 3d7990f..16f1e9c 100644 (file)
--- a/make-target-2.sh
+++ b/make-target-2.sh
@@ -33,7 +33,7 @@ echo //doing warm init
              (*print-level* 5))
           (sb!int:/show "about to LOAD warm.lisp")
          (load "src/cold/warm.lisp"))
              (*print-level* 5))
           (sb!int:/show "about to LOAD warm.lisp")
          (load "src/cold/warm.lisp"))

-        (sb-int:/show "about to SAVE-LISP-AND-DIE")
+        (sb-int:/show "done with warm.lisp, about to SAVE-LISP-AND-DIE")

        ;; Even if /SHOW output was wanted during build, it's probably
        ;; not wanted by default after build is complete. (And if it's
        ;; wanted, it can easily be turned back on.)
        ;; Even if /SHOW output was wanted during build, it's probably
        ;; not wanted by default after build is complete. (And if it's
        ;; wanted, it can easily be turned back on.)

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 3482adf..96d064c 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -2452,6 +2452,39 @@
         (or (compiled-debug-var-save-sc-offset debug-var)
             (compiled-debug-var-sc-offset debug-var))))))
 
         (or (compiled-debug-var-save-sc-offset debug-var)
             (compiled-debug-var-sc-offset debug-var))))))
 

+;;; a helper function for working with possibly-invalid values:
+;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
+;;;
+;;; (Such values can arise in registers on machines with conservative
+;;; GC, and might also arise in debug variable locations when
+;;; those variables are invalid.)
+(defun make-valid-lisp-obj (val)
+  (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
+  #!+sb-show (%primitive print (sb!impl::hexstr val))
+  (if (or
+       ;; fixnum
+       (zerop (logand val 3))
+       ;; character
+       (and (zerop (logand val #xffff0000)) ; Top bits zero
+           (= (logand val #xff) sb!vm:base-char-type)) ; Char tag
+       ;; unbound marker
+       (= val sb!vm:unbound-marker-type)
+       ;; pointer
+       (and (logand val 1)
+           ;; Check that the pointer is valid. XXX Could do a better
+           ;; job. FIXME: e.g. by calling out to an is_valid_pointer
+           ;; routine in the C runtime support code
+           (or (< (sb!impl::read-only-space-start) val
+                  (* sb!impl::*read-only-space-free-pointer*
+                     sb!vm:word-bytes))
+               (< (sb!impl::static-space-start) val
+                  (* sb!impl::*static-space-free-pointer*
+                     sb!vm:word-bytes))
+               (< (sb!impl::current-dynamic-space-start) val
+                  (sap-int (dynamic-space-free-pointer))))))
+      (make-lisp-obj val)
+      :invalid-object))
+

 ;;; CMU CL had
 ;;;   (DEFUN SUB-ACCESS-DEBUG-VAR-SLOT (FP SC-OFFSET &OPTIONAL ESCAPED) ..)
 ;;; code for this case.
 ;;; CMU CL had
 ;;;   (DEFUN SUB-ACCESS-DEBUG-VAR-SLOT (FP SC-OFFSET &OPTIONAL ESCAPED) ..)
 ;;; code for this case.

@@ -2462,102 +2495,100 @@
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))

+  (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")
+  #!+sb-show (%primitive print (sb!impl::hexstr fp))
+  #!+sb-show (%primitive print (sb!impl::hexstr sc-offset))
+  #!+sb-show (%primitive print (sb!impl::hexstr escaped))

   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped
   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped

-                (let ((,var (sb!vm:context-register
-                             escaped (sb!c:sc-offset-offset sc-offset))))
-                  ,@forms)
-                :invalid-value-for-unescaped-register-storage))
+                   (let ((,var (sb!vm:context-register
+                                escaped
+                                (sb!c:sc-offset-offset sc-offset))))
+                     (/show0 "in escaped case, ,VAR value=..")
+                     #!+sb-show (%primitive print (sb!impl::hexstr ,var))
+                     ,@forms)
+                   :invalid-value-for-unescaped-register-storage))

             (escaped-float-value (format)
               `(if escaped
             (escaped-float-value (format)
               `(if escaped

-                (sb!vm:context-float-register
-                 escaped (sb!c:sc-offset-offset sc-offset) ',format)
-                :invalid-value-for-unescaped-register-storage))
+                   (sb!vm:context-float-register
+                    escaped (sb!c:sc-offset-offset sc-offset) ',format)
+                   :invalid-value-for-unescaped-register-storage))

             (escaped-complex-float-value (format)
               `(if escaped
             (escaped-complex-float-value (format)
               `(if escaped

-                (complex
-                 (sb!vm:context-float-register
-                  escaped (sb!c:sc-offset-offset sc-offset) ',format)
-                 (sb!vm:context-float-register
-                  escaped (1+ (sb!c:sc-offset-offset sc-offset)) ',format))
-                :invalid-value-for-unescaped-register-storage))
-            ;; The debug variable locations are not always valid, and
-            ;; on the x86 locations can contain raw values. To
-            ;; prevent later problems from invalid objects, they are
-            ;; filtered here.
-            (make-valid-lisp-obj (val)
-              `(if (or
-                    ;; fixnum
-                    (zerop (logand ,val 3))
-                    ;; character
-                    (and (zerop (logand ,val #xffff0000)) ; Top bits zero
-                     (= (logand ,val #xff) sb!vm:base-char-type)) ; Char tag
-                    ;; unbound marker
-                    (= ,val sb!vm:unbound-marker-type)
-                    ;; pointer
-                    (and (logand ,val 1)
-                     ;; Check that the pointer is valid. XXX Could do a
-                     ;; better job.
-                     (or (< (sb!impl::read-only-space-start) ,val
-                            (* sb!impl::*read-only-space-free-pointer*
-                               sb!vm:word-bytes))
-                         (< (sb!impl::static-space-start) ,val
-                            (* sb!impl::*static-space-free-pointer*
-                               sb!vm:word-bytes))
-                         (< (sb!impl::current-dynamic-space-start) ,val
-                            (sap-int (dynamic-space-free-pointer))))))
-                (make-lisp-obj ,val)
-                :invalid-object)))
+                   (complex
+                    (sb!vm:context-float-register
+                     escaped (sb!c:sc-offset-offset sc-offset) ',format)
+                    (sb!vm:context-float-register
+                     escaped (1+ (sb!c:sc-offset-offset sc-offset)) ',format))
+                   :invalid-value-for-unescaped-register-storage)))

     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)

+       (/show0 "case of ANY-REG-SC-NUMBER or DESCRIPTOR-REG-SC-NUMBER")

        (without-gcing
        (with-escaped-value (val)
        (without-gcing
        (with-escaped-value (val)

+         (/show0 "VAL=..")
+         #!+sb-show (%primitive print (sb!impl::hexstr val))

          (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number
          (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number

+       (/show0 "case of BASE-CHAR-REG-SC-NUMBER")

        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number
        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number

+       (/show0 "case of SAP-REG-SC-NUMBER")

        (with-escaped-value (val)
         (int-sap val)))
       (#.sb!vm:signed-reg-sc-number
        (with-escaped-value (val)
         (int-sap val)))
       (#.sb!vm:signed-reg-sc-number

+       (/show0 "case of SIGNED-REG-SC-NUMBER")

        (with-escaped-value (val)
         (if (logbitp (1- sb!vm:word-bits) val)
             (logior val (ash -1 sb!vm:word-bits))
             val)))
       (#.sb!vm:unsigned-reg-sc-number
        (with-escaped-value (val)
         (if (logbitp (1- sb!vm:word-bits) val)
             (logior val (ash -1 sb!vm:word-bits))
             val)))
       (#.sb!vm:unsigned-reg-sc-number

+       (/show0 "case of UNSIGNED-REG-SC-NUMBER")

        (with-escaped-value (val)
         val))
       (#.sb!vm:single-reg-sc-number
        (with-escaped-value (val)
         val))
       (#.sb!vm:single-reg-sc-number

+       (/show0 "case of SINGLE-REG-SC-NUMBER")

        (escaped-float-value single-float))
       (#.sb!vm:double-reg-sc-number
        (escaped-float-value single-float))
       (#.sb!vm:double-reg-sc-number

+       (/show0 "case of DOUBLE-REG-SC-NUMBER")

        (escaped-float-value double-float))
       #!+long-float
       (#.sb!vm:long-reg-sc-number
        (escaped-float-value double-float))
       #!+long-float
       (#.sb!vm:long-reg-sc-number

+       (/show0 "case of LONG-REG-SC-NUMBER")

        (escaped-float-value long-float))
       (#.sb!vm:complex-single-reg-sc-number
        (escaped-float-value long-float))
       (#.sb!vm:complex-single-reg-sc-number

+       (/show0 "case of COMPLEX-SINGLE-REG-SC-NUMBER")

        (escaped-complex-float-value single-float))
       (#.sb!vm:complex-double-reg-sc-number
        (escaped-complex-float-value single-float))
       (#.sb!vm:complex-double-reg-sc-number

+       (/show0 "case of COMPLEX-DOUBLE-REG-SC-NUMBER")

        (escaped-complex-float-value double-float))
       #!+long-float
       (#.sb!vm:complex-long-reg-sc-number
        (escaped-complex-float-value double-float))
       #!+long-float
       (#.sb!vm:complex-long-reg-sc-number

+       (/show0 "case of COMPLEX-LONG-REG-SC-NUMBER")

        (escaped-complex-float-value long-float))
       (#.sb!vm:single-stack-sc-number
        (escaped-complex-float-value long-float))
       (#.sb!vm:single-stack-sc-number

+       (/show0 "case of SINGLE-STACK-SC-NUMBER")

        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                sb!vm:word-bytes))))
       (#.sb!vm:double-stack-sc-number
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                sb!vm:word-bytes))))
       (#.sb!vm:double-stack-sc-number

+       (/show0 "case of DOUBLE-STACK-SC-NUMBER")

        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                sb!vm:word-bytes))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                sb!vm:word-bytes))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number

+       (/show0 "case of LONG-STACK-SC-NUMBER")

        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                              sb!vm:word-bytes))))
       (#.sb!vm:complex-single-stack-sc-number
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                              sb!vm:word-bytes))))
       (#.sb!vm:complex-single-stack-sc-number

+       (/show0 "case of COMPLEX-STACK-SC-NUMBER")

        (complex
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                 sb!vm:word-bytes)))
        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:word-bytes)))))
       (#.sb!vm:complex-double-stack-sc-number
        (complex
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                 sb!vm:word-bytes)))
        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:word-bytes)))))
       (#.sb!vm:complex-double-stack-sc-number

+       (/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER")

        (complex
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:word-bytes)))
        (complex
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
                                 sb!vm:word-bytes)))

@@ -2565,24 +2596,30 @@
                                 sb!vm:word-bytes)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
                                 sb!vm:word-bytes)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number

+       (/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER")

        (complex
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                               sb!vm:word-bytes)))
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
                               sb!vm:word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (complex
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
                               sb!vm:word-bytes)))
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
                               sb!vm:word-bytes)))))
       (#.sb!vm:control-stack-sc-number

+       (/show0 "case of CONTROL-STACK-SC-NUMBER")

        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.sb!vm:base-char-stack-sc-number
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.sb!vm:base-char-stack-sc-number

+       (/show0 "case of BASE-CHAR-STACK-SC-NUMBER")

        (code-char
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:word-bytes)))))
       (#.sb!vm:unsigned-stack-sc-number
        (code-char
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:word-bytes)))))
       (#.sb!vm:unsigned-stack-sc-number

+       (/show0 "case of UNSIGNED-STACK-SC-NUMBER")

        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                            sb!vm:word-bytes))))
       (#.sb!vm:signed-stack-sc-number
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                            sb!vm:word-bytes))))
       (#.sb!vm:signed-stack-sc-number

+       (/show0 "case of SIGNED-STACK-SC-NUMBER")

        (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                   sb!vm:word-bytes))))
       (#.sb!vm:sap-stack-sc-number
        (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                   sb!vm:word-bytes))))
       (#.sb!vm:sap-stack-sc-number

+       (/show0 "case of SAP-STACK-SC-NUMBER")

        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:word-bytes)))))))
 
        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:word-bytes)))))))
 

diff --git a/src/code/debug-var-io.lisp b/src/code/debug-var-io.lisp
index 055b4df..0d0ba29 100644 (file)
--- a/src/code/debug-var-io.lisp
+++ b/src/code/debug-var-io.lisp
@@ -22,8 +22,13 @@
 ;;;;    254 => read next two bytes for integer
 ;;;;    255 => read next four bytes for integer
 
 ;;;;    254 => read next two bytes for integer
 ;;;;    255 => read next four bytes for integer
 

-;;; Given a byte vector Vec and an index variable Index, read a variable
-;;; length integer and advance index.
+;;; Given a byte vector VEC and an index variable INDEX, read a
+;;; variable length integer and advance index.
+;;;
+;;; FIXME: This is called O(20) times. It should be reimplemented
+;;; with much of its logic in a single service function which can
+;;; be called by the macro expansion:
+;;;   `(SETF ,INDEX (%READ-VAR-INTEGER ,VEC ,INDEX)).

 (defmacro read-var-integer (vec index)
   (once-only ((val `(aref ,vec ,index)))
     `(cond ((<= ,val 253)
 (defmacro read-var-integer (vec index)
   (once-only ((val `(aref ,vec ,index)))
     `(cond ((<= ,val 253)

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index c50b579..3a71d9a 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -567,10 +567,6 @@
                                   function))))
       (%enumerate-files head pathname verify-existence function)))
 
                                   function))))
       (%enumerate-files head pathname verify-existence function)))
 

-;;; REMOVEME after finding bug.
-#!+sb-show (defvar *show-directory*)
-#!+sb-show (defvar *show-name*)
-

 (defun %enumerate-files (directory pathname verify-existence function)
   (declare (simple-string directory))
   (/show0 "entering %ENUMERATE-FILES")
 (defun %enumerate-files (directory pathname verify-existence function)
   (declare (simple-string directory))
   (/show0 "entering %ENUMERATE-FILES")

@@ -614,13 +610,6 @@
                 (sb!unix:close-dir dir)))))
          (t
           (/show0 "default case")
                 (sb!unix:close-dir dir)))))
          (t
           (/show0 "default case")

-          
-          ;; Put DIRECTORY and NAME somewhere we can find them even when
-          ;; things are too screwed up for the debugger.
-          #!+sb-show (progn
-                       (setf *show-directory* directory
-                             *show-name* name))
-

           (let ((file (concatenate 'string directory name)))
             (/show0 "computed basic FILE=..")
             #!+sb-show (%primitive print file)
           (let ((file (concatenate 'string directory name)))
             (/show0 "computed basic FILE=..")
             #!+sb-show (%primitive print file)

diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 963c669..9f9d67d 100644 (file)
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -28,12 +28,11 @@
         (fp (gensym))
         (context (gensym))
         (sc-offsets (gensym))
         (fp (gensym))
         (context (gensym))
         (sc-offsets (gensym))

-        (temp (gensym))

         (fn-name (symbolicate name "-HANDLER")))
     `(progn
        ;; FIXME: Having a separate full DEFUN for each error doesn't
        ;; seem to add much value, and it takes a lot of space. Perhaps
         (fn-name (symbolicate name "-HANDLER")))
     `(progn
        ;; FIXME: Having a separate full DEFUN for each error doesn't
        ;; seem to add much value, and it takes a lot of space. Perhaps

-       ;; we could make this a big CASE statement instead?
+       ;; we could do this dispatch with a big CASE statement instead?

        (defun ,fn-name (name ,fp ,context ,sc-offsets)
         ;; FIXME: Perhaps put in OPTIMIZE declaration to make this
         ;; byte coded.
        (defun ,fn-name (name ,fp ,context ,sc-offsets)
         ;; FIXME: Perhaps put in OPTIMIZE declaration to make this
         ;; byte coded.

@@ -44,32 +43,24 @@
         ;; where his error was detected instead of telling him where
         ;; he ended up inside the system error-handling logic.
         (declare (ignorable name ,fp ,context ,sc-offsets))
         ;; where his error was detected instead of telling him where
         ;; he ended up inside the system error-handling logic.
         (declare (ignorable name ,fp ,context ,sc-offsets))

-        (macrolet ((set-value (var value)
-                     (let ((pos (position var ',required)))
-                       (unless pos
-                         (error "~S isn't one of the required args." var))
-                       `(let ((,',temp ,value))
-                          (sb!di::sub-set-debug-var-slot
-                           ,',fp (nth ,pos ,',sc-offsets)
-                           ,',temp ,',context)
-                          (setf ,var ,',temp)))))
-          (let (,@(let ((offset -1))
-                    (mapcar #'(lambda (var)
-                                `(,var (sb!di::sub-access-debug-var-slot
-                                        ,fp
-                                        (nth ,(incf offset)
-                                             ,sc-offsets)
-                                        ,context)))
-                            required))
-                  ,@(when rest-pos
-                      `((,(nth (1+ rest-pos) args)
-                         (mapcar #'(lambda (sc-offset)
-                                     (sb!di::sub-access-debug-var-slot
+        (/show0 "about to do outer LETs in DEFERR macroexpanded DEFUN")
+        (let (,@(let ((offset -1))
+                  (mapcar #'(lambda (var)
+                              `(,var (sb!di::sub-access-debug-var-slot

                                       ,fp
                                       ,fp

-                                      sc-offset
-                                      ,context))
-                                 (nthcdr ,rest-pos ,sc-offsets))))))
-            ,@body)))
+                                      (nth ,(incf offset)
+                                           ,sc-offsets)
+                                      ,context)))
+                          required))
+              ,@(when rest-pos
+                  `((,(nth (1+ rest-pos) args)
+                     (mapcar #'(lambda (sc-offset)
+                                 (sb!di::sub-access-debug-var-slot
+                                  ,fp
+                                  sc-offset
+                                  ,context))
+                             (nthcdr ,rest-pos ,sc-offsets))))))
+          ,@body))

        (setf (svref *internal-errors* ,(error-number-or-lose name))
             #',fn-name))))
 
        (setf (svref *internal-errors* ,(error-number-or-lose name))
             #',fn-name))))
 

@@ -283,6 +274,9 @@
         :operands (list this that)))
 
 (deferr object-not-type-error (object type)
         :operands (list this that)))
 
 (deferr object-not-type-error (object type)

+  (/show0 "entering body of DEFERR OBJECT-NOT-TYPE-ERROR, OBJECT,TYPE=..")
+  #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr object))
+  #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr type))

   (error (if (and (typep object 'instance)
                  (layout-invalid (%instance-layout object)))
             'layout-invalid
   (error (if (and (typep object 'instance)
                  (layout-invalid (%instance-layout object)))
             'layout-invalid

@@ -507,10 +501,12 @@
 
 (defun internal-error (context continuable)
   (declare (type system-area-pointer context) (ignore continuable))
 
 (defun internal-error (context continuable)
   (declare (type system-area-pointer context) (ignore continuable))

+  (/show0 "entering INTERNAL-ERROR, CONTEXT=..")
+  #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr context))

   (infinite-error-protect
    (let ((context (locally
   (infinite-error-protect
    (let ((context (locally

-                  (declare (optimize (inhibit-warnings 3)))
-                  (sb!alien:sap-alien context (* os-context-t)))))
+                   (declare (optimize (inhibit-warnings 3)))
+                   (sb!alien:sap-alien context (* os-context-t)))))

      (multiple-value-bind (error-number arguments)
         (sb!vm:internal-error-arguments context)
        (multiple-value-bind (name sb!debug:*stack-top-hint*)
      (multiple-value-bind (error-number arguments)
         (sb!vm:internal-error-arguments context)
        (multiple-value-bind (name sb!debug:*stack-top-hint*)

@@ -533,8 +529,7 @@
                 ((not (functionp handler))
                  (error 'simple-error
                         :function-name name
                 ((not (functionp handler))
                  (error 'simple-error
                         :function-name name

-                        :format-control
-                        "internal error ~D: ~A; args=~S"
+                        :format-control "internal error ~D: ~A; args=~S"

                         :format-arguments
                         (list error-number
                               handler
                         :format-arguments
                         (list error-number
                               handler

diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index bd08c4a..38aafab 100644 (file)
--- a/src/code/x86-vm.lisp
+++ b/src/code/x86-vm.lisp
@@ -188,25 +188,37 @@
 ;;;;      and internal error handling) the extra runtime cost should be
 ;;;;      negligible.
 
 ;;;;      and internal error handling) the extra runtime cost should be
 ;;;;      negligible.
 

-(def-alien-routine ("os_context_pc_addr" context-pc-addr) (* int)
+(def-alien-routine ("os_context_pc_addr" context-pc-addr) (* unsigned-int)
+  ;; (Note: Just as in CONTEXT-REGISTER-ADDR, we intentionally use an
+  ;; 'unsigned *' interpretation for the 32-bit word passed to us by
+  ;; the C code, even though the C code may think it's an 'int *'.)

   (context (* os-context-t)))
 
 (defun context-pc (context)
   (declare (type (alien (* os-context-t)) context))
   (int-sap (deref (context-pc-addr context))))
 
   (context (* os-context-t)))
 
 (defun context-pc (context)
   (declare (type (alien (* os-context-t)) context))
   (int-sap (deref (context-pc-addr context))))
 

-(def-alien-routine ("os_context_register_addr" context-register-addr) (* int)
+(def-alien-routine ("os_context_register_addr" context-register-addr)
+  (* unsigned-int)
+  ;; (Note the mismatch here between the 'int *' value that the C code
+  ;; may think it's giving us and the 'unsigned *' value that we
+  ;; receive. It's intentional: the C header files may think of
+  ;; register values as signed, but the CMU CL code tends to think of
+  ;; register values as unsigned, and might get bewildered if we ask
+  ;; it to work with signed values.)

   (context (* os-context-t))
   (index int))
 
   (context (* os-context-t))
   (index int))
 

+;;; FIXME: Should this and CONTEXT-PC be INLINE to reduce consing?
+;;; (Are they used in anything time-critical, or just the debugger?)

 (defun context-register (context index)
   (declare (type (alien (* os-context-t)) context))
   (deref (context-register-addr context index)))
 
 (defun %set-context-register (context index new)
 (defun context-register (context index)
   (declare (type (alien (* os-context-t)) context))
   (deref (context-register-addr context index)))
 
 (defun %set-context-register (context index new)

-  (declare (type (alien (* os-context-t)) context))
-  (setf (deref (context-register-addr context index))
-       new))
+(declare (type (alien (* os-context-t)) context))
+(setf (deref (context-register-addr context index))
+      new))

 
 ;;; Like CONTEXT-REGISTER, but returns the value of a float register.
 ;;; FORMAT is the type of float to return.
 
 ;;; Like CONTEXT-REGISTER, but returns the value of a float register.
 ;;; FORMAT is the type of float to return.

@@ -215,13 +227,13 @@
 ;;; so it's stubbed out. Someday, in order to make the debugger work
 ;;; better, it may be necessary to unstubify it.
 (defun context-float-register (context index format)
 ;;; so it's stubbed out. Someday, in order to make the debugger work
 ;;; better, it may be necessary to unstubify it.
 (defun context-float-register (context index format)

-  (declare (ignore context index format))
+  (declare (ignore context index))

   (warn "stub CONTEXT-FLOAT-REGISTER")
   (warn "stub CONTEXT-FLOAT-REGISTER")

-  (coerce 0.0 'format))
+  (coerce 0.0 format))

 (defun %set-context-float-register (context index format new-value)
 (defun %set-context-float-register (context index format new-value)

-  (declare (ignore context index format))
+  (declare (ignore context index))

   (warn "stub %SET-CONTEXT-FLOAT-REGISTER")
   (warn "stub %SET-CONTEXT-FLOAT-REGISTER")

-  (coerce new-value 'format))
+  (coerce new-value format))

 
 ;;; Given a signal context, return the floating point modes word in
 ;;; the same format as returned by FLOATING-POINT-MODES.
 
 ;;; Given a signal context, return the floating point modes word in
 ;;; the same format as returned by FLOATING-POINT-MODES.

@@ -251,26 +263,35 @@
 ;;; arguments from the instruction stream.
 (defun internal-error-arguments (context)
   (declare (type (alien (* os-context-t)) context))
 ;;; arguments from the instruction stream.
 (defun internal-error-arguments (context)
   (declare (type (alien (* os-context-t)) context))

+  (/show0 "entering INTERNAL-ERROR-ARGUMENTS, CONTEXT=..")
+  #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr context))

   (let ((pc (context-pc context)))
     (declare (type system-area-pointer pc))
     ;; using INT3 the pc is .. INT3 <here> code length bytes...
     (let* ((length (sap-ref-8 pc 1))
   (let ((pc (context-pc context)))
     (declare (type system-area-pointer pc))
     ;; using INT3 the pc is .. INT3 <here> code length bytes...
     (let* ((length (sap-ref-8 pc 1))

-          (vector (make-specializable-array
-                   length
-                   :element-type '(unsigned-byte 8))))
+          (vector (make-array length :element-type '(unsigned-byte 8))))

       (declare (type (unsigned-byte 8) length)
               (type (simple-array (unsigned-byte 8) (*)) vector))
       (declare (type (unsigned-byte 8) length)
               (type (simple-array (unsigned-byte 8) (*)) vector))

+      (/show0 "LENGTH,VECTOR,ERROR-NUMBER=..")
+      #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr length))
+      #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr vector))

       (copy-from-system-area pc (* sb!vm:byte-bits 2)
                             vector (* sb!vm:word-bits
                                       sb!vm:vector-data-offset)
                             (* length sb!vm:byte-bits))
       (let* ((index 0)
             (error-number (sb!c::read-var-integer vector index)))
       (copy-from-system-area pc (* sb!vm:byte-bits 2)
                             vector (* sb!vm:word-bits
                                       sb!vm:vector-data-offset)
                             (* length sb!vm:byte-bits))
       (let* ((index 0)
             (error-number (sb!c::read-var-integer vector index)))

+       #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr error-number))

        (collect ((sc-offsets))
          (loop
        (collect ((sc-offsets))
          (loop

+          (/show0 "INDEX=..")
+          #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr index))

           (when (>= index length)
             (return))
           (when (>= index length)
             (return))

-          (sc-offsets (sb!c::read-var-integer vector index)))
+          (let ((sc-offset (sb!c::read-var-integer vector index)))
+            (/show0 "SC-OFFSET=..")
+            #!+sb-show (sb!sys:%primitive print (sb!impl::hexstr sc-offset))
+            (sc-offsets sc-offset)))

          (values error-number (sc-offsets)))))))
 \f
 ;;; Do whatever is necessary to make the given code component
          (values error-number (sc-offsets)))))))
 \f
 ;;; Do whatever is necessary to make the given code component

diff --git a/src/runtime/x86-arch.c b/src/runtime/x86-arch.c
index 406030f..3c556c4 100644 (file)
--- a/src/runtime/x86-arch.c
+++ b/src/runtime/x86-arch.c
@@ -191,8 +191,6 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
     os_context_t *context = (os_context_t*)void_context;
     unsigned int trap;
 
     os_context_t *context = (os_context_t*)void_context;
     unsigned int trap;
 

-    SHOW("entering sigtrap_handler(..)"); /* REMOVEME */
-

     if (single_stepping && (signal==SIGTRAP))
     {
        /* fprintf(stderr,"* single step trap %x\n", single_stepping); */
     if (single_stepping && (signal==SIGTRAP))
     {
        /* fprintf(stderr,"* single step trap %x\n", single_stepping); */

@@ -241,7 +239,6 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
         * here, and restore it after we do our thing, but there
         * seems to be no point in doing that, since we're just
         * going to lose(..) anyway. */
         * here, and restore it after we do our thing, but there
         * seems to be no point in doing that, since we're just
         * going to lose(..) anyway. */

-       SHOW("in trap_Halt case of sigtrap_handler(..)"); /* REMOVEME */

        fake_foreign_function_call(context);
        lose("%%primitive halt called; the party is over.");
 
        fake_foreign_function_call(context);
        lose("%%primitive halt called; the party is over.");
 

@@ -268,7 +265,6 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
        interrupt_handle_now(signal, info, context);
        break;
     }
        interrupt_handle_now(signal, info, context);
        break;
     }

-    SHOW("leaving sigtrap_handler(..)"); /* REMOVEME */

 }
 
 void
 }
 
 void

diff --git a/tests/bignum-test.lisp b/tests/bignum-test.lisp
deleted file mode 100644 (file)
index 5a7926d..0000000
--- a/tests/bignum-test.lisp
+++ /dev/null
@@ -1,102 +0,0 @@
-;;;; some stuff to check that bignum operations are returning correct
-;;;; results
-
-;;;; This software is part of the SBCL system. See the README file for
-;;;; more information.
-;;;;
-;;;; This software is derived from the CMU CL system, which was
-;;;; written at Carnegie Mellon University and released into the
-;;;; public domain. The software is in the public domain and is
-;;;; provided with absolutely no warranty. See the COPYING and CREDITS
-;;;; files for more information.
-
-(in-package "SB!BIGNUM")
-
-(file-comment
-  "$Header$")
-
-(defvar *in-bignum-wrapper* nil)
-
-(defmacro def-bignum-wrapper (name lambda-list &body body)
-  (let ((var-name (sb!int:symbolicate "*OLD-" name "*"))
-       (wrap-name (sb!int:symbolicate "WRAP-" name))
-       (args (mapcar #'(lambda (x)
-                         (if (listp x) (car x) x))
-                     (remove-if #'(lambda (x)
-                                    (member x lambda-list-keywords))
-                                lambda-list))))
-    `(progn
-       (defvar ,var-name (fdefinition ',name))
-       (defun ,wrap-name ,lambda-list
-        (if *in-bignum-wrapper*
-            (funcall ,var-name ,@args)
-            (let ((*in-bignum-wrapper* t))
-              ,@body)))
-       (setf (fdefinition ',name) #',wrap-name))))
-
-(defun big= (x y)
-  (= (if (typep x 'bignum)
-        (%normalize-bignum x (%bignum-length x))
-        x)
-     (if (typep y 'bignum)
-        (%normalize-bignum y (%bignum-length y))
-        y)))
-
-(def-bignum-wrapper add-bignums (x y)
-  (let ((res (funcall *old-add-bignums* x y)))
-    (assert (big= (- res y) x))
-    res))
-
-(def-bignum-wrapper multiply-bignums (x y)
-  (let ((res (funcall *old-multiply-bignums* x y)))
-    (if (zerop x)
-       (assert (zerop res))
-       (multiple-value-bind (q r) (truncate res x)
-         (assert (and (zerop r) (big= q y)))))
-    res))
-
-(def-bignum-wrapper negate-bignum (x &optional (fully-normalized t))
-  (let ((res (funcall *old-negate-bignum* x fully-normalized)))
-    (assert (big= (- res) x))
-    res))
-
-(def-bignum-wrapper subtract-bignum (x y)
-  (let ((res (funcall *old-subtract-bignum* x y)))
-    (assert (big= (+ res y) x))
-    res))
-
-(def-bignum-wrapper multiply-bignum-and-fixnum (x y)
-  (let ((res (funcall *old-multiply-bignum-and-fixnum* x y)))
-    (if (zerop x)
-       (assert (zerop res))
-       (multiple-value-bind (q r) (truncate res x)
-         (assert (and (zerop r) (big= q y)))))
-    res))
-
-(def-bignum-wrapper multiply-fixnums (x y)
-  (let ((res (funcall *old-multiply-fixnums* x y)))
-    (if (zerop x)
-       (assert (zerop res))
-       (multiple-value-bind (q r) (truncate res x)
-         (assert (and (zerop r) (big= q y)))))
-    res))
-
-(def-bignum-wrapper bignum-ashift-right (x shift)
-  (let ((res (funcall *old-bignum-ashift-right* x shift)))
-    (assert (big= (ash res shift) (logand x (ash -1 shift))))
-    res))
-
-(def-bignum-wrapper bignum-ashift-left (x shift)
-  (let ((res (funcall *old-bignum-ashift-left* x shift)))
-    (assert (big= (ash res (- shift)) x))
-    res))
-
-(def-bignum-wrapper bignum-truncate (x y)
-  (multiple-value-bind (q r) (funcall *old-bignum-truncate* x y)
-    (assert (big= (+ (* q y) r) x))
-    (values q r)))
-
-(def-bignum-wrapper bignum-compare (x y)
-  (let ((res (funcall *old-bignum-compare* x y)))
-    (assert (big= (signum (- x y)) res))
-    res))

diff --git a/tests/run-tests.sh b/tests/run-tests.sh
index 6ac24e8..366eba1 100644 (file)
--- a/tests/run-tests.sh
+++ b/tests/run-tests.sh
@@ -16,9 +16,16 @@ for f in *.impure.lisp; do
     echo $f | $sbcl < pure.lisp
 done
 
     echo $f | $sbcl < pure.lisp
 done
 

-# *.test.sh files are scripts to test stuff. A file foo.test.sh
+# *.test.sh files are scripts to test stuff, typically stuff which can't
+# so easily be tested within Lisp itself. A file foo.test.sh

 # may be associated with other files foo*, e.g. foo.lisp, foo-1.lisp,
 # or foo.pl.
 for f in *.test.sh; do
 # may be associated with other files foo*, e.g. foo.lisp, foo-1.lisp,
 # or foo.pl.
 for f in *.test.sh; do

-    sh $f
+    sh $f || exit failed test $f
+done
+
+# *.assertoids files contain ASSERTOID statements to test things
+# interpreted and at various compilation levels.
+for f in *.assertoids; do
+    echo "(load \"$f\")" | $sbcl --eval '(load "assertoid.lisp")'

 done
 done

diff --git a/version.lisp-expr b/version.lisp-expr
index 0a230c4..ec6008f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -13,6 +13,6 @@
 ;;;
 ;;; Conventionally a string a la "0.6.6" is used for released
 ;;; versions, and a string a la "0.6.5.12" is used for versions which
 ;;;
 ;;; Conventionally a string a la "0.6.6" is used for released
 ;;; versions, and a string a la "0.6.5.12" is used for versions which

-;;; aren't released but correspond only to CVS tags.
+;;; aren't released but correspond only to CVS tags or snapshots.

 
 

-"0.6.7.1"
+"0.6.7.2"