Check for overflow when converting integer to cons and back.
[bpt/emacs.git] / src / lisp.h
index 76938a4..1c1e3ec 100644 (file)
@@ -24,6 +24,8 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #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.  */
 
@@ -34,9 +36,13 @@ extern void check_cons_list (void);
 #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.  */
 #ifndef EMACS_INT
-# if BITS_PER_LONG < BITS_PER_LONG_LONG
+# 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"
@@ -313,7 +319,7 @@ Lisp_Object;
 #endif /* WORDS_BIGENDIAN */
 
 #ifdef __GNUC__
-static __inline__ Lisp_Object
+static inline Lisp_Object
 LISP_MAKE_RVALUE (Lisp_Object o)
 {
     return o;
@@ -466,8 +472,8 @@ enum pvec_type
 
 #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
 
@@ -521,30 +527,27 @@ extern Lisp_Object make_number (EMACS_INT);
 
 #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.  */
 
@@ -762,6 +765,12 @@ extern EMACS_INT string_bytes (struct Lisp_String *);
 
 #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))  \
@@ -1176,7 +1185,7 @@ struct Lisp_Hash_Table
      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.
@@ -1188,11 +1197,12 @@ struct Lisp_Hash_Table
   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);
 };
 
 
@@ -2090,7 +2100,7 @@ extern Lisp_Object Vascii_canon_table;
 \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;
 
@@ -2400,9 +2410,35 @@ EXFUN (Fadd1, 1);
 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;
@@ -2465,19 +2501,19 @@ extern void syms_of_syntax (void);
 
 /* 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);
@@ -2570,7 +2606,6 @@ extern void move_gap_both (EMACS_INT, EMACS_INT);
 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 *,
@@ -2683,8 +2718,8 @@ extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
 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
@@ -2706,6 +2741,7 @@ EXFUN (Fmake_vector, 2);
 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);
@@ -2833,7 +2869,7 @@ extern void syms_of_lread (void);
 
 /* 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;
@@ -3349,6 +3385,7 @@ extern void reset_sys_modes (struct tty_display_info *);
 extern void init_all_sys_modes (void);
 extern void reset_all_sys_modes (void);
 extern void wait_for_termination (int);
+extern void interruptible_wait_for_termination (int);
 extern void flush_pending_output (int);
 extern void child_setup_tty (int);
 extern void setup_pty (int);