diff src/lisp-union.h @ 272:c5d627a313b1 r21-0b34

Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 11cf20601dec
children 8626e4521993
line wrap: on
line diff
--- a/src/lisp-union.h	Mon Aug 13 10:27:41 2007 +0200
+++ b/src/lisp-union.h	Mon Aug 13 10:28:48 2007 +0200
@@ -19,217 +19,153 @@
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
-/* Synched up with: FSF 19.30.  Split out from lisp.h. */
+/* Divergent from FSF.  */
+
+/* Definition of Lisp_Object type as a union.
+   The declaration order of the objects within the struct members
+   of the union is dependent on ENDIAN-ness and USE_MINIMAL_TAGBITS.
+   See lisp-disunion.h for more details.  */
 
 typedef
 union Lisp_Object
 {
+  /* if non-valbits are at lower addresses */
+#if defined(WORDS_BIGENDIAN) == defined(USE_MINIMAL_TAGBITS)
   struct
   {
-#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
-    /* Big-endian lowtags, little-endian hightags */
-    unsigned EMACS_INT type_mark: GCTYPEBITS + GCMARKBITS;
-    signed EMACS_INT val: VALBITS;
-#else /* If WORDS_BIGENDIAN, or little-endian hightags */
-    signed EMACS_INT val: VALBITS;
-    unsigned EMACS_INT mark_type: GCTYPEBITS + GCMARKBITS;
-#endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
+    EMACS_UINT val : VALBITS;
+#if GCMARKBITS > 0
+    unsigned int markbit: GCMARKBITS;
+#endif
+    enum_field (Lisp_Type) type : GCTYPEBITS;
+  } gu;
+
+  struct
+  {
+    signed EMACS_INT val : INT_VALBITS;
+    unsigned int bits : INT_GCBITS;
   } s;
+
+  struct
+  {
+    EMACS_UINT val : INT_VALBITS;
+    unsigned int bits : INT_GCBITS;
+  } u;
+#else /* non-valbits are at higher addresses */
   struct
   {
-#if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
-    unsigned EMACS_INT val: VALBITS;
+    enum_field (Lisp_Type) type : GCTYPEBITS;
+#if GCMARKBITS > 0
+    unsigned int markbit: GCMARKBITS;
 #endif
-#ifdef __GNUC__ /* Non-ANSI extension */
-    enum Lisp_Type type: GCTYPEBITS;
-#else
-    unsigned EMACS_INT type: GCTYPEBITS;
-#endif /* __GNUC__ */
-    /* The markbit is not really part of the value of a Lisp_Object,
-       and is always zero except during garbage collection.  */
-#if GCMARKBITS > 0
-    unsigned EMACS_INT markbit: GCMARKBITS;
-#endif
-#if (!!defined (WORDS_BIGENDIAN)  != !!defined (LOWTAGS))
-    unsigned EMACS_INT val: VALBITS;
-#endif
+    EMACS_UINT val : VALBITS;
   } gu;
-#ifdef USE_MINIMAL_TAGBITS
+
+  struct
+  {
+    unsigned int bits : INT_GCBITS;
+    signed EMACS_INT val : INT_VALBITS;
+  } s;
+
   struct
   {
-#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
-    unsigned bit: GCTYPEBITS - 1;
-#endif
-    signed EMACS_INT val: VALBITS + 1;
-#if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
-    unsigned bit: GCTYPEBITS - 1;
-#endif
-  } si;
-  struct
-  {
-#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
-    unsigned bit: GCTYPEBITS - 1;
-#endif
-    unsigned EMACS_INT val: VALBITS + 1;
-#if (!!defined (WORDS_BIGENDIAN) == !!defined (LOWTAGS))
-    unsigned bit: GCTYPEBITS - 1;
-#endif
-  } u_i;
-#endif /* USE_MINIMAL_TAGBITS */
+    unsigned int bits : INT_GCBITS;
+    EMACS_UINT val : INT_VALBITS;
+  } u;
+
+#endif /* non-valbits are at higher addresses */
+
   EMACS_UINT ui;
-  EMACS_INT i;
-  /* GCC bites yet again.  I fart in the general direction of
-     the GCC authors.
+  signed EMACS_INT i;
 
-     This was formerly declared 'void *v' etc. but that causes
+  /* This was formerly declared 'void *v' etc. but that causes
      GCC to accept any (yes, any) pointer as the argument of
      a function declared to accept a Lisp_Object. */
-  struct __nosuchstruct__ *v;
-  CONST struct __nosuchstruct__ *cv;             /* C wanks */
+  struct nosuchstruct *v;
+  CONST struct nosuchstruct *cv;
 }
 Lisp_Object;
 
