#include <stdarg.h>
#include <stddef.h>
+#include <inttypes.h>
+
+#include <intprops.h>
/* Use the configure flag --enable-checking[=LIST] to enable various
types of run time checks for Lisp objects. */
#define CHECK_CONS_LIST() ((void) 0)
#endif
+/* Temporarily disable wider-than-pointer integers until they're tested more.
+ Build with CFLAGS='-DWIDE_EMACS_INT' to try them out. */
+/* #undef WIDE_EMACS_INT */
+
/* These are default choices for the types to use. */
-#ifdef _LP64
#ifndef EMACS_INT
-#define EMACS_INT long
-#define BITS_PER_EMACS_INT BITS_PER_LONG
-#define pI "l"
-#endif
-#ifndef EMACS_UINT
-#define EMACS_UINT unsigned long
-#endif
-#else /* not _LP64 */
-#ifndef EMACS_INT
-#define EMACS_INT int
-#define BITS_PER_EMACS_INT BITS_PER_INT
-#define pI ""
+# if BITS_PER_LONG < BITS_PER_LONG_LONG && defined WIDE_EMACS_INT
+# define EMACS_INT long long
+# define BITS_PER_EMACS_INT BITS_PER_LONG_LONG
+# define pI "ll"
+# elif BITS_PER_INT < BITS_PER_LONG
+# define EMACS_INT long
+# define BITS_PER_EMACS_INT BITS_PER_LONG
+# define pI "l"
+# else
+# define EMACS_INT int
+# define BITS_PER_EMACS_INT BITS_PER_INT
+# define pI ""
+# endif
#endif
#ifndef EMACS_UINT
-#define EMACS_UINT unsigned int
-#endif
+# define EMACS_UINT unsigned EMACS_INT
#endif
/* Extra internal type checking? */
#endif /* WORDS_BIGENDIAN */
#ifdef __GNUC__
-static __inline__ Lisp_Object
+static inline Lisp_Object
LISP_MAKE_RVALUE (Lisp_Object o)
{
return o;
#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 ((intptr_t) (ptr)) == 0), /* Check alignment. */ \
+ (var) = (type) | (intptr_t) (ptr))
-#define XPNTR(a) ((EMACS_INT) ((a) & ~TYPEMASK))
+#define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK))
#else /* not USE_LSB_TAG */
#define XSET(var, type, ptr) \
((var) = ((EMACS_INT) ((EMACS_UINT) (type) << VALBITS) \
- + ((EMACS_INT) (ptr) & VALMASK)))
+ + ((intptr_t) (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) ((uintptr_t) (((a) & VALMASK)) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_UINT) ((a) & VALMASK))
+#define XPNTR(a) ((uintptr_t) ((a) & VALMASK))
#endif
#endif /* not USE_LSB_TAG */
#define XHASH(a) ((a).i)
#define XTYPE(a) ((enum Lisp_Type) (a).u.type)
-#define XINT(a) ((a).s.val)
-#define XUINT(a) ((a).u.val)
+#define XINT(a) ((EMACS_INT) (a).s.val)
+#define XUINT(a) ((EMACS_UINT) (a).u.val)
#ifdef 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) ((intptr_t) (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) ((intptr_t) (XUINT (a) | DATA_SEG_BITS))
#else
-#define XPNTR(a) ((EMACS_INT) XUINT (a))
+#define XPNTR(a) ((intptr_t) XUINT (a))
#endif
#endif /* !USE_LSB_TAG */
#define EQ(x, y) (XHASH (x) == XHASH (y))
-/* Largest and smallest representable fixnum values. These are the C
- values. */
-
+/* Number of bits in a fixnum, including the sign bit. */
#ifdef USE_2_TAGS_FOR_INTS
-# define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << VALBITS)
-# define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << VALBITS) - 1)
-/* Mask indicating the significant bits of a Lisp_Int.
- I.e. (x & INTMASK) == XUINT (make_number (x)). */
-# define INTMASK ((((EMACS_INT) 1) << (VALBITS + 1)) - 1)
+# define FIXNUM_BITS (VALBITS + 1)
#else
-# define MOST_NEGATIVE_FIXNUM - ((EMACS_INT) 1 << (VALBITS - 1))
-# define MOST_POSITIVE_FIXNUM (((EMACS_INT) 1 << (VALBITS - 1)) - 1)
-/* Mask indicating the significant bits of a Lisp_Int.
- I.e. (x & INTMASK) == XUINT (make_number (x)). */
-# define INTMASK ((((EMACS_INT) 1) << VALBITS) - 1)
+# define FIXNUM_BITS VALBITS
#endif
+/* Mask indicating the significant bits of a fixnum. */
+#define INTMASK (((EMACS_INT) 1 << FIXNUM_BITS) - 1)
+
+/* Largest and smallest representable fixnum values. These are the C
+ values. */
+#define MOST_POSITIVE_FIXNUM (INTMASK / 2)
+#define MOST_NEGATIVE_FIXNUM (-1 - MOST_POSITIVE_FIXNUM)
+
/* Value is non-zero if I doesn't fit into a Lisp fixnum. It is
written this way so that it also works if I is of unsigned
- type. */
+ type or if I is a NaN. */
#define FIXNUM_OVERFLOW_P(i) \
- ((i) > MOST_POSITIVE_FIXNUM \
- || ((i) < 0 && (i) < MOST_NEGATIVE_FIXNUM))
+ (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM))
/* Extract a value or address from a Lisp_Object. */
#endif /* not GC_CHECK_STRING_BYTES */
+/* A string cannot contain more bytes than a fixnum can represent,
+ nor can it be so long that C pointer arithmetic stops working on
+ the string plus a terminating null. */
+#define STRING_BYTES_MAX \
+ min (MOST_POSITIVE_FIXNUM, min (SIZE_MAX, PTRDIFF_MAX) - 1)
+
/* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \
do { if (EQ (STR, empty_multibyte_string)) \
a special way (e.g. because of weakness). */
/* Number of key/value entries in the table. */
- unsigned int count;
+ EMACS_INT count;
/* Vector of keys and values. The key of item I is found at index
2 * I, the value is found at index 2 * I + 1.
struct Lisp_Hash_Table *next_weak;
/* C function to compare two keys. */
- int (* cmpfn) (struct Lisp_Hash_Table *, Lisp_Object,
- unsigned, Lisp_Object, unsigned);
+ int (*cmpfn) (struct Lisp_Hash_Table *,
+ Lisp_Object, EMACS_UINT,
+ Lisp_Object, EMACS_UINT);
/* C function to compute hash code. */
- unsigned (* hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
+ EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
};
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 uintptr_t
\f
/* Define a built-in function for calling from Lisp.
`lname' should be the name to give the function in Lisp,
\f
/* Number of bytes of structure consed since last GC. */
-extern int consing_since_gc;
+extern EMACS_INT consing_since_gc;
extern EMACS_INT gc_relative_threshold;
EXFUN (Fsub1, 1);
EXFUN (Fmake_variable_buffer_local, 1);
+/* Convert the integer I to an Emacs representation, either the integer
+ itself, or a cons of two or three integers, or if all else fails a float.
+ I should not have side effects. */
+#define INTEGER_TO_CONS(i) \
+ (! FIXNUM_OVERFLOW_P (i) \
+ ? make_number (i) \
+ : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16) \
+ || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16)) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16)) \
+ ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
+ : ! ((FIXNUM_OVERFLOW_P (INTMAX_MIN >> 16 >> 24) \
+ || FIXNUM_OVERFLOW_P (UINTMAX_MAX >> 16 >> 24)) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
+ ? Fcons (make_number ((i) >> 16 >> 24), \
+ Fcons (make_number ((i) >> 16 & 0xffffff), \
+ make_number ((i) & 0xffff))) \
+ : make_float (i))
+
+/* Convert the Emacs representation CONS back to an integer of type
+ TYPE, storing the result the variable VAR. Signal an error if CONS
+ is not a valid representation or is out of range for TYPE. */
+#define CONS_TO_INTEGER(cons, type, var) \
+ (TYPE_SIGNED (type) \
+ ? ((var) = cons_to_signed (cons, TYPE_MINIMUM (type), TYPE_MAXIMUM (type))) \
+ : ((var) = cons_to_unsigned (cons, TYPE_MAXIMUM (type))))
+extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
+extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
+
extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
-extern Lisp_Object long_to_cons (unsigned long);
-extern unsigned long cons_to_long (Lisp_Object);
extern void args_out_of_range (Lisp_Object, Lisp_Object) NO_RETURN;
extern void args_out_of_range_3 (Lisp_Object, Lisp_Object,
Lisp_Object) NO_RETURN;
/* Defined in fns.c */
extern Lisp_Object QCrehash_size, QCrehash_threshold;
-extern int next_almost_prime (int);
-extern Lisp_Object larger_vector (Lisp_Object, int, Lisp_Object);
+extern EMACS_INT next_almost_prime (EMACS_INT);
+extern Lisp_Object larger_vector (Lisp_Object, EMACS_INT, Lisp_Object);
extern void sweep_weak_hash_tables (void);
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qstring_lessp;
extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
-unsigned sxhash (Lisp_Object, int);
+EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object);
-int hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, unsigned *);
-int hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
- unsigned);
+EMACS_INT hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
+EMACS_INT hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
+ EMACS_UINT);
void init_weak_hash_tables (void);
extern void init_fns (void);
EXFUN (Fmake_hash_table, MANY);
extern void make_gap (EMACS_INT);
extern EMACS_INT copy_text (const unsigned char *, unsigned char *,
EMACS_INT, int, int);
-extern EMACS_INT count_size_as_multibyte (const unsigned char *, EMACS_INT);
extern int count_combining_before (const unsigned char *,
EMACS_INT, EMACS_INT, EMACS_INT);
extern int count_combining_after (const unsigned char *,
extern void reset_malloc_hooks (void);
extern void uninterrupt_malloc (void);
extern void malloc_warning (const char *);
-extern void memory_full (void) NO_RETURN;
-extern void buffer_memory_full (void) NO_RETURN;
+extern void memory_full (size_t) NO_RETURN;
+extern void buffer_memory_full (EMACS_INT) NO_RETURN;
extern int survives_gc_p (Lisp_Object);
extern void mark_object (Lisp_Object);
#if defined REL_ALLOC && !defined SYSTEM_MALLOC
EXFUN (Fvector, MANY);
EXFUN (Fmake_symbol, 1);
EXFUN (Fmake_marker, 0);
+extern void string_overflow (void) NO_RETURN;
EXFUN (Fmake_string, 2);
extern Lisp_Object build_string (const char *);
extern Lisp_Object make_string (const char *, EMACS_INT);
/* Defined in eval.c. */
extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
-extern Lisp_Object Qinhibit_quit, Qclosure, Qdebug;
+extern Lisp_Object Qinhibit_quit, Qclosure;
extern Lisp_Object Qand_rest;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vsignaling_function;
extern void child_setup_tty (int);
extern void setup_pty (int);
extern int set_window_size (int, int, int);
-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);
HCoop / bpt / emacs.git / blobdiff