home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / lisp-union.h < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-25  |  6.8 KB  |  202 lines
  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 the Free
  19. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. /* Synched up with: FSF 19.28.  Split out from lisp.h. */
  22.  
  23. #if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))
  24.  
  25. /* Big-endian lowtags, little-endian hightags */
  26. typedef
  27. union Lisp_Object
  28.   {
  29.     struct
  30.       {
  31.     unsigned LISP_WORD_TYPE type_mark: GCTYPEBITS + 1;
  32.     signed LISP_WORD_TYPE val: VALBITS;
  33.       } s;
  34.     struct
  35.       {
  36. #ifdef __GNUC__ /* Non-ANSI extension */
  37.         enum Lisp_Type type: GCTYPEBITS;
  38. #else
  39.     unsigned LISP_WORD_TYPE type: GCTYPEBITS;
  40. #endif /* __GNUC__ */
  41.     /* The markbit is not really part of the value of a Lisp_Object,
  42.        and is always zero except during garbage collection.  */
  43.     unsigned LISP_WORD_TYPE markbit: 1;
  44.     unsigned LISP_WORD_TYPE val: VALBITS;
  45.       } gu;
  46.     /* GCC bites yet again.  I fart in the general direction of
  47.        the GCC authors.
  48.  
  49.        This was formerly declared 'void *v' etc. but that causes
  50.        GCC to accept any (yes, any) pointer as the argument of
  51.        a function declared to accept a Lisp_Object. */
  52.     struct __nosuchstruct__ *v;
  53.     CONST struct __nosuchstruct__ *cv;             /* C wanks */
  54.   }
  55. Lisp_Object;
  56.  
  57. #else /* If WORDS_BIGENDIAN, or little-endian hightags */
  58.  
  59. /* Big-endian hightags, little-endian lowtags */
  60. typedef
  61. union Lisp_Object
  62.   {
  63.     struct
  64.       {
  65.     signed LISP_WORD_TYPE val: VALBITS;
  66.     unsigned LISP_WORD_TYPE mark_type: GCTYPEBITS + 1;
  67.       } s;
  68.     struct
  69.       {
  70.     unsigned LISP_WORD_TYPE val: VALBITS;
  71. #ifdef __GNUC__ /* Non-ANSI extension */
  72.         enum Lisp_Type type: GCTYPEBITS;
  73. #else
  74.     unsigned LISP_WORD_TYPE type: GCTYPEBITS;
  75. #endif /* __GNUC__ */
  76.     /* The markbit is not really part of the value of a Lisp_Object,
  77.        and is always zero except during garbage collection.  */
  78.     unsigned LISP_WORD_TYPE markbit: 1;
  79.       } gu;
  80.     LISP_WORD_TYPE i;
  81.     struct __nosuchstruct__ *v;
  82.     CONST struct __nosuchstruct__ *cv;             /* C sucks */
  83.   }
  84. Lisp_Object;
  85.  
  86. #endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */
  87.  
  88.  
  89. #ifndef XMAKE_LISP
  90. #if (__GNUC__ > 1)
  91. /* Use GCC's struct initializers feature */
  92. #define XMAKE_LISP(vartype,ptr) \
  93.    ((union Lisp_Object) { gu: { markbit: 0, \
  94.                                 type: (vartype), \
  95.                                 val: ((unsigned LISP_WORD_TYPE) ptr) } })
  96. #endif /* __GNUC__ */
  97. #endif /* !XMAKE_LISP */
  98.  
  99.  
  100. #ifdef XMAKE_LISP
  101. #define Qzero (XMAKE_LISP (Lisp_Int, 0))
  102. #define make_number(a) (XMAKE_LISP (Lisp_Int, (a)))
  103. #else
  104. extern Lisp_Object Qzero;
  105. #endif
  106.  
  107.  
  108. #define EQ(x,y) ((x).v == (y).v)
  109.  
  110. #define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
  111. #define XSETTYPE(a,b) ((a).gu.type = (b))
  112. #define XGCTYPE(a) XTYPE((a))
  113.  
  114. /* This definition should be enabled but I feel a bit of trepidation
  115.    in doing so. --ben */
  116. #if 0 /* EXPLICIT_SIGN_EXTEND */
  117. /* Make sure we sign-extend; compilers have been known to fail to do so.  */
  118. #define XINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
  119. #else
  120. #define XINT(a) ((a).s.val)
  121. #endif /* EXPLICIT_SIGN_EXTEND */
  122.  
  123. #if 0
  124. /* XFASTINT is error-prone and saves a few instructions at best,
  125.    so there's really no point to it.  Just use XINT() or make_number()
  126.    instead. --ben */
  127. /* The + 0 is to prevent XFASTINT being used on the LHS of an assignment */
  128. #define XFASTINT(a) ((a).gu.val + 0)
  129. #endif /* 0 */
  130.  
  131. #define XUINT(a) ((a).gu.val)
  132. #ifdef HAVE_SHM
  133. /* In this representation, data is found in two widely separated segments.  */
  134. extern int pure_size;
  135. # define XPNTR(a) \
  136.   ((void *)(((a).gu.val) | ((a).gu.val > pure_size ? DATA_SEG_BITS : PURE_SEG_BITS)))
  137. #else /* not HAVE_SHM */
  138. # ifdef DATA_SEG_BITS
  139. /* This case is used for the rt-pc and hp-pa.
  140.    In the diffs I was given, it checked for ptr = 0
  141.    and did not adjust it in that case.
  142.    But I don't think that zero should ever be found
  143.    in a Lisp object whose data type says it points to something.
  144.  */
  145. #  define XPNTR(a) ((void *)(((a).gu.val) | DATA_SEG_BITS))
  146. # else /* not DATA_SEG_BITS */
  147. #  define XPNTR(a) ((void *) ((a).gu.val))
  148. # endif /* not DATA_SEG_BITS */
  149. #endif /* not HAVE_SHM */        
  150. #define XSETINT(a, b) do { ((a) = make_number (b)); } while (0)
  151. #define XSETUINT(a, b) XSETINT (a, b)
  152. #define XSETPNTR(a, b) XSETINT (a, b)
  153.  
  154. /* XSETOBJ was formerly named XSET.  The name change was made to catch
  155.    C code that attempts to use this macro.  You should always use the
  156.    individual settor macros (XSETCONS, XSETBUFFER, etc.) instead. */
  157.  
  158. #ifdef XMAKE_LISP
  159. #define XSETOBJ(var,vartype,ptr) \
  160.   do { ((var) = XMAKE_LISP ((vartype), (ptr))); } while (0)
  161. #else
  162. /* This is haired up to avoid evaluating var twice...
  163.    This is necessary only in the "union" version.
  164.    The "int" version has never done double evaluation.
  165.  */
  166. /* XEmacs change: put the assignment to val first; otherwise you
  167.    can trip up the error_check_*() stuff */
  168. #define XSETOBJ(var,vartype,ptr)                \
  169.    do {                                \
  170.      Lisp_Object *tmp_xset_var = &((var));            \
  171.      (*tmp_xset_var).s.val = ((LISP_WORD_TYPE) (ptr));    \
  172.      (*tmp_xset_var).gu.markbit = 0;            \
  173.      (*tmp_xset_var).gu.type = ((vartype));            \
  174.       } while (0)
  175. #endif /* undefined XMAKE_LISP */
  176.  
  177. /* During garbage collection, XGCTYPE must be used for extracting types
  178.  so that the mark bit is ignored.  XMARKBIT access the markbit.
  179.  Markbits are used only in particular slots of particular structure types.
  180.  Other markbits are always zero.
  181.  Outside of garbage collection, all mark bits are always zero.  */
  182.  
  183.  
  184. #define XMARKBIT(a) ((a).gu.markbit)
  185. #define XSETMARKBIT(a,b) do { (XMARKBIT(a) = (b)); } while (0)
  186. #define XMARK(a) do { XMARKBIT(a) = 1; } while (0)
  187. /* no 'do {} while' because this is used in a mondo macro in lrecord.h */
  188. #define XUNMARK(a) (XMARKBIT(a) = 0)
  189.  
  190. /* Use this for turning a (void *) into a Lisp_Object, as when the
  191.   Lisp_Object is passed into a toolkit callback function */
  192. #define VOID_TO_LISP(larg,varg) \
  193.   do { ((larg).v = (struct __nosuchstruct__ *) (varg)); } while (0)
  194. #define CVOID_TO_LISP(larg,varg) \
  195.   do { ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)); } while (0)
  196.  
  197. /* Use this for turning a Lisp_Object into a  (void *), as when the
  198.   Lisp_Object is passed into a toolkit callback function */
  199. #define LISP_TO_VOID(larg) ((void *) ((larg).v))
  200. #define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))
  201.  
  202.