ftp.nice.ch/pub/next/unix/editor/xemacs.19.13.s.tar.gz#/xemacs-19.13/src/lisp-union.h

This is lisp-union.h in view mode; [Download] [Up]

/* Fundamental definitions for XEmacs Lisp interpreter -- union objects.
   Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994
   Free Software Foundation, Inc.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

/* Synched up with: FSF 19.28.  Split out from lisp.h. */

#if (!!defined (WORDS_BIGENDIAN) != !!defined (LOWTAGS))

/* Big-endian lowtags, little-endian hightags */
typedef
union Lisp_Object
  {
    struct
      {
	unsigned LISP_WORD_TYPE type_mark: GCTYPEBITS + 1;
	signed LISP_WORD_TYPE val: VALBITS;
      } s;
    struct
      {
#ifdef __GNUC__ /* Non-ANSI extension */
        enum Lisp_Type type: GCTYPEBITS;
#else
	unsigned LISP_WORD_TYPE 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.  */
	unsigned LISP_WORD_TYPE markbit: 1;
	unsigned LISP_WORD_TYPE val: VALBITS;
      } gu;
    /* GCC bites yet again.  I fart in the general direction of
       the GCC authors.

       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 */
  }
Lisp_Object;

#else /* If WORDS_BIGENDIAN, or little-endian hightags */

/* Big-endian hightags, little-endian lowtags */
typedef
union Lisp_Object
  {
    struct
      {
	signed LISP_WORD_TYPE val: VALBITS;
	unsigned LISP_WORD_TYPE mark_type: GCTYPEBITS + 1;
      } s;
    struct
      {
	unsigned LISP_WORD_TYPE val: VALBITS;
#ifdef __GNUC__ /* Non-ANSI extension */
        enum Lisp_Type type: GCTYPEBITS;
#else
	unsigned LISP_WORD_TYPE 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.  */
	unsigned LISP_WORD_TYPE markbit: 1;
      } gu;
    LISP_WORD_TYPE i;
    struct __nosuchstruct__ *v;
    CONST struct __nosuchstruct__ *cv;             /* C sucks */
  }
Lisp_Object;

#endif /* BIG/LITTLE_ENDIAN vs HIGH/LOWTAGS */


#ifndef XMAKE_LISP
#if (__GNUC__ > 1)
/* Use GCC's struct initializers feature */
#define XMAKE_LISP(vartype,ptr) \
   ((union Lisp_Object) { gu: { markbit: 0, \
                                type: (vartype), \
                                val: ((unsigned LISP_WORD_TYPE) ptr) } })
#endif /* __GNUC__ */
#endif /* !XMAKE_LISP */


#ifdef XMAKE_LISP
#define Qzero (XMAKE_LISP (Lisp_Int, 0))
#define make_number(a) (XMAKE_LISP (Lisp_Int, (a)))
#else
extern Lisp_Object Qzero;
#endif


#define EQ(x,y) ((x).v == (y).v)

#define XTYPE(a) ((enum Lisp_Type) (a).gu.type)
#define XSETTYPE(a,b) ((a).gu.type = (b))
#define XGCTYPE(a) XTYPE((a))

/* This definition should be enabled but I feel a bit of trepidation
   in doing so. --ben */
#if 0 /* EXPLICIT_SIGN_EXTEND */
/* Make sure we sign-extend; compilers have been known to fail to do so.  */
#define XINT(a) (((a).i << ((LONGBITS) - (VALBITS))) >> ((LONGBITS) - (VALBITS)))
#else
#define XINT(a) ((a).s.val)
#endif /* EXPLICIT_SIGN_EXTEND */

#if 0
/* XFASTINT is error-prone and saves a few instructions at best,
   so there's really no point to it.  Just use XINT() or make_number()
   instead. --ben */
/* The + 0 is to prevent XFASTINT being used on the LHS of an assignment */
#define XFASTINT(a) ((a).gu.val + 0)
#endif /* 0 */

#define XUINT(a) ((a).gu.val)
#ifdef HAVE_SHM
/* In this representation, data is found in two widely separated segments.  */
extern int pure_size;
# define XPNTR(a) \
  ((void *)(((a).gu.val) | ((a).gu.val > 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 *)(((a).gu.val) | DATA_SEG_BITS))
# else /* not DATA_SEG_BITS */
#  define XPNTR(a) ((void *) ((a).gu.val))
# endif /* not DATA_SEG_BITS */
#endif /* not HAVE_SHM */        
#define XSETINT(a, b) do { ((a) = make_number (b)); } while (0)
#define XSETUINT(a, b) XSETINT (a, b)
#define XSETPNTR(a, b) XSETINT (a, b)

/* 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 XMAKE_LISP
#define XSETOBJ(var,vartype,ptr) \
  do { ((var) = XMAKE_LISP ((vartype), (ptr))); } while (0)
#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,ptr)				\
   do {								\
	 Lisp_Object *tmp_xset_var = &((var));			\
	 (*tmp_xset_var).s.val = ((LISP_WORD_TYPE) (ptr));	\
	 (*tmp_xset_var).gu.markbit = 0;			\
	 (*tmp_xset_var).gu.type = ((vartype));			\
      } while (0)
#endif /* undefined XMAKE_LISP */

/* During garbage collection, XGCTYPE must be used for extracting types
 so that the mark bit is ignored.  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 XSETMARKBIT(a,b) do { (XMARKBIT(a) = (b)); } while (0)
#define XMARK(a) do { XMARKBIT(a) = 1; } while (0)
/* no 'do {} while' because this is used in a mondo macro in lrecord.h */
#define XUNMARK(a) (XMARKBIT(a) = 0)

/* Use this for turning a (void *) into a Lisp_Object, as when the
  Lisp_Object is passed into a toolkit callback function */
#define VOID_TO_LISP(larg,varg) \
  do { ((larg).v = (struct __nosuchstruct__ *) (varg)); } while (0)
#define CVOID_TO_LISP(larg,varg) \
  do { ((larg).cv = (CONST struct __nosuchstruct__ *) (varg)); } while (0)

/* Use this for turning a Lisp_Object into a  (void *), as when the
  Lisp_Object is passed into a toolkit callback function */
#define LISP_TO_VOID(larg) ((void *) ((larg).v))
#define LISP_TO_CVOID(larg) ((CONST void *) ((larg).cv))

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.