/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
+ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
-#include "syssignal.h"
-#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
-#include "font.h"
#include "keymap.h"
static void swap_in_symval_forwarding (struct Lisp_Symbol *,
return Qfloat;
case Lisp_Misc_Finalizer:
return Qfinalizer;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ return Quser_ptr;
+#endif
default:
emacs_abort ();
}
return Qnil;
}
+#ifdef HAVE_MODULES
+DEFUN ("user-ptrp", Fuser_ptrp, Suser_ptrp, 1, 1, 0,
+ doc: /* Return t if OBJECT is a module user pointer. */)
+ (Lisp_Object object)
+{
+ if (USER_PTRP (object))
+ return Qt;
+ return Qnil;
+}
+#endif
+
DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0,
doc: /* Return t if OBJECT is a built-in function. */)
(Lisp_Object object)
return;
}
+ maybe_set_redisplay (symbol);
sym = XSYMBOL (symbol);
start:
return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
\f
+/* Convert the integer I to a cons-of-integers, where I is not in
+ fixnum range. */
+
+#define INTBIG_TO_LISP(i, extremum) \
+ (eassert (FIXNUM_OVERFLOW_P (i)), \
+ (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \
+ && FIXNUM_OVERFLOW_P ((i) >> 16)) \
+ ? Fcons (make_number ((i) >> 16), make_number ((i) & 0xffff)) \
+ : ! (FIXNUM_OVERFLOW_P ((extremum) >> 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)))
+
+Lisp_Object
+intbig_to_lisp (intmax_t i)
+{
+ return INTBIG_TO_LISP (i, INTMAX_MIN);
+}
+
+Lisp_Object
+uintbig_to_lisp (uintmax_t i)
+{
+ return INTBIG_TO_LISP (i, UINTMAX_MAX);
+}
+
/* 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. */
switch (code)
{
case Aadd:
- if (INT_ADD_OVERFLOW (accum, next))
- {
- overflow = 1;
- accum &= INTMASK;
- }
- accum += next;
+ overflow |= INT_ADD_WRAPV (accum, next, &accum);
break;
case Asub:
- if (INT_SUBTRACT_OVERFLOW (accum, next))
- {
- overflow = 1;
- accum &= INTMASK;
- }
- accum = argnum ? accum - next : nargs == 1 ? - next : next;
+ if (! argnum)
+ accum = nargs == 1 ? - next : next;
+ else
+ overflow |= INT_SUBTRACT_WRAPV (accum, next, &accum);
break;
case Amult:
- if (INT_MULTIPLY_OVERFLOW (accum, next))
- {
- EMACS_UINT a = accum, b = next, ab = a * b;
- overflow = 1;
- accum = ab & INTMASK;
- }
- else
- accum *= next;
+ overflow |= INT_MULTIPLY_WRAPV (accum, next, &accum);
break;
case Adiv:
if (! (argnum || nargs == 1))
{
if (next == 0)
xsignal0 (Qarith_error);
- accum /= next;
+ if (INT_DIVIDE_OVERFLOW (accum, next))
+ overflow = true;
+ else
+ accum /= next;
}
break;
case Alogand:
DEFSYM (Qbool_vector_p, "bool-vector-p");
DEFSYM (Qchar_or_string_p, "char-or-string-p");
DEFSYM (Qmarkerp, "markerp");
+#ifdef HAVE_MODULES
+ DEFSYM (Quser_ptrp, "user-ptrp");
+#endif
DEFSYM (Qbuffer_or_string_p, "buffer-or-string-p");
DEFSYM (Qinteger_or_marker_p, "integer-or-marker-p");
DEFSYM (Qfboundp, "fboundp");
DEFSYM (Qmarker, "marker");
DEFSYM (Qoverlay, "overlay");
DEFSYM (Qfinalizer, "finalizer");
+#ifdef HAVE_MODULES
+ DEFSYM (Quser_ptr, "user-ptr");
+#endif
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
defsubr (&Sbyteorder);
defsubr (&Ssubr_arity);
defsubr (&Ssubr_name);
+#ifdef HAVE_MODULES
+ defsubr (&Suser_ptrp);
+#endif
defsubr (&Sbool_vector_exclusive_or);
defsubr (&Sbool_vector_union);