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 # define XSETINT(var, value) do {       \
  93   Lisp_Object *_xzx = &(var);           \
  94   _xzx->s.val = (value);                \
  95   _xzx->s.bits = 1;                     \
  96 } while (0)
  97 # define XSETCHAR(var, value) do {      \
  98   Lisp_Object *_xzx = &(var);           \
  99   _xzx->gu.val = (EMACS_UINT) (value);  \
 100   _xzx->gu.type = Lisp_Type_Char;       \
 101 } while (0)
 102 # define XSETOBJ(var, vartype, value)   \
 103   ((void) ((var).ui = (EMACS_UINT) (value)))
 104 # define XPNTRVAL(x) ((x).ui)
 105 #else /* ! USE_MINIMAL_TAGBITS */
 106 # define XSETOBJ(var, vartype, value) do {      \
 107   Lisp_Object *_xzx = &(var);                   \
 108   _xzx->gu.val = (EMACS_UINT) (value);          \
 109   _xzx->gu.type = (vartype);                    \
 110   _xzx->gu.markbit = 0;                         \
 111 } while (0)
 112 # define XSETINT(var, value) XSETOBJ (var, Lisp_Type_Int, value)
 113 # define XSETCHAR(var, value) XSETOBJ (var, Lisp_Type_Char, value)
 114 # define XPNTRVAL(x) ((x).gu.val)
 115 #endif /* ! USE_MINIMAL_TAGBITS */
 116
 117 INLINE Lisp_Object make_int (EMACS_INT val);
 118 INLINE Lisp_Object
 119 make_int (EMACS_INT val)
 120 {
 121   Lisp_Object obj;
 122   XSETINT(obj, val);
 123   return obj;
 124 }
 125
 126 INLINE Lisp_Object make_char (Emchar val);
 127 INLINE Lisp_Object
 128 make_char (Emchar val)
 129 {
 130   Lisp_Object obj;
 131   XSETCHAR(obj, val);
 132   return obj;
 133 }
 134
 135 extern Lisp_Object Qnull_pointer, Qzero;
 136
 137 #define XREALINT(x) ((x).s.val)
 138 #define XUINT(x) ((x).u.val)
 139 #define XTYPE(x) ((x).gu.type)
 140 #define XGCTYPE(x) XTYPE (x)
 141 #define EQ(x,y) ((x).v == (y).v)
 142
 143 #ifdef USE_MINIMAL_TAGBITS
 144 #define INTP(x) ((x).s.bits)
 145 #define GC_EQ(x,y) EQ (x, y)
 146 #else
 147 #define INTP(x) (XTYPE(x) == Lisp_Type_Int)
 148 #define GC_EQ(x,y) ((x).gu.val == (y).gu.val && XTYPE (x) == XTYPE (y))
 149 #endif
 150
 151 #if GCMARKBITS > 0
 152 /* XMARKBIT accesses the markbit.  Markbits are used only in
 153    particular slots of particular structure types.  Other markbits are
 154    always zero.  Outside of garbage collection, all mark bits are
 155    always zero. */
 156 # define XMARKBIT(x) ((x).gu.markbit)
 157 # define XMARK(x) ((void) (XMARKBIT (x) = 1))
 158 # define XUNMARK(x) ((void) (XMARKBIT (x) = 0))
 159 #else
 160 # define XUNMARK(x) DO_NOTHING
 161 #endif
 162
 163 /* Convert between a (void *) and a Lisp_Object, as when the
 164    Lisp_Object is passed to a toolkit callback function */
 165 #define VOID_TO_LISP(larg,varg) \
 166      ((void) ((larg).v = (struct nosuchstruct *) (varg)))
 167 #define CVOID_TO_LISP(larg,varg) \
 168      ((void) ((larg).cv = (CONST struct nosuchstruct *) (varg)))
 169 #define LISP_TO_VOID(larg) ((void *) ((larg).v))
 170 #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
 171
 172 /* Convert a Lisp_Object into something that can't be used as an
 173    lvalue.  Useful for type-checking. */
 174 #if (__GNUC__ > 1)
 175 #define NON_LVALUE(larg) ({ (larg); })
 176 #else
 177 /* Well, you can't really do it without using a function call, and
 178    there's no real point in that; no-union-type is the rule, and that
 179    will catch errors. */
 180 #define NON_LVALUE(larg) (larg)
 181 #endif