-#ifndef USE_MINIMAL_TAGBITS
-#ifndef XMAKE_LISP
-#if (__GNUC__ > 1)
-/* Use GCC's struct initializers feature */
-#define XMAKE_LISP(vartype,value) \
-   ((union Lisp_Object) { gu: { markbit: 0, \
-                                type: (vartype), \
-                                val: ((unsigned EMACS_INT) value) } })
-#endif /* __GNUC__ */
-#endif /* !XMAKE_LISP */
+#define XCHARVAL(x) ((x).gu.val)
+
+#ifdef USE_MINIMAL_TAGBITS
+# define XSETINT(var, value) do {	\
+  Lisp_Object *_xzx = &(var);		\
+  _xzx->s.val = (value);		\
+  _xzx->s.bits = 1;			\
+} while (0)
+# define XSETCHAR(var, value) do {	\
+  Lisp_Object *_xzx = &(var);		\
+  _xzx->gu.val = (EMACS_UINT) (value);	\
+  _xzx->gu.type = Lisp_Type_Char;	\
+} while (0)
+# define XSETOBJ(var, vartype, value)	\
+  ((void) ((var).ui = (EMACS_UINT) (value)))
+# define XPNTRVAL(x) ((x).ui)
+#else /* ! USE_MINIMAL_TAGBITS */
+# define XSETOBJ(var, vartype, value) do {	\
+  Lisp_Object *_xzx = &(var);			\
+  _xzx->gu.val = (EMACS_UINT) (value);		\
+  _xzx->gu.type = (vartype);			\
+  _xzx->gu.markbit = 0;				\
+} while (0)
+# define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value)
+# define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
+# define XPNTRVAL(x) ((x).gu.val)
 #endif /* ! USE_MINIMAL_TAGBITS */
 
-#ifdef XMAKE_LISP
-#define Qzero (XMAKE_LISP (Lisp_Type_Int, 0))
-#define make_int(a) (XMAKE_LISP (Lisp_Type_Int, (a)))
-#define make_char(a) (XMAKE_LISP (Lisp_Type_Char, (a)))
-#else
-extern Lisp_Object Qzero;
-#endif
-
-extern Lisp_Object Qnull_pointer;
-
-#define EQ(x,y) ((x).v == (y).v)
-#define GC_EQ(x,y) ((x).gu.val == (y).gu.val && (x).gu.type == (y).gu.type)
+INLINE Lisp_Object make_int (EMACS_INT val);
+INLINE Lisp_Object
+make_int (EMACS_INT val)
+{
+  Lisp_Object obj;
+  XSETINT(obj, val);
+  return obj;
+}
 
-#define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
-#define XGCTYPE(a) XTYPE (a)
+INLINE Lisp_Object make_char (Emchar val);
+INLINE Lisp_Object
+make_char (Emchar val)
+{
+  Lisp_Object obj;
+  XSETCHAR(obj, val);
+  return obj;
+}
 
-/* This was commented out a long time ago.  I uncommented it, but it
-   makes the Alpha crash, and that's the only system that would use
-   this, so it stays commented out. */
-#if 0 /* EXPLICIT_SIGN_EXTEND */
-/* Make sure we sign-extend; compilers have been known to fail to do so.  */
-#define XREALINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
-#else
-#ifdef USE_MINIMAL_TAGBITS
-# define XREALINT(a) ((a).si.val)
-#else
-# define XREALINT(a) ((a).s.val)
-#endif
-#endif /* EXPLICIT_SIGN_EXTEND */
+extern Lisp_Object Qnull_pointer, Qzero;
+
+#define XREALINT(x) ((x).s.val)
+#define XUINT(x) ((x).u.val)
+#define XTYPE(x) ((x).gu.type)
+#define XGCTYPE(x) XTYPE (x)
+#define EQ(x,y) ((x).v == (y).v)
 
 #ifdef USE_MINIMAL_TAGBITS
-# define XUINT(a) ((a).u_i.val)
+#define INTP(x) ((x).s.bits)
+#define GC_EQ(x,y) EQ (x, y)
 #else
-# define XUINT(a) XPNTRVAL(a)
-#endif
-
-#ifdef USE_MINIMAL_TAGBITS
-# define XPNTRVAL(a) ((a).ui)
-# define XCHARVAL(a) ((a).gu.val)
-#else
-# define XPNTRVAL(a) ((a).gu.val)
-# define XCHARVAL(a) XPNTRVAL(a)
+#define INTP(x) (XTYPE(x) == Lisp_Type_Int)
+#define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y))
 #endif
 
