git.chise.org Git - chise/xemacs-chise.git.1/blob - src/lisp-union.h

   1 /* Fundamental definitions for XEmacs Lisp interpreter -- union objects.
   2    Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
   3    Free Software Foundation, Inc.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Divergent from FSF.  */
  23
  24 /* Definition of Lisp_Object type as a union.
  25    The declaration order of the objects within the struct members
  26    of the union is dependent on ENDIAN-ness and USE_MINIMAL_TAGBITS.
  27    See lisp-disunion.h for more details.  */
  28
  29 typedef
  30 union Lisp_Object
  31 {
  32   /* if non-valbits are at lower addresses */
  33 #if defined(WORDS_BIGENDIAN) == defined(USE_MINIMAL_TAGBITS)
  34   struct
  35   {
  36     EMACS_UINT val : VALBITS;
  37 #if GCMARKBITS > 0
  38     unsigned int markbit: GCMARKBITS;
  39 #endif
  40     enum_field (Lisp_Type) type : GCTYPEBITS;
  41   } gu;
  42
  43   struct
  44   {
  45     signed EMACS_INT val : INT_VALBITS;
  46     unsigned int bits : INT_GCBITS;
  47   } s;
  48
  49   struct
  50   {
  51     EMACS_UINT val : INT_VALBITS;
  52     unsigned int bits : INT_GCBITS;
  53   } u;
  54 #else /* non-valbits are at higher addresses */
  55   struct
  56   {
  57     enum_field (Lisp_Type) type : GCTYPEBITS;
  58 #if GCMARKBITS > 0
  59     unsigned int markbit: GCMARKBITS;
  60 #endif
  61     EMACS_UINT val : VALBITS;
  62   } gu;
  63
  64   struct
  65   {
  66     unsigned int bits : INT_GCBITS;
  67     signed EMACS_INT val : INT_VALBITS;
  68   } s;
  69
  70   struct
  71   {
  72     unsigned int bits : INT_GCBITS;
  73     EMACS_UINT val : INT_VALBITS;
  74   } u;
  75
  76 #endif /* non-valbits are at higher addresses */
  77
  78   EMACS_UINT ui;
  79   signed EMACS_INT i;
  80
  81   /* This was formerly declared 'void *v' etc. but that causes
  82      GCC to accept any (yes, any) pointer as the argument of
  83      a function declared to accept a Lisp_Object. */
  84   struct nosuchstruct *v;
  85   CONST struct nosuchstruct *cv;
  86 }
  87 Lisp_Object;
  88
  89 #define XCHARVAL(x) ((x).gu.val)
  90
  91 #ifdef USE_MINIMAL_TAGBITS
  92
  93 # define XSETINT(var, value) do {       \
  94   EMACS_INT xset_value = (value);       \
  95   Lisp_Object *xset_var = &(var);       \
  96   xset_var->s.bits = 1;                 \
  97   xset_var->s.val = xset_value;         \
  98 } while (0)
  99 # define XSETCHAR(var, value) do {      \
 100   Emchar xset_value = (value);          \
 101   Lisp_Object *xset_var = &(var);       \
 102   xset_var->gu.type = Lisp_Type_Char;   \
 103   xset_var->gu.val = xset_value;        \
 104 } while (0)
 105 # define XSETOBJ(var, vartype, value) do {      \
 106   EMACS_UINT xset_value = (EMACS_UINT) (value); \
 107   (var).ui = xset_value;                        \
 108 } while (0)
 109 # define XPNTRVAL(x) ((x).ui)
 110
 111 #else /* ! USE_MINIMAL_TAGBITS */
 112
 113 # define XSETOBJ(var, vartype, value) do {      \
 114   EMACS_UINT xset_value = (EMACS_UINT) (value); \
 115   Lisp_Object *xset_var = &(var);               \
 116   xset_var->gu.type = (vartype);                \
 117   xset_var->gu.markbit = 0;                     \
 118   xset_var->gu.val = xset_value;                \
 119 } while (0)
 120 # define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value)
 121 # define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
 122 # define XPNTRVAL(x) ((x).gu.val)
 123
 124 #endif /* ! USE_MINIMAL_TAGBITS */
 125
 126 INLINE Lisp_Object make_int (EMACS_INT val);
 127 INLINE Lisp_Object
 128 make_int (EMACS_INT val)
 129 {
 130   Lisp_Object obj;
 131   XSETINT(obj, val);
 132   return obj;
 133 }
 134
 135 INLINE Lisp_Object make_char (Emchar val);
 136 INLINE Lisp_Object
 137 make_char (Emchar val)
 138 {
 139   Lisp_Object obj;
 140   XSETCHAR(obj, val);
 141   return obj;
 142 }
 143
 144 extern Lisp_Object Qnull_pointer, Qzero;
 145
 146 #define XREALINT(x) ((x).s.val)
 147 #define XUINT(x) ((x).u.val)
 148 #define XTYPE(x) ((x).gu.type)
 149 #define XGCTYPE(x) XTYPE (x)
 150 #define EQ(x,y) ((x).v == (y).v)
 151
 152 #ifdef USE_MINIMAL_TAGBITS
 153 #define INTP(x) ((x).s.bits)
 154 #define GC_EQ(x,y) EQ (x, y)
 155 #else
 156 #define INTP(x) (XTYPE(x) == Lisp_Type_Int)
 157 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y))
 158 #endif
 159
 160 #if GCMARKBITS > 0
 161 /* XMARKBIT accesses the markbit.  Markbits are used only in
 162    particular slots of particular structure types.  Other markbits are
 163    always zero.  Outside of garbage collection, all mark bits are
 164    always zero. */
 165 # define XMARKBIT(x) ((x).gu.markbit)
 166 # define XMARK(x) ((void) (XMARKBIT (x) = 1))
 167 # define XUNMARK(x) ((void) (XMARKBIT (x) = 0))
 168 #else
 169 # define XUNMARK(x) DO_NOTHING
 170 #endif
 171
 172 /* Convert between a (void *) and a Lisp_Object, as when the
 173    Lisp_Object is passed to a toolkit callback function */
 174 #define VOID_TO_LISP(larg,varg) \
 175      ((void) ((larg).v = (struct nosuchstruct *) (varg)))
 176 #define CVOID_TO_LISP(larg,varg) \
 177      ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg)))
 178 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
 179 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
 180
 181 /* Convert a Lisp_Object into something that can't be used as an
 182    lvalue.  Useful for type-checking. */
 183 #if (__GNUC__ > 1)
 184 #define NON_LVALUE(larg) ({ (larg); })
 185 #else
 186 /* Well, you can't really do it without using a function call, and
 187    there's no real point in that; no-union-type is the rule, and that
 188    will catch errors. */
 189 #define NON_LVALUE(larg) (larg)
 190 #endif