This is lisp.h in view mode; [Download] [Up]
/* Fundamental definitions for XEmacs Lisp interpreter.
Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc.
Copyright (C) 1994, 1995 Amdahl Corporation.
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. */
#ifndef _XEMACS_LISP_H_
#define _XEMACS_LISP_H_
/************************************************************************/
/* general definitions */
/************************************************************************/
/* We include the following generally useful header files so that you
don't have to worry about prototypes when using the standard C
library functions and macros. These files shouldn't be excessively
large so they shouldn't cause that much of a slowdown. */
#include <stdlib.h>
#include <unistd.h>
#include <string.h> /* primarily for memcpy, etc. */
#include <stdio.h> /* NULL, etc. */
#include <ctype.h>
#include <stdarg.h>
#ifndef INCLUDED_FCNTL
# define INCLUDED_FCNTL
# include <fcntl.h>
#endif /* INCLUDED_FCNTL */
#ifdef __lucid
# include <sysent.h>
#endif
#include "blocktype.h" /* A generally useful include */
#include "dynarr.h" /* A generally useful include */
#include "symsinit.h" /* compiler warning suppression */
/* Also define min() and max(). (Some compilers put them in strange
places that won't be referenced by the above include files, such
as 'macros.h' under Solaris.) */
#ifndef min
#define min(a,b) ((a) <= (b) ? (a) : (b))
#endif
#ifndef max
#define max(a,b) ((a) > (b) ? (a) : (b))
#endif
/* Emacs needs to use its own definitions of certain system calls on
some systems (like SunOS 4.1 and USG systems, where the read system
call is interruptible but Emacs expects it not to be; and under
MULE, where all filenames need to be converted to external format).
To do this, we #define read to be sys_read, which is defined in
sysdep.c. We first #undef read, in case some system file defines
read as a macro. sysdep.c doesn't encapsulate read, so the call to
read inside of sys_read will do the right thing.
DONT_ENCAPSULATE is used in files such as sysdep.c that want to
call the actual system calls rather than the encapsulated versions.
Those files can call sys_read to get the (possibly) encapsulated
versions.
IMPORTANT: the redefinition of the system call must occur *after* the
inclusion of any header files that declare or define the system call;
otherwise lots of unfriendly things can happen. This goes for all
encapsulated system calls.
We encapsulate the most common system calls here; we assume their
declarations are in one of the standard header files included above.
Other encapsulations are declared in the appropriate sys*.h file. */
#if defined (ENCAPSULATE_READ) && !defined (DONT_ENCAPSULATE)
# undef read
# define read sys_read
#endif
#if !defined (ENCAPSULATE_READ) && defined (DONT_ENCAPSULATE)
# define sys_read read
#endif
#if defined (ENCAPSULATE_WRITE) && !defined (DONT_ENCAPSULATE)
# undef write
# define write sys_write
#endif
#if !defined (ENCAPSULATE_WRITE) && defined (DONT_ENCAPSULATE)
# define sys_write write
#endif
#if defined (ENCAPSULATE_OPEN) && !defined (DONT_ENCAPSULATE)
# undef open
# define open sys_open
#endif
#if !defined (ENCAPSULATE_OPEN) && defined (DONT_ENCAPSULATE)
# define sys_open open
#endif
#if defined (ENCAPSULATE_CLOSE) && !defined (DONT_ENCAPSULATE)
# undef close
# define close sys_close
#endif
#if !defined (ENCAPSULATE_CLOSE) && defined (DONT_ENCAPSULATE)
# define sys_close close
#endif
/* Now the stdio versions ... */
#if defined (ENCAPSULATE_FREAD) && !defined (DONT_ENCAPSULATE)
# undef fread
# define fread sys_fread
#endif
#if !defined (ENCAPSULATE_FREAD) && defined (DONT_ENCAPSULATE)
# define sys_fread fread
#endif
#if defined (ENCAPSULATE_FWRITE) && !defined (DONT_ENCAPSULATE)
# undef fwrite
# define fwrite sys_fwrite
#endif
#if !defined (ENCAPSULATE_FWRITE) && defined (DONT_ENCAPSULATE)
# define sys_fwrite fwrite
#endif
#if defined (ENCAPSULATE_FOPEN) && !defined (DONT_ENCAPSULATE)
# undef fopen
# define fopen sys_fopen
#endif
#if !defined (ENCAPSULATE_FOPEN) && defined (DONT_ENCAPSULATE)
# define sys_fopen fopen
#endif
#if defined (ENCAPSULATE_FCLOSE) && !defined (DONT_ENCAPSULATE)
# undef fclose
# define fclose sys_fclose
#endif
#if !defined (ENCAPSULATE_FCLOSE) && defined (DONT_ENCAPSULATE)
# define sys_fclose fclose
#endif
/* generally useful */
#define countof(x) (sizeof(x)/sizeof(x[0]))
#define slot_offset(type, slot_name) \
((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0)))
#define malloc_type(type) ((type *) xmalloc (sizeof (type)))
#define malloc_type_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type)))
/* also generally useful if you want to avoid arbitrary size limits
but don't need a full dynamic array. Assumes that BASEVAR points
to a malloced array of TYPE objects (or possibly a NULL pointer,
if SIZEVAR is 0), with the total size stored in SIZEVAR. This
macro will realloc BASEVAR as necessary so that it can hold at
least NEEDED_SIZE objects. The reallocing is done by doubling,
which ensures constant amortized time per element. */
#define DO_REALLOC(basevar, sizevar, needed_size, type) do \
{ \
/* Avoid side-effectualness. */ \
/* Dammit! Macros suffer from dynamic scope! */ \
/* We demand inline functions! */ \
int do_realloc_needed_size = (needed_size); \
int newsize = 0; \
while ((sizevar) < (do_realloc_needed_size)) { \
newsize = 2*(sizevar); \
if (newsize < 32) \
newsize = 32; \
(sizevar) = newsize; \
} \
if (newsize) \
(basevar) = (type *) xrealloc (basevar, (newsize)*sizeof(type)); \
} while (0)
#ifdef ERROR_CHECK_MALLOC
#define xfree(lvalue) do \
{ \
void **ptr = (void **) &(lvalue); \
xfree_1 (*ptr); \
*ptr = (void *) 0xDEADBEEF; \
} while (0)
#else
#define xfree_1 xfree
#endif
/* We assume an ANSI C compiler and libraries and memcpy, memset, memcmp */
/* (This definition is here because system header file macros may want
* to call bzero (eg FD_ZERO) */
#ifndef bzero
#define bzero(m, l) memset ((m), 0, (l))
#endif
#ifndef DOESNT_RETURN
# ifdef __GNUC__
# define DOESNT_RETURN void volatile /* eg extern DOESNT_RETURN abort (); */
# else
# define DOESNT_RETURN void
# endif
#endif
#ifndef ALIGNOF
# if defined (__GNUC__) && (__GNUC__ >= 2)
# define ALIGNOF(x) __alignof(x)
# else
# define ALIGNOF(x) sizeof(x)
# endif
#endif
#ifdef QUANTIFY
#include "quantify.h"
#define QUANTIFY_START_RECORDING \
do { quantify_start_recording_data (); } while (0)
#define QUANTIFY_STOP_RECORDING \
do { quantify_stop_recording_data (); } while (0)
#else /* !QUANTIFY */
#define QUANTIFY_START_RECORDING
#define QUANTIFY_STOP_RECORDING
#endif /* !QUANTIFY */
#ifndef DO_NOTHING
#define DO_NOTHING do {} while (0)
#endif
/* We define assert iff USE_ASSERTIONS or DEBUG_XEMACS is defined.
Otherwise we it to NULL. Quantify has shown that the time the
assert checks take is measurable so let's not include them in
production binaries. */
#ifdef USE_ASSERTIONS
/* Highly dubious kludge */
/* (thanks, Jamie, I feel better now -- ben) */
extern void assert_failed (CONST char *, int, CONST char *);
# define abort() (assert_failed (__FILE__, __LINE__, "abort()"))
# define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x))
#else
# ifdef DEBUG_XEMACS
# define assert(x) ((x) ? (void) 0 : (void) abort ())
# else
# define assert(x)
# endif
#endif
#ifdef DEBUG_XEMACS
#define REGISTER
#else
#define REGISTER register
#endif
#ifndef INT_MAX
#define INT_MAX ((int) ((1U << (INTBITS - 1)) - 1))
#endif
#if defined (__GNUC__) && (__GNUC__ >= 2)
/* Entomological studies have revealed that the following junk is
necessary under GCC. GCC has a compiler bug where incorrect
code will be generated if you use a global temporary variable
in a macro and the macro occurs twice in the same expression.
As it happens, we can avoid this problem using a GCC language
extension. Thus we play weird games with syntax to avoid having
to provide two definitions for lots of macros.
The approximate way this works is as follows:
1. Use these macros whenever you want to avoid evaluating an
argument more than once in a macro. (It's almost always a
good idea to make your macros safe like this.)
2. Choose a name for the temporary variable you will store
the parameter in. It should begin with `mactemp_' and
be distinguishing, since it will (or may) be a global
variable.
3. In the same header file as the macro, put in a
MAC_DECLARE_EXTERN for the temporary variable. This
resolves to an external variable declaration for some
compilers.
4. Put a MAC_DEFINE for the variable in a C file somewhere.
This resolves to a variable definition for some compilers.
5. Write your macro with no semicolons or commas in it.
Remember to use parentheses to surround macro arguments,
but you do not need to surround each separate statement
or the temporary variable with parentheses.
6. Write your macro like this:
#define foo(bar,baz) \
MAC_BEGIN \
MAC_DECLARE (struct frobozz *, mactemp_foobar, bar) \
SOME_EXPRESSION \
MAC_SEP \
SOME OTHER EXPRESSION \
MAC_END
7. You only need to use MAC_SEP if you have more than one
expression in the macro, not counting any MAC_DECLARE
statements.
DONT_DECLARE_MAC_VARS is used in signal.c, for asynchronous signals.
All functions that may be called from within an asynchronous signal
handler must declare local variables (with MAC_DECLARE_LOCAL) for
the (normally global) variables used in these sorts of macros.
Otherwise, a signal could occur in the middle of processing one
of these macros and the signal handler could use the same macro,
resulting in the global variable getting overwritten and yielding
nasty evil crashes that are very difficult to track down.
*/
# define MAC_BEGIN ({
# define MAC_DECLARE(type, var, value) type var = (value);
# define MAC_SEP ;
# define MAC_END ; })
# define MAC_DECLARE_EXTERN(type, var)
# define MAC_DECLARE_LOCAL(type, var)
# define MAC_DEFINE(type, var)
#else
# define MAC_BEGIN (
# define MAC_DECLARE(type, var, value) var = (value),
# define MAC_SEP ,
# define MAC_END )
# ifdef DONT_DECLARE_MAC_VARS
# define MAC_DECLARE_EXTERN(type, var)
# else
# define MAC_DECLARE_EXTERN(type, var) extern type var;
# endif
# define MAC_DECLARE_LOCAL(type, var) type var
# define MAC_DEFINE(type, var) type var
#endif
/************************************************************************/
/* typedefs */
/************************************************************************/
/* We put typedefs here so that prototype declarations don't choke.
Note that we don't actually declare the structures here (except
maybe for simple structures like Dynarrs); that keeps them private
to the routines that actually use them. */
/* The data representing the text in a buffer is logically a set
of Bufbytes, declared as follows. */
typedef unsigned char Bufbyte;
/* To the user, a buffer is made up of characters, declared as follows.
In the non-Mule world, characters and Bufbytes are equivalent.
In the Mule world, a characters requires (typically) 1 to 4
Bufbytes for its representation in a buffer. */
typedef int Emchar;
/* Different ways of referring to a position in a buffer. We use
the typedefs in preference to 'int' to make it clearer what
sort of position is being used. See extents.c for a description
of the different positions. We put them here instead of in
buffer.h (where they rightfully belong) to avoid syntax errors
in function prototypes. */
typedef int Bufpos;
typedef int Bytind;
typedef int Memind;
/* Counts of bytes or chars */
typedef int Bytecount;
typedef int Charcount;
typedef struct lstream Lstream;
typedef unsigned int face_index;
typedef struct face_cache_element_dynarr_type
{
Dynarr_declare (struct face_cache_element);
} face_cache_element_dynarr;
typedef unsigned int glyph_index;
typedef struct glyph_cache_element_dynarr_type
{
Dynarr_declare (struct glyph_cache_element);
} glyph_cache_element_dynarr;
struct buffer; /* "buffer.h" */
struct device; /* device.h */
struct extent_fragment;
struct extent;
struct frame; /* "frame.h" */
struct window; /* "window.h" */
struct Lisp_Event; /* "events.h" */
struct Lisp_Process; /* "process.c" */
struct stat; /* <sys/stat.h> */
struct Lisp_Color_Instance;
struct Lisp_Font_Instance;
struct Lisp_Image_Instance;
struct font_metric_info;
typedef struct bufbyte_dynarr_type
{
Dynarr_declare (Bufbyte);
} bufbyte_dynarr;
typedef struct emchar_dynarr_type
{
Dynarr_declare (Emchar);
} emchar_dynarr;
typedef struct unsigned_char_dynarr_type
{
Dynarr_declare (unsigned char);
} unsigned_char_dynarr;
typedef struct int_dynarr_type
{
Dynarr_declare (int);
} int_dynarr;
/************************************************************************/
/* Definition of Lisp_Object data type */
/************************************************************************/
/* There's not any particular reason not to use lrecords for these; some
objects get slightly larger, but we get 3 bit tags instead of 4.
*/
#define LRECORD_SYMBOL
/* Define the fundamental Lisp data structures */
/* This is the set of Lisp data types */
enum Lisp_Type
{
/* Integer. XINT(obj) is the integer value. */
Lisp_Int /* 0 DTP-FIXNUM */
/* XRECORD_LHEADER (object) points to a struct lrecord_header
lheader->implementation determines the type (and GC behaviour)
of the object. */
,Lisp_Record /* 1 DTP-OTHER-POINTER */
/* Cons. XCONS (object) points to a struct Lisp_Cons. */
,Lisp_Cons /* 2 DTP-LIST */
/* LRECORD_STRING is NYI */
/* String. XSTRING (object) points to a struct Lisp_String.
The length of the string, and its contents, are stored therein. */
,Lisp_String /* 3 DTP-STRING */
#ifndef LRECORD_VECTOR
/* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector.
The length of the vector, and its contents, are stored therein. */
,Lisp_Vector /* 4 DTP-SIMPLE-ARRAY */
#endif
#ifndef LRECORD_SYMBOL
/* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
,Lisp_Symbol
#endif /* !LRECORD_SYMBOL */
};
#define POINTER_TYPE_P(type) ((type) != Lisp_Int)
/* This should be the underlying type intowhich a Lisp_Object must fit.
In a strict ANSI world, this must be `int', since ANSI says you can't
use bitfields on any type other than `int'. However, on a machine
where `int' and `long' are not the same size, this should be the
longer of the two. (This also must be something into which a pointer
to an arbitrary object will fit, modulo any DATA_SEG_BITS cruft.)
*/
#if (LONGBITS > INTBITS)
# define LISP_WORD_TYPE long
#else
# define LISP_WORD_TYPE int
#endif
/* Cast pointers to this type to compare them. Some machines want int. */
#ifndef PNTR_COMPARISON_TYPE
# define PNTR_COMPARISON_TYPE unsigned int
#endif
/* These values are overridden by the m- file on some machines. */
#ifndef GCTYPEBITS
# define GCTYPEBITS 3L
#endif
#ifndef VALBITS
# define VALBITS ((LONGBITS)-((GCTYPEBITS)+1L))
#endif
#ifdef NO_UNION_TYPE
# include "lisp-disunion.h"
#else /* !NO_UNION_TYPE */
# include "lisp-union.h"
#endif /* !NO_UNION_TYPE */
/* WARNING WARNING WARNING. You must ensure on your own that proper
GC protection is provided for the elements in this array. */
typedef struct lisp_dynarr_type
{
Dynarr_declare (Lisp_Object);
} lisp_dynarr;
/************************************************************************/
/* Definitions of basic Lisp objects */
/************************************************************************/
#include "lrecord.h"
/********** unbound ***********/
/* Qunbound is a special Lisp_Object (actually of type
symbol-value-forward), that can never be visible to
the Lisp caller and thus can be used in the C code
to mean "no such value". */
#define UNBOUNDP(val) EQ (val, Qunbound)
/*********** cons ***********/
/* In a cons, the markbit of the car is the gc mark bit */
struct Lisp_Cons
{
Lisp_Object car, cdr;
};
#if 0 /* FSFmacs */
/* Like a cons, but records info on where the text lives that it was read from */
/* This is not really in use now */
struct Lisp_Buffer_Cons
{
Lisp_Object car, cdr;
struct buffer *buffer;
int bufpos;
};
#endif
DECLARE_NONRECORD (cons, struct Lisp_Cons);
#define XCONS(a) XNONRECORD (a, cons, Lisp_Cons, struct Lisp_Cons)
#define XSETCONS(c, p) XSETOBJ (c, Lisp_Cons, p)
#define CONSP(x) (XTYPE (x) == Lisp_Cons)
#define CHECK_CONS(x, i) \
do { if (!CONSP (x)) x = wrong_type_argument (Qconsp, x); } while (0)
#define NILP(x) EQ (x, Qnil)
#define CHECK_LIST(x, i) \
do { if ((!CONSP (x)) && !NILP (x)) x = wrong_type_argument (Qlistp, x); } while (0)
#define XCAR(a) (XCONS (a)->car)
#define XCDR(a) (XCONS (a)->cdr)
/* For a list that's known to be in valid list format --
will abort() if the list is not in valid format */
#define LIST_LOOP(consvar, list) \
for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
/* For a list that may not be in valid list format --
will signal an error if the list is not in valid format */
#define EXTERNAL_LIST_LOOP(consvar, listp) \
for (consvar = listp; !NILP (consvar); consvar = XCDR (consvar)) \
if (!CONSP (consvar)) \
signal_simple_error ("Invalid list format", listp); \
else
/* For a property list (alternating keywords/values) that may not be
in valid list format -- will signal an error if the list is not in
valid format. CONSVAR is used to keep track of the iterations
without modifying LISTP.
We have to be tricky to still keep the same C format.*/
#define EXTERNAL_PROPERTY_LIST_LOOP(consvar, keyword, value, listp) \
for (consvar = listp; \
(CONSP (consvar) && CONSP (XCDR (consvar)) ? \
(keyword = XCAR (consvar), value = XCAR (XCDR (consvar))) : \
(keyword = Qunbound, value = Qunbound)), \
!NILP (consvar); \
consvar = XCDR (XCDR (consvar))) \
if (UNBOUNDP (keyword)) \
signal_simple_error ("Invalid property list format", listp); \
else
/*********** string ***********/
/* In a string or vector, the sign bit of the `size' is the gc mark bit */
/* (The size and data fields have underscores prepended to catch old
code that attempts to reference the fields directly) */
struct Lisp_String
{
#ifdef LRECORD_STRING
struct lrecord_header lheader;
#endif
long _size;
Bufbyte *_data;
Lisp_Object plist;
};
#ifdef LRECORD_STRING
DECLARE_LRECORD (string, struct Lisp_String);
#define XSTRING(x) XRECORD (x, string, struct Lisp_String)
#define XSETSTRING(x, p) XSETRECORD (x, p, string)
#define STRINGP(x) RECORDP (x, string)
#define CHECK_STRING(x, i) CHECK_RECORD (x, string)
#else
DECLARE_NONRECORD (string, struct Lisp_String);
#define XSTRING(x) XNONRECORD (x, string, Lisp_String, struct Lisp_String)
#define XSETSTRING(x, p) XSETOBJ (x, Lisp_String, p)
#define STRINGP(x) (XTYPE (x) == Lisp_String)
#define CHECK_STRING(x, i) \
do { if (!STRINGP (x)) x = wrong_type_argument (Qstringp, x); } while (0)
#endif
#define string_length(s) ((s)->_size)
#define string_data(s) ((s)->_data + 0)
#define string_byte(s, i) ((s)->_data[i] + 0)
#define set_string_length(s, len) do { (s)->_size = (len); } while (0)
#define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0)
#define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0)
#define string_dups(s) string_getprop (s, Qdup_list, Qnil)
#define set_string_dups(s, list) string_putprop (s, Qdup_list, list)
#ifdef MULE
# define string_char_length(s) ---- no Mule support yet ----
# define string_ext_length(s) ---- no Mule support yet ----
# define string_char(s, i) ---- no Mule support yet ----
# define set_string_char(s, i, c) ---- no Mule support yet ----
#else
# define string_char_length(s) string_length (s)
# define string_ext_length(s) string_length (s)
# define string_char(s, i) ((Emchar) string_byte (s, i))
# define set_string_char(s, i, c) set_string_byte (s, i, c)
#endif /* MULE */
extern char *string_ext_data_static (struct Lisp_String *s, int bin);
extern char *string_ext_data_malloc (struct Lisp_String *s);
#define string_ext_data(s) string_ext_data_static (s, 0)
#define string_ext_data2(s) string_ext_data_static (s, 1)
#define string_ext_data3(s) string_ext_data_static (s, 2)
#define string_ext_data4(s) string_ext_data_static (s, 3)
#define string_ext_data5(s) string_ext_data_static (s, 4)
/*********** vector ***********/
struct Lisp_Vector
{
#ifdef LRECORD_VECTOR
struct lrecord_header lheader;
#endif
long size;
/* next is now chained through v->contents[size], terminated by Qzero.
* This means that pure vectors don't need a "next" */
/* struct Lisp_Vector *next; */
Lisp_Object contents[1];
};
#ifdef LRECORD_VECTOR
DECLARE_LRECORD (vector, struct Lisp_Vector);
#define XVECTOR(x) XRECORD (x, vector, struct Lisp_Vector)
#define XSETVECTOR(x, p) XSETRECORD (x, p, vector)
#define VECTORP(x) RECORDP (x, vector)
#define CHECK_VECTOR(x, i) CHECK_RECORD (x, vector)
#else
DECLARE_NONRECORD (vector, struct Lisp_Vector);
#define XVECTOR(x) XNONRECORD (x, vector, Lisp_Vector, struct Lisp_Vector)
#define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Vector, p)
#define VECTORP(x) (XTYPE (x) == Lisp_Vector)
#define CHECK_VECTOR(x, i) \
do { if (!VECTORP (x)) x = wrong_type_argument (Qvectorp, x); } while(0)
#endif
#define vector_length(v) ((v)->size)
#define vector_data(v) ((v)->contents)
#define vector_next(v) ((v)->contents[(v)->size])
/*********** symbol ***********/
/* In a symbol, the markbit of the plist is used as the gc mark bit */
struct Lisp_Symbol
{
#ifdef LRECORD_SYMBOL
struct lrecord_header lheader;
#endif
/* next symbol in this obarray bucket */
struct Lisp_Symbol *next;
struct Lisp_String *name;
Lisp_Object value;
Lisp_Object function;
Lisp_Object plist;
};
#define SYMBOL_IS_KEYWORD(sym) (string_byte (XSYMBOL(sym)->name, 0) == ':')
#define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj))
#ifdef LRECORD_SYMBOL
DECLARE_LRECORD (symbol, struct Lisp_Symbol);
#define XSYMBOL(x) XRECORD (x, symbol, struct Lisp_Symbol)
#define XSETSYMBOL(x, p) XSETRECORD (x, p, symbol)
#define SYMBOLP(x) RECORDP (x, symbol)
#define CHECK_SYMBOL(x, i) CHECK_RECORD (x, symbol)
#else
DECLARE_NONRECORD (symbol, struct Lisp_Symbol);
#define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Symbol, struct Lisp_Symbol)
#define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Symbol, (p))
#define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
#define CHECK_SYMBOL(x, i) \
do { if (!SYMBOLP (x)) x = wrong_type_argument (Qsymbolp, x); } while(0)
#endif
#define symbol_next(s) ((s)->next)
/*********** subr ***********/
struct Lisp_Subr
{
struct lrecord_header lheader;
short min_args, max_args;
CONST char *prompt;
CONST char *doc;
CONST char *name;
Lisp_Object (*subr_fn) ();
};
DECLARE_LRECORD (subr, struct Lisp_Subr);
#define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr)
#define XSETSUBR(x, p) XSETRECORD (x, p, subr)
#define SUBRP(x) RECORDP (x, subr)
#define CHECK_SUBR(x, i) CHECK_RECORD (x, subr)
#define subr_function(subr) (subr)->subr_fn
#define subr_name(subr) (subr)->name
/*********** marker ***********/
struct Lisp_Marker
{
struct lrecord_header lheader;
struct Lisp_Marker *next;
struct buffer *buffer;
Memind memind;
};
DECLARE_LRECORD (marker, struct Lisp_Marker);
#define XMARKER(x) XRECORD (x, marker, struct Lisp_Marker)
#define XSETMARKER(x, p) XSETRECORD (x, p, marker)
#define MARKERP(x) RECORDP (x, marker)
#define CHECK_MARKER(x, i) CHECK_RECORD (x, marker)
/* The second check was looking for GCed markers still in use */
/* if (INTP (XMARKER (x)->lheader.next.v)) abort (); */
#define marker_next(m) ((m)->next)
/*********** float ***********/
#ifdef LISP_FLOAT_TYPE
struct Lisp_Float
{
struct lrecord_header lheader;
union { double d; struct Lisp_Float *next; } data;
};
DECLARE_LRECORD (float, struct Lisp_Float);
#define XFLOAT(x) XRECORD (x, float, struct Lisp_Float)
#define XSETFLOAT(x, p) XSETRECORD (x, p, float)
#define FLOATP(x) RECORDP (x, float)
#define CHECK_FLOAT(x, i) CHECK_RECORD (x, float)
#define float_next(f) ((f)->data.next)
#define float_data(f) ((f)->data.d)
#ifndef DBL_DIG
# define DBL_DIG 16
#endif
#define XFLOATINT(n) extract_float (n)
#define CHECK_INT_OR_FLOAT(x, i) \
do { if ( !INTP (x) && !FLOATP (x)) \
x = wrong_type_argument (Qnumberp, (x)); } while (0)
#define CHECK_INT_OR_FLOAT_COERCE_MARKER(x, i) \
do { if (INTP (x) || FLOATP (x)) \
; \
else if (MARKERP (x)) \
x = make_number (marker_position (x)); \
else \
x = wrong_type_argument (Qnumber_or_marker_p, x); } while (0)
# define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
#else /* not LISP_FLOAT_TYPE */
#define XFLOAT(x) --- error! No float support. ---
#define XSETFLOAT(x, p) --- error! No float support. ---
#define FLOATP(x) 0
#define CHECK_FLOAT(x, i) --- error! No float support. ---
#define XFLOATINT(n) XINT(n)
#define CHECK_INT_OR_FLOAT CHECK_INT
#define CHECK_INT_OR_FLOAT_COERCE_MARKER CHECK_INT_COERCE_MARKER
#define INT_OR_FLOATP(x) (INTP (x))
#endif /* not LISP_FLOAT_TYPE */
#define INTP(x) (XTYPE (x) == Lisp_Int)
#define CHECK_INT(x, i) \
do { if (!INTP (x)) x = wrong_type_argument (Qintegerp, x); } while (0)
#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
#define CHECK_NATNUM(x, i) \
do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
#ifdef MULE
extern int valid_emchar_p (Emchar ch);
#define CHARP(x) (INTP (x) && valid_emchar_p (XINT (x)))
#else
/* #### Ugh, backward compatibility: should check for a range of 0 - 255 */
#define CHARP(x) INTP (x)
#endif
#ifdef MULE
#define COERCE_CHAR(x)
#else
#define COERCE_CHAR(x) \
do { XSETINT (x, XINT (x) & 0xFF); } while (0)
#endif
#define CHECK_COERCE_CHAR(x, i) \
do { if (!CHARP (x)) x = wrong_type_argument (Qcharacterp, x); \
COERCE_CHAR (x); } while (0)
#define CHECK_INT_COERCE_MARKER(x, i) \
do { if (INTP (x)) \
; \
else if (MARKERP (x)) \
x = make_number (marker_position (x)); \
else \
x = wrong_type_argument (Qinteger_or_marker_p, x); } while (0)
/*********** pure space ***********/
#define CHECK_IMPURE(obj) \
do { if (purified (obj)) pure_write_error (); } while (0)
/************************************************************************/
/* Definitions of primitive Lisp functions and variables */
/************************************************************************/
/* Define a built-in function for calling from Lisp.
`lname' should be the name to give the function in Lisp,
as a null-terminated C string.
`fnname' should be the name of the function in C.
By convention, it starts with F.
`sname' should be the name for the C constant structure
that records information on this function for internal use.
By convention, it should be the same as `fnname' but with S instead of F.
It's too bad that C macros can't compute this from `fnname'.
`minargs' should be a number, the minimum number of arguments allowed.
`maxargs' should be a number, the maximum number of arguments allowed,
or else MANY or UNEVALLED.
MANY means pass a vector of evaluated arguments,
in the form of an integer number-of-arguments
followed by the address of a vector of Lisp_Objects
which contains the argument values.
UNEVALLED means pass the list of unevaluated arguments
`prompt' says how to read arguments for an interactive call.
This can be zero or a C string.
Zero means that interactive calls are not allowed.
A string is interpreted in a hairy way:
it should contain one line for each argument to be read, terminated by \n.
The first character of the line controls the type of parsing:
s -- read a string.
S -- read a symbol.
k -- read a key sequence and return it as a string.
a -- read a function name (symbol) with completion.
C -- read a command name (symbol) with completion.
v -- read a variable name (symbol) with completion.
b -- read a buffer name (a string) with completion.
B -- buffer name, may be existing buffer or may not be.
f -- read a file name, file must exist.
F -- read a file name, file need not exist.
n -- read a number.
c -- read a character and return it as a number.
p -- use the numeric value of the prefix argument.
P -- use raw value of prefix - can be nil, -, (NUMBER) or NUMBER.
x -- read a Lisp object from the minibuffer.
X -- read a Lisp form from the minibuffer and use its value.
A null string means call interactively with no arguments.
`doc' is documentation for the user.
*/
#define SUBR_MAX_ARGS 8
#define MANY -2
#define UNEVALLED -1
/* Can't be const, because then subr->doc is read-only and
* FSnarf_documentation chokes */
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; /* See below */ \
static struct Lisp_Subr sname \
= { { lrecord_subr }, minargs, maxargs, prompt, 0, lname, fnname }; \
Lisp_Object fnname
/* Scary ANSI C preprocessor hackery by Felix Lee <flee@guardian.cse.psu.edu>
to get DEFUN to declare a prototype that matches maxargs, so that the
compiler can complain if the "real" arglist doesn't match. Clever hack
or repulsive kludge? You be the judge.
*/
/* WARNING: If you add defines below for higher values of maxargs,
make sure to also fix the clauses in funcall_subr() */
#define DEFUN_ARGS_MANY (int, Lisp_Object *)
#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
#define DEFUN_ARGS_0 (void)
#define DEFUN_ARGS_1 (Lisp_Object)
#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object)
#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_9 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object)
#define DEFUN_ARGS_10 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_11 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object)
#define DEFUN_ARGS_12 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
#include "symeval.h"
/* Depth of special binding/unwind-protect stack. Use as arg to unbind_to */
extern int specpdl_depth (void);
/************************************************************************/
/* Checking for QUIT */
/************************************************************************/
/* Asynchronous events set something_happened, and then are processed
within the QUIT macro. At this point, we are guaranteed to not be in
any sensitive code. */
extern volatile int something_happened;
extern int check_what_happened (void);
extern volatile int quit_check_signal_happened;
extern volatile int quit_check_signal_tick_count;
extern int check_quit (void);
extern void signal_quit (void);
/* Nonzero if ought to quit now. */
#define QUITP ((quit_check_signal_happened ? check_quit () : 0), \
(!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
|| EQ (Vquit_flag, Qcritical))))
/* QUIT used to call QUITP, but there are some places where QUITP
is called directly, and check_what_happened() should only be called
when Emacs is actually ready to quit because it could do things
like switch threads. */
#define INTERNAL_QUITP \
((something_happened ? check_what_happened () : 0), \
(!NILP (Vquit_flag) && \
(NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
#define INTERNAL_REALLY_QUITP \
(check_what_happened (), \
(!NILP (Vquit_flag) && \
(NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
/* Check quit-flag and quit if it is non-nil. Also do any other things
that might have gotten queued until it was safe. */
#define QUIT \
do { if (INTERNAL_QUITP) signal_quit (); } while (0)
#define REALLY_QUIT \
do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
/************************************************************************/
/* hashing */
/************************************************************************/
/* #### for a 64-bit machine, we should substitute a prime just over
2^32 */
#define GOOD_HASH_VALUE 65599 /* prime number just over 2^16;
Dragon book, p. 435 */
#define HASH2(a, b) ((a) * GOOD_HASH_VALUE + (b))
#define HASH3(a, b, c) (HASH2 (a, b) * GOOD_HASH_VALUE + (c))
#define HASH4(a, b, c, d) (HASH3 (a, b, c) * GOOD_HASH_VALUE + (d))
#define HASH5(a, b, c, d, e) (HASH4 (a, b, c, d) * GOOD_HASH_VALUE + (e))
#define HASH6(a, b, c, d, e, f) (HASH5 (a, b, c, d, e) * GOOD_HASH_VALUE + (f))
#define HASH7(a, b, c, d, e, f, g) \
(HASH6 (a, b, c, d, e, f) * GOOD_HASH_VALUE + (g))
#define HASH8(a, b, c, d, e, f, g, h) \
(HASH7 (a, b, c, d, e, f, g) * GOOD_HASH_VALUE + (h))
#define HASH9(a, b, c, d, e, f, g, h, i) \
(HASH8 (a, b, c, d, e, f, g, h) * GOOD_HASH_VALUE + (i))
/* Enough already! */
#define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj))
unsigned long string_hash (CONST void *xv);
unsigned long memory_hash (CONST void *xv, int size);
unsigned long internal_hash (Lisp_Object obj, int depth);
/************************************************************************/
/* String translation */
/************************************************************************/
#ifdef I18N3
# if 0
# include <libintl.h> /* SunOS 4 doesn't have this loser */
# else
extern char *dgettext (CONST char *, CONST char *);
extern char *gettext (CONST char *);
extern char *textdomain (CONST char *);
extern char *bindtextdomain (CONST char *, CONST char *);
# endif
# define GETTEXT(x) gettext (x)
# define LISP_GETTEXT(x) Fgettext (x)
#else /* !I18N3 */
# define GETTEXT(x) (x)
# define LISP_GETTEXT(x) (x)
#endif /* !I18N3 */
/* DEFER_GETTEXT is used to identify strings which are translated when
they are referenced instead of when they are defined.
These include Qerror_messages and initialized arrays of strings.
*/
#define DEFER_GETTEXT(x) (x)
/************************************************************************/
/* Case conversion */
/************************************************************************/
/* A "trt" table is a mapping from characters to other characters,
typically used to convert between uppercase and lowercase. For
compatibility reasons, trt tables are currently in the form of
a Lisp string of 256 characters, specifying the conversion for each
of the first 256 Emacs characters (i.e. the 256 extended-ASCII
characters). This should be generalized at some point to support
conversions for all of the allowable Mule characters.
*/
MAC_DECLARE_EXTERN (Emchar, mactemp_trt_ch)
#define EMACS_TO_C_CHAR(c) ((Bufbyte) (c))
#define C_TO_EMACS_CHAR(c) ((Emchar) (c))
#define IN_TRT_TABLE_DOMAIN(c) ((c) >= 0 && (c) < 0400)
#define TRT_TABLE_OF(trt, c) \
MAC_BEGIN \
MAC_DECLARE (Emchar, mactemp_trt_ch, c) \
IN_TRT_TABLE_DOMAIN (mactemp_trt_ch) ? \
C_TO_EMACS_CHAR (string_char (XSTRING (trt), \
EMACS_TO_C_CHAR (mactemp_trt_ch))) : \
mactemp_trt_ch \
MAC_END
MAC_DECLARE_EXTERN (Emchar, mactemp_case_ch)
/* Macros used below. */
#define DOWNCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->downcase_table, c)
#define UPCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->upcase_table, c)
/* For Lo, the Lord didst appear and look upon the face of the code,
and the Lord was unhappy with the strange syntax that had come
into vogue with the cryptic name of "C". And so the Lord didst
decree, that from now on all programmers shall use Pascal syntax,
a syntax truly and in sooth ordained in heaven. Amen. */
/* 1 if CH is upper case. */
#define UPPERCASEP(buf, ch) \
MAC_BEGIN \
MAC_DECLARE (Emchar, mactemp_case_ch, ch) \
DOWNCASE_TABLE_OF (buf, mactemp_case_ch) != mactemp_case_ch \
MAC_END
/* 1 if CH is lower case. */
#define LOWERCASEP(buf, ch) \
MAC_BEGIN \
MAC_DECLARE (Emchar, mactemp_case_ch, ch) \
UPCASE_TABLE_OF (buf, mactemp_case_ch) != mactemp_case_ch && \
DOWNCASE_TABLE_OF (buf, mactemp_case_ch) == mactemp_case_ch \
MAC_END
/* 1 if CH is neither upper nor lower case. */
#define NOCASEP(buf, ch) \
MAC_BEGIN \
MAC_DECLARE (Emchar, mactemp_case_ch, ch) \
UPCASE_TABLE_OF (buf, mactemp_case_ch) == mactemp_case_ch \
MAC_END
/* Upcase a character, or make no change if that cannot be done. */
#define UPCASE(buf, ch) \
MAC_BEGIN \
MAC_DECLARE (Emchar, mactemp_case_ch, ch) \
DOWNCASE_TABLE_OF (buf, mactemp_case_ch) == mactemp_case_ch ? \
UPCASE_TABLE_OF (buf, mactemp_case_ch) : mactemp_case_ch \
MAC_END
/* Upcase a character known to be not upper case. */
#define UPCASE1(buf, ch) UPCASE_TABLE_OF (buf, ch)
/* Downcase a character, or make no change if that cannot be done. */
#define DOWNCASE(buf, ch) DOWNCASE_TABLE_OF (buf, ch)
/************************************************************************/
/* Garbage collection / GC-protection */
/************************************************************************/
/* number of bytes of structure consed since last GC */
extern int consing_since_gc;
/* threshold for doing another gc */
extern int gc_cons_threshold;
/* Structure for recording stack slots that need marking */
/* This is a chain of structures, each of which points at a Lisp_Object
variable whose value should be marked in garbage collection.
Normally every link of the chain is an automatic variable of a function,
and its `val' points to some argument or local variable of the function.
On exit to the function, the chain is set back to the value it had on
entry. This way, no link remains in the chain when the stack frame
containing the link disappears.
Every function that can call Feval must protect in this fashion all
Lisp_Object variables whose contents will be used again. */
extern struct gcpro *gcprolist;
struct gcpro
{
struct gcpro *next;
Lisp_Object *var; /* Address of first protected variable */
int nvars; /* Number of consecutive protected variables */
};
#ifdef DEBUG_GCPRO
extern void debug_gcpro1(), debug_gcpro2(), debug_gcpro3(), debug_gcpro4(),
debug_gcpro_5(), debug_ungcpro();
#define GCPRO1(v) \
debug_gcpro1 (__FILE__, __LINE__,&gcpro1,&v)
#define GCPRO2(v1,v2) \
debug_gcpro2 (__FILE__, __LINE__,&gcpro1,&gcpro2,&v1,&v2)
#define GCPRO3(v1,v2,v3) \
debug_gcpro3 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&v1,&v2,&v3)
#define GCPRO4(v1,v2,v3,v4) \
debug_gcpro4 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,\
&v1,&v2,&v3,&v4)
#define GCPRO5(v1,v2,v3,v4,v5) \
debug_gcpro5 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,&gcpro5,\
&v1,&v2,&v3,&v4,&v5)
#define UNGCPRO \
debug_ungcpro(__FILE__, __LINE__,&gcpro1)
#else /* ! DEBUG_GCPRO */
#define GCPRO1(varname) \
{gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
gcprolist = &gcpro1; }
#define GCPRO2(varname1, varname2) \
{gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
gcprolist = &gcpro2; }
#define GCPRO3(varname1, varname2, varname3) \
{gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
gcprolist = &gcpro3; }
#define GCPRO4(varname1, varname2, varname3, varname4) \
{gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
gcprolist = &gcpro4; }
#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
{gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
gcprolist = &gcpro5; }
#define UNGCPRO (gcprolist = gcpro1.next)
#endif /* ! DEBUG_GCPRO */
/* There was a special version here for the SunPro C compiler
(i.e. without the do and while (0)), because that compiler
reports bogus extra warnings here. However, that special
version is unsafe and could lead to all sorts of strange
behavior. I don't want to have to think about this kludge
when coding, so you'll just have to live with those extra
warnings. (Or tell the compiler writers to fix this!)
*/
/* Evaluate expr, UNGCPRO, and then return the value of expr. */
#define RETURN_UNGCPRO(expr) \
do \
{ \
Lisp_Object ret_ungc_val = (expr); \
UNGCPRO; \
return ret_ungc_val; \
} \
while (0)
/* Call staticpro (&var) to protect static variable `var'. */
extern void staticpro (Lisp_Object *);
/* Nonzero means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
extern int initialized;
#include "emacsfns.h"
#endif /* _XEMACS_LISP_H_ */
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.