-#ifdef HAVE_SHM
-/* In this representation, data is found in two widely separated segments.  */
-extern int pure_size;
-# define XPNTR(a) \
-  ((void *)(XPNTRVAL(a)) | (XPNTRVAL(a) > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)))
-#else /* not HAVE_SHM */
-# ifdef DATA_SEG_BITS
-/* This case is used for the rt-pc and hp-pa.
-   In the diffs I was given, it checked for ptr = 0
-   and did not adjust it in that case.
-   But I don't think that zero should ever be found
-   in a Lisp object whose data type says it points to something.
- */
-#  define XPNTR(a) ((void *)((XPNTRVAL(a)) | DATA_SEG_BITS))
-# else /* not DATA_SEG_BITS */
-#  define XPNTR(a) ((void *) (XPNTRVAL(a)))
-# endif /* not DATA_SEG_BITS */
-#endif /* not HAVE_SHM */
-
-#ifdef USE_MINIMAL_TAGBITS
-# define XSETINT(a, b) \
-    do { Lisp_Object *_xzx = &(a) ; \
-         (*_xzx).si.val = (b) ; \
-         (*_xzx).si.bit = 1; \
-       } while (0)
-# define XSETCHAR(a, b) \
-    do { Lisp_Object *_xzx = &(a) ; \
-         (*_xzx).gu.val = (b) ; \
-         (*_xzx).gu.type = Lisp_Type_Char; \
-       } while (0)
+#if GCMARKBITS > 0
+/* XMARKBIT accesses the markbit.  Markbits are used only in
+   particular slots of particular structure types.  Other markbits are
+   always zero.  Outside of garbage collection, all mark bits are
+   always zero. */
+# define XMARKBIT(x) ((x).gu.markbit)
+# define XMARK(x) ((void) (XMARKBIT (x) = 1))
+# define XUNMARK(x) ((void) (XMARKBIT (x) = 0))
 #else
-# define XSETINT(a, b) ((void) ((a) = make_int (b)))
-# define XSETCHAR(a, b) ((void) ((a) = make_char (b)))
+# define XUNMARK(x) DO_NOTHING
 #endif
 
-/* XSETOBJ was formerly named XSET.  The name change was made to catch
-   C code that attempts to use this macro.  You should always use the
-   individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
-
-#ifdef USE_MINIMAL_TAGBITS
-# define XSETOBJ(var, vartype, value) \
-   ((void) ((var).ui = (EMACS_UINT)(value)))
-#else
-# ifdef XMAKE_LISP
-#  define XSETOBJ(a, type, b) ((void) ((a) = XMAKE_LISP (type, b)))
-# else
-/* This is haired up to avoid evaluating var twice...
-   This is necessary only in the "union" version.
-   The "int" version has never done double evaluation.
- */
-/* XEmacs change: put the assignment to val first; otherwise you
-   can trip up the error_check_*() stuff */
-#  define XSETOBJ(var, vartype, value)			\
-   do {							\
-	 Lisp_Object *tmp_xset_var = &(var);		\
-	 (*tmp_xset_var).s.val = ((EMACS_INT) (value));	\
-	 (*tmp_xset_var).gu.markbit = 0;		\
-	 (*tmp_xset_var).gu.type = (vartype);		\
-      } while (0)
-# endif /* ! XMAKE_LISP */
-#endif /* ! USE_MINIMAL_TAGBITS */
-
-#if GCMARKBITS > 0
-/*
- * XMARKBIT access the markbit.  Markbits are used only in particular
- * slots of particular structure types.  Other markbits are always
- * zero.  Outside of garbage collection, all mark bits are always
- * zero.
- */
-# define XMARKBIT(a) ((a).gu.markbit)
-# define XMARK(a) ((void) (XMARKBIT (a) = 1))
-# define XUNMARK(a) ((void) (XMARKBIT (a) = 0))
-#else
-# define XUNMARK(a) DO_NOTHING
-#endif
-
-/* Use this for turning a (void *) into a Lisp_Object, as when the
-  Lisp_Object is passed into a toolkit callback function */
+/* Convert between a (void *) and a Lisp_Object, as when the
+   Lisp_Object is passed to a toolkit callback function */
 #define VOID_TO_LISP(larg,varg) \
-     ((void) ((larg).v = (struct __nosuchstruct__ *) (varg)))
+     ((void) ((larg).v = (struct nosuchstruct *) (varg)))
 #define CVOID_TO_LISP(larg,varg) \
-     ((void) ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)))
-
-/* Use this for turning a Lisp_Object into a  (void *), as when the
-  Lisp_Object is passed into a toolkit callback function */
+     ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg)))
 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))