2011-06-03 Paul Eggert <eggert@cs.ucla.edu>
+ Check for overflow when converting integer to cons and back.
+ * charset.c (Fdefine_charset_internal, Fdecode_char):
+ Use cons_to_unsigned to catch overflow.
+ (Fencode_char): Use INTEGER_TO_CONS.
+ * composite.h (LGLYPH_CODE): Use cons_to_unsigned.
+ (LGLYPH_SET_CODE): Use INTEGER_TO_CONS.
+ * data.c (long_to_cons, cons_to_long): Remove.
+ (cons_to_unsigned, cons_to_signed): New functions.
+ These signal an error for invalid or out-of-range values.
+ * dired.c (Ffile_attributes): Use INTEGER_TO_CONS.
+ * fileio.c (Fset_visited_file_modtime): Use CONS_TO_INTEGER.
+ * font.c (Ffont_variation_glyphs):
+ * fontset.c (Finternal_char_font): Use INTEGER_TO_CONS.
+ * lisp.h (INTEGER_TO_CONS, CONS_TO_INTEGER): New macros.
+ (cons_to_signed, cons_to_unsigned): New decls.
+ (long_to_cons, cons_to_long): Remove decls.
+ * undo.c (record_first_change): Use INTEGER_TO_CONS.
+ (Fprimitive_undo): Use CONS_TO_INTEGER.
+ * xfns.c (Fx_window_property): Likewise.
+ * xselect.c (x_own_selection, selection_data_to_lisp_data):
+ Use INTEGER_TO_CONS.
+ (x_handle_selection_request, x_handle_selection_clear)
+ (x_get_foreign_selection, Fx_disown_selection_internal)
+ (Fx_get_atom_name, x_send_client_event): Use CONS_TO_INTEGER.
+ (lisp_data_to_selection_data): Use cons_to_unsigned.
+ (x_fill_property_data): Use cons_to_signed. Report values out of range.
+
Fix doc for machines with wider system times such as time_t.
On such machines, it's now safe to assume that EMACS_INT is as
wide as the system times, so that shifting right by 16 will
val = args[charset_arg_min_code];
if (! NILP (val))
{
- unsigned code;
+ unsigned code = cons_to_unsigned (val, UINT_MAX);
- if (INTEGERP (val))
- code = XINT (val);
- else
- {
- CHECK_CONS (val);
- CHECK_NUMBER_CAR (val);
- CHECK_NUMBER_CDR (val);
- code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
- }
if (code < charset.min_code
|| code > charset.max_code)
args_out_of_range_3 (make_number (charset.min_code),
val = args[charset_arg_max_code];
if (! NILP (val))
{
- unsigned code;
+ unsigned code = cons_to_unsigned (val, UINT_MAX);
- if (INTEGERP (val))
- code = XINT (val);
- else
- {
- CHECK_CONS (val);
- CHECK_NUMBER_CAR (val);
- CHECK_NUMBER_CDR (val);
- code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
- }
if (code < charset.min_code
|| code > charset.max_code)
args_out_of_range_3 (make_number (charset.min_code),
struct charset *charsetp;
CHECK_CHARSET_GET_ID (charset, id);
- if (CONSP (code_point))
- {
- CHECK_NATNUM_CAR (code_point);
- CHECK_NATNUM_CDR (code_point);
- code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point)));
- }
- else
- {
- CHECK_NATNUM (code_point);
- code = XINT (code_point);
- }
+ code = cons_to_unsigned (code_point, UINT_MAX);
charsetp = CHARSET_FROM_ID (id);
c = DECODE_CHAR (charsetp, code);
return (c >= 0 ? make_number (c) : Qnil);
code = ENCODE_CHAR (charsetp, XINT (ch));
if (code == CHARSET_INVALID_CODE (charsetp))
return Qnil;
- if (code > 0x7FFFFFF)
- return Fcons (make_number (code >> 16), make_number (code & 0xFFFF));
- return make_number (code);
+ return INTEGER_TO_CONS (code);
}
#define LGLYPH_CODE(g) \
(NILP (AREF ((g), LGLYPH_IX_CODE)) \
? FONT_INVALID_CODE \
- : CONSP (AREF ((g), LGLYPH_IX_CODE)) \
- ? ((XFASTINT (XCAR (AREF ((g), LGLYPH_IX_CODE))) << 16) \
- | (XFASTINT (XCDR (AREF ((g), LGLYPH_IX_CODE))))) \
- : XFASTINT (AREF ((g), LGLYPH_IX_CODE)))
+ : cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned)))
#define LGLYPH_WIDTH(g) XINT (AREF ((g), LGLYPH_IX_WIDTH))
#define LGLYPH_LBEARING(g) XINT (AREF ((g), LGLYPH_IX_LBEARING))
#define LGLYPH_RBEARING(g) XINT (AREF ((g), LGLYPH_IX_RBEARING))
#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_number (val))
/* Callers must assure that VAL is not negative! */
#define LGLYPH_SET_CODE(g, val) \
- do { \
- if (val == FONT_INVALID_CODE) \
- ASET ((g), LGLYPH_IX_CODE, Qnil); \
- else if ((EMACS_INT)val > MOST_POSITIVE_FIXNUM) \
- ASET ((g), LGLYPH_IX_CODE, Fcons (make_number ((val) >> 16), \
- make_number ((val) & 0xFFFF))); \
- else \
- ASET ((g), LGLYPH_IX_CODE, make_number (val)); \
- } while (0)
+ ASET (g, LGLYPH_IX_CODE, \
+ val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val))
#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_number (val))
#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_number (val))
return Qnil;
}
\f
-/* Convert between long values and pairs of Lisp integers.
- Note that long_to_cons returns a single Lisp integer
- when the value fits in one. */
+/* Convert the cons-of-integers, integer, or float value C to an
+ unsigned value with maximum value MAX. Signal an error if C does not
+ have a valid format or is out of range. */
+uintmax_t
+cons_to_unsigned (Lisp_Object c, uintmax_t max)
+{
+ int valid = 0;
+ uintmax_t val IF_LINT (= 0);
+ if (INTEGERP (c))
+ {
+ valid = 0 <= XINT (c);
+ val = XINT (c);
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (0 <= d
+ && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c))
+ {
+ Lisp_Object top = XCAR (c);
+ Lisp_Object bot = XCDR (c);
+ if (CONSP (bot))
+ bot = XCAR (bot);
+ if (NATNUMP (top) && XFASTINT (top) <= UINTMAX_MAX >> 16 && NATNUMP (bot))
+ {
+ uintmax_t utop = XFASTINT (top);
+ val = (utop << 16) | XFASTINT (bot);
+ valid = 1;
+ }
+ }
-Lisp_Object
-long_to_cons (long unsigned int i)
-{
- unsigned long top = i >> 16;
- unsigned int bot = i & 0xFFFF;
- if (top == 0)
- return make_number (bot);
- if (top == (unsigned long)-1 >> 16)
- return Fcons (make_number (-1), make_number (bot));
- return Fcons (make_number (top), make_number (bot));
+ if (! (valid && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
-unsigned long
-cons_to_long (Lisp_Object c)
+/* Convert the cons-of-integers, integer, or float value C to a signed
+ value with extrema MIN and MAX. Signal an error if C does not have
+ a valid format or is out of range. */
+intmax_t
+cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
- Lisp_Object top, bot;
+ int valid = 0;
+ intmax_t val IF_LINT (= 0);
if (INTEGERP (c))
- return XINT (c);
- top = XCAR (c);
- bot = XCDR (c);
- if (CONSP (bot))
- bot = XCAR (bot);
- return ((XINT (top) << 16) | XINT (bot));
+ {
+ val = XINT (c);
+ valid = 1;
+ }
+ else if (FLOATP (c))
+ {
+ double d = XFLOAT_DATA (c);
+ if (min <= d
+ && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1))
+ {
+ val = d;
+ valid = 1;
+ }
+ }
+ else if (CONSP (c))
+ {
+ Lisp_Object top = XCAR (c);
+ Lisp_Object bot = XCDR (c);
+ if (CONSP (bot))
+ bot = XCAR (bot);
+ if (INTEGERP (top) && INTMAX_MIN >> 16 <= XINT (top)
+ && XINT (top) <= INTMAX_MAX >> 16 && INTEGERP (bot))
+ {
+ intmax_t itop = XINT (top);
+ val = (itop << 16) | XINT (bot);
+ valid = 1;
+ }
+ }
+
+ if (! (valid && min <= val && val <= max))
+ error ("Not an in-range integer, float, or cons of integers");
+ return val;
}
\f
DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
This is a floating point number if the size is too large for an integer.
8. File modes, as a string of ten letters or dashes as in ls -l.
9. t if file's gid would change if file were deleted and recreated.
-10. inode number. If inode number is larger than what Emacs integer
- can hold, but all but the bottom 16 bits still fits, this is a cons cell
- containing two integers: first the high part, then the low 16 bits.
- If the inode number is still wider, this is of the form
- (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
- and finally the low 16 bits.
+10. inode number. If it is larger than what the Emacs integer
+ can hold, this is a cons cell containing two integers: first the
+ high part, then the low 16 bits.
11. Filesystem device number. If it is larger than what the Emacs
integer can hold, this is a cons cell, similar to the inode number.
#else /* file gid will be egid */
values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
#endif /* not BSD4_2 */
- if (!FIXNUM_OVERFLOW_P (s.st_ino))
- /* Keep the most common cases as integers. */
- values[10] = make_number (s.st_ino);
- else if (!FIXNUM_OVERFLOW_P (s.st_ino >> 16))
- /* To allow inode numbers larger than VALBITS, separate the bottom
- 16 bits. */
- values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)),
- make_number ((EMACS_INT)(s.st_ino & 0xffff)));
- else
- {
- /* To allow inode numbers beyond what INTEGER_TO_CONS can handle,
- separate into 2 24-bit high parts and a 16-bit bottom part.
- The code on the next line avoids a compiler warning on
- systems where st_ino is 32 bit wide. (bug#766). */
- EMACS_INT high_ino = s.st_ino >> 31 >> 1;
-
- values[10] = Fcons (make_number (high_ino >> 8),
- Fcons (make_number (((high_ino & 0xff) << 16)
- + (s.st_ino >> 16 & 0xffff)),
- make_number (s.st_ino & 0xffff)));
- }
-
- /* Likewise for device. */
- if (FIXNUM_OVERFLOW_P (s.st_dev))
- values[11] = Fcons (make_number (s.st_dev >> 16),
- make_number (s.st_dev & 0xffff));
- else
- values[11] = make_number (s.st_dev);
+ values[10] = INTEGER_TO_CONS (s.st_ino);
+ values[11] = INTEGER_TO_CONS (s.st_dev);
return Flist (sizeof(values) / sizeof(values[0]), values);
}
{
if (!NILP (time_list))
{
- current_buffer->modtime = cons_to_long (time_list);
+ CONS_TO_INTEGER (time_list, time_t, current_buffer->modtime);
current_buffer->modtime_size = -1;
}
else
for (i = 0; i < 255; i++)
if (variations[i])
{
- Lisp_Object code;
int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
- /* Stops GCC whining about limited range of data type. */
- EMACS_INT var = variations[i];
-
- if (var > MOST_POSITIVE_FIXNUM)
- code = Fcons (make_number ((variations[i]) >> 16),
- make_number ((variations[i]) & 0xFFFF));
- else
- code = make_number (variations[i]);
+ Lisp_Object code = INTEGER_TO_CONS (variations[i]);
val = Fcons (Fcons (make_number (vs), code), val);
}
return val;
{
unsigned code = face->font->driver->encode_char (face->font, c);
Lisp_Object font_object;
- /* Assignment to EMACS_INT stops GCC whining about limited range
- of data type. */
- EMACS_INT cod = code;
if (code == FONT_INVALID_CODE)
return Qnil;
XSETFONT (font_object, face->font);
- if (cod <= MOST_POSITIVE_FIXNUM)
- return Fcons (font_object, make_number (code));
- return Fcons (font_object, Fcons (make_number (code >> 16),
- make_number (code & 0xFFFF)));
+ return Fcons (font_object, INTEGER_TO_CONS (code));
}
return Qnil;
}
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 integers, or if all else fails a float.
+ The float might lose information; this happens only in extreme cases
+ such as 32-bit EMACS_INT and 64-bit time_t with outlandish time values,
+ and these aren't worth complicating the interface.
+
+ 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)) \
+ : 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;
void
record_first_change (void)
{
- Lisp_Object high, low;
struct buffer *base_buffer = current_buffer;
if (EQ (BVAR (current_buffer, undo_list), Qt))
if (base_buffer->base_buffer)
base_buffer = base_buffer->base_buffer;
- XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
- XSETFASTINT (low, base_buffer->modtime & 0xffff);
- BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list));
+ BVAR (current_buffer, undo_list) =
+ Fcons (Fcons (Qt, INTEGER_TO_CONS (base_buffer->modtime)),
+ BVAR (current_buffer, undo_list));
}
/* Record a change in property PROP (whose old value was VAL)
if (EQ (car, Qt))
{
/* Element (t high . low) records previous modtime. */
- Lisp_Object high, low;
- time_t mod_time;
struct buffer *base_buffer = current_buffer;
-
- high = Fcar (cdr);
- low = Fcdr (cdr);
- mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
+ time_t mod_time;
+ CONS_TO_INTEGER (cdr, time_t, mod_time);
if (current_buffer->base_buffer)
base_buffer = current_buffer->base_buffer;
if (! NILP (source))
{
- if (NUMBERP (source))
- {
- if (FLOATP (source))
- target_window = (Window) XFLOAT (source);
- else
- target_window = XFASTINT (source);
-
- if (target_window == 0)
- target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
- }
- else if (CONSP (source))
- target_window = cons_to_long (source);
+ CONS_TO_INTEGER (source, Window, target_window);
+ if (! target_window)
+ target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
}
BLOCK_INPUT;
Lisp_Object prev_value;
selection_data = list4 (selection_name, selection_value,
- long_to_cons (timestamp), frame);
+ INTEGER_TO_CONS (timestamp), frame);
prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
dpyinfo->terminal->Vselection_alist
|| INTEGERP (check)
|| NILP (value))
return value;
- /* Check for a value that cons_to_long could handle. */
+ /* Check for a value that CONS_TO_INTEGER could handle. */
else if (CONSP (check)
&& INTEGERP (XCAR (check))
&& (INTEGERP (XCDR (check))
if (NILP (local_selection_data)) goto DONE;
/* Decline requests issued prior to our acquiring the selection. */
- local_selection_time
- = (Time) cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
+ CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
+ Time, local_selection_time);
if (SELECTION_EVENT_TIME (event) != CurrentTime
&& local_selection_time > SELECTION_EVENT_TIME (event))
goto DONE;
/* Well, we already believe that we don't own it, so that's just fine. */
if (NILP (local_selection_data)) return;
- local_selection_time = (Time)
- cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
+ CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
+ Time, local_selection_time);
/* We have reasserted the selection since this SelectionClear was
generated, so we can disregard it. */
return Qnil;
if (! NILP (time_stamp))
- {
- if (CONSP (time_stamp))
- requestor_time = (Time) cons_to_long (time_stamp);
- else if (INTEGERP (time_stamp))
- requestor_time = (Time) XUINT (time_stamp);
- else if (FLOATP (time_stamp))
- requestor_time = (Time) XFLOAT_DATA (time_stamp);
- else
- error ("TIME_STAMP must be cons or number");
- }
+ CONS_TO_INTEGER (time_stamp, Time, requestor_time);
BLOCK_INPUT;
convert it to a cons of integers, 16 bits in each half.
*/
else if (format == 32 && size == sizeof (unsigned int))
- return long_to_cons (((unsigned int *) data) [0]);
+ return INTEGER_TO_CONS (((unsigned int *) data) [0]);
else if (format == 16 && size == sizeof (unsigned short))
return make_number ((int) (((unsigned short *) data) [0]));
for (i = 0; i < size / 4; i++)
{
unsigned int j = ((unsigned int *) data) [i];
- Faset (v, make_number (i), long_to_cons (j));
+ Faset (v, make_number (i), INTEGER_TO_CONS (j));
}
return v;
}
*size_ret = 1;
*data_ret = (unsigned char *) xmalloc (sizeof (unsigned long) + 1);
(*data_ret) [sizeof (unsigned long)] = 0;
- (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
+ (*(unsigned long **) data_ret) [0] = cons_to_unsigned (obj, ULONG_MAX);
if (NILP (type)) type = QINTEGER;
}
else if (VECTORP (obj))
*data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
for (i = 0; i < *size_ret; i++)
if (*format_ret == 32)
- (*((unsigned long **) data_ret)) [i]
- = cons_to_long (XVECTOR (obj)->contents [i]);
+ (*((unsigned long **) data_ret)) [i] =
+ cons_to_unsigned (XVECTOR (obj)->contents [i], ULONG_MAX);
else
- (*((unsigned short **) data_ret)) [i]
- = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
+ (*((unsigned short **) data_ret)) [i] =
+ cons_to_unsigned (XVECTOR (obj)->contents [i], USHRT_MAX);
}
}
else
selection_atom = symbol_to_x_atom (dpyinfo, selection);
BLOCK_INPUT;
- timestamp = (NILP (time_object) ? last_event_timestamp
- : cons_to_long (time_object));
+ if (NILP (time_object))
+ timestamp = last_event_timestamp;
+ else
+ CONS_TO_INTEGER (time_object, Time, timestamp);
XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
UNBLOCK_INPUT;
{
Lisp_Object o = XCAR (iter);
- if (INTEGERP (o))
- val = (long) XFASTINT (o);
- else if (FLOATP (o))
- val = (long) XFLOAT_DATA (o);
- else if (CONSP (o))
- val = (long) cons_to_long (o);
+ if (INTEGERP (o) || FLOATP (o) || CONSP (o))
+ val = cons_to_signed (o, LONG_MIN, LONG_MAX);
else if (STRINGP (o))
{
BLOCK_INPUT;
error ("Wrong type, must be string, number or cons");
if (format == 8)
- *d08++ = (char) val;
+ {
+ if (CHAR_MIN <= val && val <= CHAR_MAX)
+ *d08++ = val;
+ else
+ error ("Out of 'char' range");
+ }
else if (format == 16)
- *d16++ = (short) val;
+ {
+ if (SHRT_MIN <= val && val <= SHRT_MAX)
+ *d16++ = val;
+ else
+ error ("Out of 'short' range");
+ }
else
*d32++ = val;
}
Atom atom;
int had_errors;
- if (INTEGERP (value))
- atom = (Atom) XUINT (value);
- else if (FLOATP (value))
- atom = (Atom) XFLOAT_DATA (value);
- else if (CONSP (value))
- atom = (Atom) cons_to_long (value);
- else
- error ("Wrong type, value must be number or cons");
+ CONS_TO_INTEGER (value, Atom, atom);
BLOCK_INPUT;
x_catch_errors (dpy);
else
error ("DEST as a string must be one of PointerWindow or InputFocus");
}
- else if (INTEGERP (dest))
- wdest = (Window) XFASTINT (dest);
- else if (FLOATP (dest))
- wdest = (Window) XFLOAT_DATA (dest);
- else if (CONSP (dest))
- {
- if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
- error ("Both car and cdr for DEST must be numbers");
- else
- wdest = (Window) cons_to_long (dest);
- }
+ else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest))
+ CONS_TO_INTEGER (dest, Window, wdest);
else
error ("DEST must be a frame, nil, string, number or cons");