#include <stdarg.h>
#include <stddef.h>
+#include <inttypes.h>
/* Use the configure flag --enable-checking[=LIST] to enable various
types of run time checks for Lisp objects. */
#ifndef EMACS_INT
#define EMACS_INT long
#define BITS_PER_EMACS_INT BITS_PER_LONG
-#define pEd "ld"
+#define pI "l"
#endif
#ifndef EMACS_UINT
#define EMACS_UINT unsigned long
#ifndef EMACS_INT
#define EMACS_INT int
#define BITS_PER_EMACS_INT BITS_PER_INT
-#define pEd "d"
+#define pI ""
#endif
#ifndef EMACS_UINT
#define EMACS_UINT unsigned int
#endif
#endif
+/* Integers large enough to hold casted pointers without losing info. */
+#ifdef INTPTR_MAX
+# define EMACS_INTPTR intptr_t
+#else
+# define EMACS_INTPTR EMACS_INT
+#endif
+#ifdef UINTPTR_MAX
+# define EMACS_UINTPTR uintptr_t
+#else
+# define EMACS_UINTPTR EMACS_UINT
+#endif
+
/* Extra internal type checking? */
#ifdef ENABLE_CHECKING
#ifdef USE_LSB_TAG
#define TYPEMASK ((((EMACS_INT) 1) << GCTYPEBITS) - 1)
-#define XTYPE(a) ((enum Lisp_Type) (((EMACS_UINT) (a)) & TYPEMASK))
+#define XTYPE(a) ((enum Lisp_Type) ((a) & TYPEMASK))
#ifdef USE_2_TAGS_FOR_INTS
# define XINT(a) (((EMACS_INT) (a)) >> (GCTYPEBITS - 1))
# define XUINT(a) (((EMACS_UINT) (a)) >> (GCTYPEBITS - 1))
# define XUINT(a) (((EMACS_UINT) (a)) >> GCTYPEBITS)
# define make_number(N) (((EMACS_INT) (N)) << GCTYPEBITS)
#endif
-#define XSET(var, type, ptr) \
- (eassert (XTYPE (ptr) == 0), /* Check alignment. */ \
- (var) = ((EMACS_INT) (type)) | ((EMACS_INT) (ptr)))
+#define XSET(var, type, ptr) \
+ (eassert (XTYPE ((EMACS_INTPTR) (ptr)) == 0), /* Check alignment. */ \
+ (var) = (type) | (EMACS_INTPTR) (ptr))
-#define XPNTR(a) ((EMACS_INT) ((a) & ~TYPEMASK))
+#define XPNTR(a) ((EMACS_INTPTR) ((a) & ~TYPEMASK))
#else /* not USE_LSB_TAG */
#define XSET(var, type, ptr) \
((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((EMACS_INT) (ptr) & VALMASK)))
+ + ((EMACS_INTPTR) (ptr) & VALMASK)))
#ifdef DATA_SEG_BITS
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
which were stored in a Lisp_Object */
-#define XPNTR(a) ((EMACS_UINT) (((a) & VALMASK) | DATA_SEG_BITS))
+#define XPNTR(a) ((EMACS_UINTPTR) (((a) & VALMASK)) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_UINT) ((a) & VALMASK))
+#define XPNTR(a) ((EMACS_UINTPTR) ((a) & VALMASK))
#endif
#endif /* not USE_LSB_TAG */
/* Some versions of gcc seem to consider the bitfield width when issuing
the "cast to pointer from integer of different size" warning, so the
cast is here to widen the value back to its natural size. */
-# define XPNTR(v) ((EMACS_INT)((v).s.val) << GCTYPEBITS)
+# define XPNTR(v) ((EMACS_INTPTR) (v).s.val << GCTYPEBITS)
#else /* !USE_LSB_TAG */
#ifdef DATA_SEG_BITS
/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers
which were stored in a Lisp_Object */
-#define XPNTR(a) (XUINT (a) | DATA_SEG_BITS)
+#define XPNTR(a) ((EMACS_INTPTR) (XUINT (a) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_INT) XUINT (a))
+#define XPNTR(a) ((EMACS_INTPTR) XUINT (a))
#endif
#endif /* !USE_LSB_TAG */
/* Pseudovector types. */
-#define XSETPVECTYPE(v,code) ((v)->size |= PSEUDOVECTOR_FLAG | (code))
+#define XSETPVECTYPE(v, code) XSETTYPED_PVECTYPE(v, header.size, code)
+#define XSETTYPED_PVECTYPE(v, size_member, code) \
+ ((v)->size_member |= PSEUDOVECTOR_FLAG | (code))
+#define XSETPVECTYPESIZE(v, code, sizeval) \
+ ((v)->header.size = PSEUDOVECTOR_FLAG | (code) | (sizeval))
+
+/* The cast to struct vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
+ XSETTYPED_PSEUDOVECTOR(a, b, \
+ ((struct vectorlike_header *) XPNTR (a))->size, \
+ code)
+#define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \
(XSETVECTOR (a, b), \
- eassert ((XVECTOR (a)->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
+ eassert ((size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK)) \
== (PSEUDOVECTOR_FLAG | (code))))
+
#define XSETWINDOW_CONFIGURATION(a, b) \
(XSETPSEUDOVECTOR (a, b, PVEC_WINDOW_CONFIGURATION))
#define XSETPROCESS(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_PROCESS))
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
-#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
+/* XSETSUBR is special since Lisp_Subr lacks struct vectorlike_header. */
+#define XSETSUBR(a, b) \
+ XSETTYPED_PSEUDOVECTOR (a, b, XSUBR (a)->size, PVEC_SUBR)
#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
/* Convenience macros for dealing with Lisp arrays. */
#define AREF(ARRAY, IDX) XVECTOR ((ARRAY))->contents[IDX]
-#define ASIZE(ARRAY) XVECTOR ((ARRAY))->size
+#define ASIZE(ARRAY) XVECTOR ((ARRAY))->header.size
/* The IDX==IDX tries to detect when the macro argument is side-effecting. */
#define ASET(ARRAY, IDX, VAL) \
(eassert ((IDX) == (IDX)), \
unsigned char *data;
};
-struct Lisp_Vector
+/* Header of vector-like objects. This documents the layout constraints on
+ vectors and pseudovectors other than struct Lisp_Subr. It also prevents
+ compilers from being fooled by Emacs's type punning: the XSETPSEUDOVECTOR
+ and PSEUDOVECTORP macros cast their pointers to struct vectorlike_header *,
+ because when two such pointers potentially alias, a compiler won't
+ incorrectly reorder loads and stores to their size fields. See
+ <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8546>. */
+struct vectorlike_header
{
EMACS_UINT size;
- struct Lisp_Vector *next;
+
+ /* Pointer to the next vector-like object. It is generally a buffer or a
+ Lisp_Vector alias, so for convenience it is a union instead of a
+ pointer: this way, one can write P->next.vector instead of ((struct
+ Lisp_Vector *) P->next). */
+ union {
+ struct buffer *buffer;
+ struct Lisp_Vector *vector;
+ } next;
+ };
+
+struct Lisp_Vector
+ {
+ struct vectorlike_header header;
Lisp_Object contents[1];
};
/* Return the number of "extra" slots in the char table CT. */
#define CHAR_TABLE_EXTRA_SLOTS(CT) \
- (((CT)->size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
+ (((CT)->header.size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
#ifdef __GNUC__
struct Lisp_Char_Table
{
- /* This is the vector's size field, which also holds the
+ /* HEADER.SIZE is the vector's size field, which also holds the
pseudovector type information. It holds the size, too.
The size counts the defalt, parent, purpose, ascii,
contents, and extras slots. */
- EMACS_UINT size;
- struct Lisp_Vector *next;
+ struct vectorlike_header header;
/* This holds a default value,
which is used whenever the value for a specific character is nil. */
struct Lisp_Sub_Char_Table
{
- /* This is the vector's size field, which also holds the
+ /* HEADER.SIZE is the vector's size field, which also holds the
pseudovector type information. It holds the size, too. */
- EMACS_INT size;
- struct Lisp_Vector *next;
+ struct vectorlike_header header;
/* Depth of this sub char-table. It should be 1, 2, or 3. A sub
char-table of depth 1 contains 16 elements, and each element
/* A boolvector is a kind of vectorlike, with contents are like a string. */
struct Lisp_Bool_Vector
{
- /* This is the vector's size field. It doesn't have the real size,
+ /* HEADER.SIZE is the vector's size field. It doesn't have the real size,
just the subtype information. */
- EMACS_UINT vector_size;
- struct Lisp_Vector *next;
+ struct vectorlike_header header;
/* This is the size in bits. */
EMACS_UINT size;
/* This contains the actual bits, packed into bytes. */
This type is treated in most respects as a pseudovector,
but since we never dynamically allocate or free them,
- we don't need a next-vector field. */
+ we don't need a struct vectorlike_header and its 'next' field. */
struct Lisp_Subr
{
struct Lisp_Hash_Table
{
- /* Vector fields. The hash table code doesn't refer to these. */
- EMACS_UINT size;
- struct Lisp_Vector *vec_next;
+ /* This is for Lisp; the hash table code does not refer to it. */
+ struct vectorlike_header header;
/* Function used to compare keys. */
Lisp_Object test;
/* Value is the size of hash table H. */
-#define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size
+#define HASH_TABLE_SIZE(H) ASIZE ((H)->next)
/* Default size for hash tables if not specified. */
#define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
#define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
-#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
+#define VECTORP(x) (VECTORLIKEP (x) && !(ASIZE (x) & PSEUDOVECTOR_FLAG))
#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
#define BUFFER_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Buffer_Obj)
#define KBOARD_OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Kboard_Obj)
-/* True if object X is a pseudovector whose code is CODE. */
+/* True if object X is a pseudovector whose code is CODE. The cast to struct
+ vectorlike_header * avoids aliasing issues. */
#define PSEUDOVECTORP(x, code) \
+ TYPED_PSEUDOVECTORP(x, vectorlike_header, code)
+
+/* True if object X, with internal type struct T *, is a pseudovector whose
+ code is CODE. */
+#define TYPED_PSEUDOVECTORP(x, t, code) \
(VECTORLIKEP (x) \
- && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \
+ && (((((struct t *) XPNTR (x))->size \
+ & (PSEUDOVECTOR_FLAG | (code)))) \
== (PSEUDOVECTOR_FLAG | (code))))
/* Test for specific pseudovector types. */
#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
+/* SUBRP is special since Lisp_Subr lacks struct vectorlike_header. */
+#define SUBRP(x) TYPED_PSEUDOVECTORP (x, Lisp_Subr, PVEC_SUBR)
#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
XSETCDR ((x), tmp); \
} while (0)
-/* Cast pointers to this type to compare them. Some machines want int. */
-#define PNTR_COMPARISON_TYPE EMACS_UINT
+/* Cast pointers to this type to compare them. */
+#define PNTR_COMPARISON_TYPE EMACS_UINTPTR
\f
/* Define a built-in function for calling from Lisp.
`lname' should be the name to give the function in Lisp,
`doc' is documentation for the user. */
/* This version of DEFUN declares a function prototype with the right
- arguments, so we can catch errors with maxargs at compile-time.
- DEFUN defines an internal function, and DEFUE is similar but defines a
- external function, which can be used in other C-language modules. */
-#define DEFUN static DEFINE_FUNC
-#define DEFUE extern DEFINE_FUNC
-#define DEFINE_FUNC(lname, fnname, sname, minargs, maxargs, intspec, doc) \
+ arguments, so we can catch errors with maxargs at compile-time. */
+#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
static DECL_ALIGN (struct Lisp_Subr, sname) = \
{ PVEC_SUBR | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)), \
appropriate prototype. */
#define EXFUN(fnname, maxargs) \
extern Lisp_Object fnname DEFUN_ARGS_ ## maxargs
-#define INFUN(fnname, maxargs) \
- static Lisp_Object fnname DEFUN_ARGS_ ## maxargs
/* Forward declarations for prototypes. */
struct window;
extern void buffer_memory_full (void) NO_RETURN;
extern int survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
+#if defined REL_ALLOC && !defined SYSTEM_MALLOC
extern void refill_memory_reserve (void);
+#endif
extern const char *pending_malloc_warning;
extern Lisp_Object *stack_base;
EXFUN (Fcons, 2);
/* Defined in print.c */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
-extern void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
EXFUN (Fprin1, 2);
EXFUN (Fprin1_to_string, 2);
-EXFUN (Fprinc, 2);
EXFUN (Fterpri, 1);
EXFUN (Fprint, 2);
EXFUN (Ferror_message_string, 1);
extern Lisp_Object Qstandard_output;
extern Lisp_Object Qexternal_debugging_output;
-extern void debug_output_compilation_hack (int);
extern void temp_output_buffer_setup (const char *);
extern int print_level;
extern Lisp_Object Qprint_escape_newlines;
extern void float_to_string (char *, double);
extern void syms_of_print (void);
+/* Defined in doprnt.c */
+extern size_t doprnt (char *, size_t, const char *, const char *, va_list);
+
/* Defined in lread.c. */
extern Lisp_Object Qvariable_documentation, Qstandard_input;
extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
} while (0)
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object *, Lisp_Object);
-extern int isfloat_string (const char *, int);
+Lisp_Object string_to_number (char const *, int, int);
extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
Lisp_Object);
extern void dir_warning (const char *, Lisp_Object);
/* Defined in eval.c. */
extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qclosure;
+extern Lisp_Object Qinhibit_quit, Qclosure, Qdebug;
extern Lisp_Object Qand_rest;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vsignaling_function;
extern void clear_charpos_cache (struct buffer *);
extern EMACS_INT charpos_to_bytepos (EMACS_INT);
extern EMACS_INT buf_charpos_to_bytepos (struct buffer *, EMACS_INT);
-extern EMACS_INT verify_bytepos (EMACS_INT charpos) EXTERNALLY_VISIBLE;
extern EMACS_INT buf_bytepos_to_charpos (struct buffer *, EMACS_INT);
extern void unchain_marker (struct Lisp_Marker *marker);
extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT);
extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object,
EMACS_INT, EMACS_INT);
-extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
extern void syms_of_marker (void);
/* Defined in fileio.c */
/* Nonzero means that a filter or a sentinel is running. */
extern int running_asynch_code;
-/* Defined in process.c */
+/* Defined in process.c. */
extern Lisp_Object QCtype, Qlocal;
EXFUN (Fget_buffer_process, 1);
EXFUN (Fprocess_status, 1);
EXFUN (Fkill_process, 2);
EXFUN (Fwaiting_for_user_input_p, 0);
+extern Lisp_Object Qprocessp;
extern void kill_buffer_processes (Lisp_Object);
extern int wait_reading_process_output (int, int, int, int,
Lisp_Object,
extern void child_setup_tty (int);
extern void setup_pty (int);
extern int set_window_size (int, int, int);
-extern void create_process (Lisp_Object, char **, Lisp_Object);
-extern long get_random (void);
+extern EMACS_INT get_random (void);
extern void seed_random (long);
extern int emacs_open (const char *, int, int);
extern int emacs_close (int);
-extern int emacs_read (int, char *, unsigned int);
-extern int emacs_write (int, const char *, unsigned int);
+extern EMACS_INT emacs_read (int, char *, EMACS_INT);
+extern EMACS_INT emacs_write (int, const char *, EMACS_INT);
enum { READLINK_BUFSIZE = 1024 };
extern char *emacs_readlink (const char *, char [READLINK_BUFSIZE]);
#ifndef HAVE_MEMSET
HCoop / bpt / emacs.git / blobdiff