Tweak last vectorlike_header change.

* alloc.c (struct Lisp_Vectorlike_Free): Special type to represent
vectorlike object on the free list.  This is introduced to avoid
some (but not all) pointer casting and aliasing problems, see
http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html.
* .gdbinit (pvectype, pvecsize): New commands to examine vectorlike
objects.
(xvectype, xvecsize): Use them to examine Lisp_Object values.

3 files changed, 46 insertions, 17 deletions

diff --git a/src/.gdbinit b/src/.gdbinit
index f187bafcba7..fa580cc99bf 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -650,9 +650,8 @@ If the first type printed is Lisp_Vector or Lisp_Misc,
 a second line gives the more precise type.
 end
 
-define xvectype
-  xgetptr $
-  set $size = ((struct Lisp_Vector *) $ptr)->header.size
+define pvectype
+  set $size = ((struct Lisp_Vector *) $arg0)->header.size
   if ($size & PSEUDOVECTOR_FLAG)
     output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
   else
@@ -660,14 +659,22 @@ define xvectype
   end
   echo \n
 end
-document xvectype
-Print the type or vector subtype of $.
-This command assumes that $ is a vector or pseudovector.
+document pvectype
+Print the subtype of vectorlike object.
+Takes one argument, a pointer to an object.
 end
 
-define xvecsize
+define xvectype
   xgetptr $
-  set $size = ((struct Lisp_Vector *) $ptr)->header.size
+  pvectype $ptr
+end
+document xvectype
+Print the subtype of vectorlike object.
+This command assumes that $ is a Lisp_Object.
+end
+
+define pvecsize
+  set $size = ((struct Lisp_Vector *) $arg0)->header.size
   if ($size & PSEUDOVECTOR_FLAG)
     output ($size & PSEUDOVECTOR_SIZE_MASK)
     echo \n
@@ -677,9 +684,18 @@ define xvecsize
   end
   echo \n
 end
+document pvecsize
+Print the size of vectorlike object.
+Takes one argument, a pointer to an object.
+end
+
+define xvecsize
+  xgetptr $
+  pvecsize $ptr
+end
 document xvecsize
-Print the size or vector subtype of $.
-This command assumes that $ is a vector or pseudovector.
+Print the size of $
+This command assumes that $ is a Lisp_Object.
 end
 
 define xmisctype
diff --git a/src/ChangeLog b/src/ChangeLog
index 6cf10f0fa30..752dd4313f8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2012-11-09  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        Tweak last vectorlike_header change.
+        * alloc.c (struct Lisp_Vectorlike_Free): Special type to represent
+        vectorlike object on the free list.  This is introduced to avoid
+        some (but not all) pointer casting and aliasing problems, see
+        http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html.
+        * .gdbinit (pvectype, pvecsize): New commands to examine vectorlike
+        objects.
+        (xvectype, xvecsize): Use them to examine Lisp_Object values.
+
 2012-11-09  Jan Djärv  <jan.h.d@swipnet.se>
 
         * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has
diff --git a/src/alloc.c b/src/alloc.c
index 808557dd70f..0a3d469d09b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2611,16 +2611,18 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
 
 #define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
 
-/* When V is on the free list, first word after header is used as a pointer
-   to next vector on the free list.  It might be done in a better way with:
+/* This special type is used to represent any block-allocated vectorlike
+   object on the free list.  */
 
-   (*(struct Lisp_Vector **)&(v->contents[0]))
+struct Lisp_Vectorlike_Free
+{
+  struct vectorlike_header header;
+  struct Lisp_Vector *next;
+};
 
-   but this breaks GCC's strict-aliasing rules (which looks more relaxed
-   for char and void pointers).  */
+/* When V is on the free list, it's always treated as Lisp_Vectorlike_Free.  */
 
-#define NEXT_IN_FREE_LIST(v)                            \
-  (*(struct Lisp_Vector **)((char *) v + header_size))
+#define NEXT_IN_FREE_LIST(v) ((struct Lisp_Vectorlike_Free *) v)->next
 
 /* Common shortcut to setup vector on a free list.  */