]> code.delx.au - gnu-emacs/blobdiff - src/data.c
Update copyright year to 2016
[gnu-emacs] / src / data.c
index ccec15f430a5008e843454efc9a7b7263b80da26..07f872419175822bc9441737ae24d697faa172bd 100644 (file)
@@ -1,5 +1,5 @@
 /* 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.
@@ -223,6 +223,10 @@ for example, (type-of 1) returns `integer'.  */)
           return Qfloat;
         case Lisp_Misc_Finalizer:
           return Qfinalizer;
+#ifdef HAVE_MODULES
+       case Lisp_Misc_User_Ptr:
+         return Quser_ptr;
+#endif
        default:
          emacs_abort ();
        }
@@ -424,6 +428,17 @@ DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0,
   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)
@@ -2409,6 +2424,33 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
   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.  */
@@ -3451,6 +3493,9 @@ syms_of_data (void)
   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");
@@ -3542,6 +3587,9 @@ syms_of_data (void)
   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");
@@ -3656,6 +3704,9 @@ syms_of_data (void)
   defsubr (&Sbyteorder);
   defsubr (&Ssubr_arity);
   defsubr (&Ssubr_name);
+#ifdef HAVE_MODULES
+  defsubr (&Suser_ptrp);
+#endif
 
   defsubr (&Sbool_vector_exclusive_or);
   defsubr (&Sbool_vector_union);