Mercurial > hg > xemacs-beta
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))