/* 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 *,
}
DEFUN ("null", Fnull, Snull, 1, 1, 0,
- doc: /* Return t if OBJECT is nil. */
+ doc: /* Return t if OBJECT is nil, and return nil otherwise. */
attributes: const)
(Lisp_Object object)
{
return Qfloat;
case Lisp_Misc_Finalizer:
return Qfinalizer;
+#ifdef HAVE_MODULES
+ case Lisp_Misc_User_Ptr:
+ return Quser_ptr;
+#endif
+ default:
+ emacs_abort ();
}
- emacs_abort ();
case Lisp_Vectorlike:
if (WINDOW_CONFIGURATIONP (object))
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)
(register Lisp_Object cell, Lisp_Object newcar)
{
CHECK_CONS (cell);
- CHECK_IMPURE (cell);
+ CHECK_IMPURE (cell, XCONS (cell));
XSETCAR (cell, newcar);
return newcar;
}
(register Lisp_Object cell, Lisp_Object newcdr)
{
CHECK_CONS (cell);
- CHECK_IMPURE (cell);
+ CHECK_IMPURE (cell, XCONS (cell));
XSETCDR (cell, newcdr);
return newcdr;
}
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
doc: /* Return the interactive form of CMD or nil if none.
If CMD is not a command, the return value is nil.
-Value, if non-nil, is a list \(interactive SPEC). */)
+Value, if non-nil, is a list (interactive SPEC). */)
(Lisp_Object cmd)
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
return;
}
+ maybe_set_redisplay (symbol);
sym = XSYMBOL (symbol);
start:
(Lisp_Object args)
{
Lisp_Object args_left, symbol, val;
- struct gcpro gcpro1;
args_left = val = args;
- GCPRO1 (args);
while (CONSP (args_left))
{
args_left = Fcdr (XCDR (args_left));
}
- UNGCPRO;
return val;
}
\f
1, 1, "vMake Local Variable: ",
doc: /* Make VARIABLE have a separate value in the current buffer.
Other buffers will continue to share a common default value.
-\(The buffer-local value of VARIABLE starts out as the same value
-VARIABLE previously had. If VARIABLE was void, it remains void.\)
+(The buffer-local value of VARIABLE starts out as the same value
+VARIABLE previously had. If VARIABLE was void, it remains void.)
Return VARIABLE.
If the variable is already arranged to become local when set,
just as setting the variable would do.
This function returns VARIABLE, and therefore
- (set (make-local-variable 'VARIABLE) VALUE-EXP)
+ (set (make-local-variable \\='VARIABLE) VALUE-EXP)
works.
See also `make-variable-buffer-local'.
CHECK_NUMBER (idx);
idxval = XINT (idx);
CHECK_ARRAY (array, Qarrayp);
- CHECK_IMPURE (array);
if (VECTORP (array))
{
+ CHECK_IMPURE (array, XVECTOR (array));
if (idxval < 0 || idxval >= ASIZE (array))
args_out_of_range (array, idx);
ASET (array, idxval, newelt);
{
int c;
+ CHECK_IMPURE (array, XSTRING (array));
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
CHECK_CHARACTER (newelt);
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. */
accum = 0;
break;
case Amult:
+ case Adiv:
accum = 1;
break;
case Alogand:
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)
+ if (! (argnum || nargs == 1))
accum = next;
else
{
if (next == 0)
xsignal0 (Qarith_error);
- accum /= next;
+ if (INT_DIVIDE_OVERFLOW (accum, next))
+ overflow = true;
+ else
+ accum /= next;
}
break;
case Alogand:
accum *= next;
break;
case Adiv:
- if (!argnum)
+ if (! (argnum || nargs == 1))
accum = next;
else
{
}
DEFUN ("/", Fquo, Squo, 1, MANY, 0,
- doc: /* Return first argument divided by all the remaining arguments.
+ doc: /* Divide number by divisors and return the result.
+With two or more arguments, return first argument divided by the rest.
+With one argument, return 1 divided by the argument.
The arguments must be numbers or markers.
-usage: (/ DIVIDEND &rest DIVISORS) */)
+usage: (/ NUMBER &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
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);