/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
- Copyright (C) 1985, 1986, 1988, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1988, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <signal.h>
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "puresize.h"
#include "syssignal.h"
#ifdef LISP_FLOAT_TYPE
+
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+
+/* Work around a problem that happens because math.h on hpux 7
+ defines two static variables--which, in Emacs, are not really static,
+ because `static' is defined as nothing. The problem is that they are
+ here, in floatfns.c, and in lread.c.
+ These macros prevent the name conflict. */
+#if defined (HPUX) && !defined (HPUX8)
+#define _MAXLDBL data_c_maxldbl
+#define _NMAXLDBL data_c_nmaxldbl
+#endif
+
#include <math.h>
#endif /* LISP_FLOAT_TYPE */
+#if !defined (atof)
+extern double atof ();
+#endif /* !atof */
+
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
-Lisp_Object Qend_of_file, Qarith_error;
+Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive;
Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp;
Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
(EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
return Fstring_to_number (value);
if (XTYPE (value) == Lisp_Int && EQ (predicate, Qstringp))
- return Fint_to_string (value);
+ return Fnumber_to_string (value);
}
value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
tem = call1 (predicate, value);
register Lisp_Object sym, newdef;
{
CHECK_SYMBOL (sym, 0);
+
+ if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
+ Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
+ Vautoload_queue);
+ XSYMBOL (sym)->function = newdef;
+ return newdef;
+}
+
+/* This name should be removed once it is eliminated from elsewhere. */
+
+DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,
+ "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
+Associates the function with the current load file, if any.")
+ (sym, newdef)
+ register Lisp_Object sym, newdef;
+{
+ CHECK_SYMBOL (sym, 0);
+ if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
+ Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
+ Vautoload_queue);
+ XSYMBOL (sym)->function = newdef;
+ LOADHIST_ATTACH (sym);
+ return newdef;
+}
+
+DEFUN ("define-function", Fdefine_function, Sdefine_function, 2, 2, 0,
+ "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\
+Associates the function with the current load file, if any.")
+ (sym, newdef)
+ register Lisp_Object sym, newdef;
+{
+ CHECK_SYMBOL (sym, 0);
if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
Vautoload_queue);
XSYMBOL (sym)->function = newdef;
+ LOADHIST_ATTACH (sym);
return newdef;
}
indirect_function (object)
register Lisp_Object object;
{
- Lisp_Object tortise, hare;
+ Lisp_Object tortoise, hare;
- hare = tortise = object;
+ hare = tortoise = object;
for (;;)
{
break;
hare = XSYMBOL (hare)->function;
- tortise = XSYMBOL (tortise)->function;
+ tortoise = XSYMBOL (tortoise)->function;
- if (EQ (hare, tortise))
+ if (EQ (hare, tortoise))
Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
}
return Qnil;
}
\f
-DEFUN ("int-to-string", Fint_to_string, Sint_to_string, 1, 1, 0,
+/* Convert between 32-bit values and pairs of lispy 24-bit values. */
+
+Lisp_Object
+long_to_cons (i)
+ unsigned long i;
+{
+ unsigned int top = i >> 16;
+ unsigned int bot = i & 0xFFFF;
+ if (top == 0)
+ return make_number (bot);
+ if (top == 0xFFFF)
+ return Fcons (make_number (-1), make_number (bot));
+ return Fcons (make_number (top), make_number (bot));
+}
+
+unsigned long
+cons_to_long (c)
+ Lisp_Object c;
+{
+ Lisp_Object top, bot;
+ if (INTEGERP (c))
+ return XINT (c);
+ top = XCONS (c)->car;
+ bot = XCONS (c)->cdr;
+ if (CONSP (bot))
+ bot = XCONS (bot)->car;
+ return ((XINT (top) << 16) | XINT (bot));
+}
+\f
+DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
"Convert NUM to a string by printing it in decimal.\n\
Uses a minus sign if negative.\n\
NUM may be an integer or a floating point number.")
extern Lisp_Object float_arith_driver ();
Lisp_Object
-arith_driver
- (code, nargs, args)
+arith_driver (code, nargs, args)
enum arithop code;
int nargs;
register Lisp_Object *args;
case Amult: accum *= next; break;
case Adiv:
if (!argnum) accum = next;
- else accum /= next;
+ else
+ {
+ if (next == 0)
+ Fsignal (Qarith_error, Qnil);
+ accum /= next;
+ }
break;
case Alogand: accum &= next; break;
case Alogior: accum |= next; break;
if (!argnum)
accum = next;
else
- accum /= next;
+ {
+ if (next == 0)
+ Fsignal (Qarith_error, Qnil);
+ accum /= next;
+ }
break;
case Alogand:
case Alogior:
DEFUN ("%", Frem, Srem, 2, 2, 0,
"Returns remainder of first arg divided by second.\n\
-Both must be numbers or markers.")
+Both must be integers or markers.")
+ (num1, num2)
+ register Lisp_Object num1, num2;
+{
+ Lisp_Object val;
+
+ CHECK_NUMBER_COERCE_MARKER (num1, 0);
+ CHECK_NUMBER_COERCE_MARKER (num2, 1);
+
+ if (XFASTINT (num2) == 0)
+ Fsignal (Qarith_error, Qnil);
+
+ XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
+ return val;
+}
+
+DEFUN ("mod", Fmod, Smod, 2, 2, 0,
+ "Returns X modulo Y.\n\
+The result falls between zero (inclusive) and Y (exclusive).\n\
+Both X and Y must be numbers or markers.")
(num1, num2)
register Lisp_Object num1, num2;
{
Lisp_Object val;
+ int i1, i2;
#ifdef LISP_FLOAT_TYPE
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num1, 0);
- CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 0);
+ CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (num2, 1);
if (XTYPE (num1) == Lisp_Float || XTYPE (num2) == Lisp_Float)
{
f1 = XTYPE (num1) == Lisp_Float ? XFLOAT (num1)->data : XINT (num1);
f2 = XTYPE (num2) == Lisp_Float ? XFLOAT (num2)->data : XINT (num2);
+ if (f2 == 0)
+ Fsignal (Qarith_error, Qnil);
+
#if defined (USG) || defined (sun) || defined (ultrix) || defined (hpux)
f1 = fmod (f1, f2);
#else
f1 = drem (f1, f2);
#endif
- if (f1 < 0)
+ /* If the "remainder" comes out with the wrong sign, fix it. */
+ if ((f1 < 0) != (f2 < 0))
f1 += f2;
return (make_float (f1));
}
CHECK_NUMBER_COERCE_MARKER (num2, 1);
#endif /* not LISP_FLOAT_TYPE */
- XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
+ i1 = XINT (num1);
+ i2 = XINT (num2);
+
+ if (i2 == 0)
+ Fsignal (Qarith_error, Qnil);
+
+ i1 %= i2;
+
+ /* If the "remainder" comes out with the wrong sign, fix it. */
+ if ((i1 < 0) != (i2 < 0))
+ i1 += i2;
+
+ XSET (val, Lisp_Int, i1);
return val;
}
Qbeginning_of_buffer = intern ("beginning-of-buffer");
Qend_of_buffer = intern ("end-of-buffer");
Qbuffer_read_only = intern ("buffer-read-only");
+ Qmark_inactive = intern ("mark-inactive");
Qlistp = intern ("listp");
Qconsp = intern ("consp");
staticpro (&Qbeginning_of_buffer);
staticpro (&Qend_of_buffer);
staticpro (&Qbuffer_read_only);
+ staticpro (&Qmark_inactive);
staticpro (&Qlistp);
staticpro (&Qconsp);
defsubr (&Sboundp);
defsubr (&Sfboundp);
defsubr (&Sfset);
+ defsubr (&Sdefalias);
+ defsubr (&Sdefine_function);
defsubr (&Ssetplist);
defsubr (&Ssymbol_value);
defsubr (&Sset);
defsubr (&Skill_local_variable);
defsubr (&Saref);
defsubr (&Saset);
- defsubr (&Sint_to_string);
+ defsubr (&Snumber_to_string);
defsubr (&Sstring_to_number);
defsubr (&Seqlsign);
defsubr (&Slss);
defsubr (&Stimes);
defsubr (&Squo);
defsubr (&Srem);
+ defsubr (&Smod);
defsubr (&Smax);
defsubr (&Smin);
defsubr (&Slogand);