#include "syssignal.h"
#ifdef LISP_FLOAT_TYPE
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
#include <math.h>
#endif /* LISP_FLOAT_TYPE */
Lisp_Object Qboundp, Qfboundp;
Lisp_Object Qcdr;
+Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
+Lisp_Object Qoverflow_error, Qunderflow_error;
+
#ifdef LISP_FLOAT_TYPE
Lisp_Object Qfloatp;
Lisp_Object Qnumberp, Qnumber_or_marker_p;
{
if (XTYPE (value) == Lisp_String &&
(EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
- return Fstring_to_int (value, Qt);
+ 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);
"Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
(sym, newdef)
register Lisp_Object sym, newdef;
+{
+ CHECK_SYMBOL (sym, 0);
+ if (NILP (sym) || EQ (sym, Qt))
+ return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
+
+ 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;
}
if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
return Qt;
return Qnil;
+
+ default:
+ abort ();
}
}
return Qnil;
}
\f
-DEFUN ("int-to-string", Fint_to_string, Sint_to_string, 1, 1, 0,
- "Convert INT to a string by printing it in decimal.\n\
-Uses a minus sign if negative.")
+/* 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;
+{
+ int 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.")
(num)
Lisp_Object num;
{
return build_string (buffer);
}
-DEFUN ("string-to-int", Fstring_to_int, Sstring_to_int, 1, 1, 0,
- "Convert STRING to an integer by parsing it as a decimal number.")
+DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 1, 0,
+ "Convert STRING to a number by parsing it as a decimal number.\n\
+This parses both integers and floating point numbers.")
(str)
register Lisp_Object str;
{
+ unsigned char *p;
+
CHECK_STRING (str, 0);
+ p = XSTRING (str)->data;
+
+ /* Skip any whitespace at the front of the number. Some versions of
+ atoi do this anyway, so we might as well make Emacs lisp consistent. */
+ while (*p == ' ' || *p == '\t')
+ p++;
+
#ifdef LISP_FLOAT_TYPE
- if (isfloat_string (XSTRING (str)->data))
- return make_float (atof (XSTRING (str)->data));
+ if (isfloat_string (p))
+ return make_float (atof (p));
#endif /* LISP_FLOAT_TYPE */
- return make_number (atoi (XSTRING (str)->data));
+ return make_number (atoi (p));
}
\f
enum arithop
void
syms_of_data ()
{
+ Lisp_Object error_tail, arith_tail;
+
Qquote = intern ("quote");
Qlambda = intern ("lambda");
Qsubr = intern ("subr");
Qcdr = intern ("cdr");
+ error_tail = Fcons (Qerror, Qnil);
+
/* ERROR is used as a signaler for random errors for which nothing else is right */
Fput (Qerror, Qerror_conditions,
- Fcons (Qerror, Qnil));
+ error_tail);
Fput (Qerror, Qerror_message,
build_string ("error"));
build_string ("Quit"));
Fput (Qwrong_type_argument, Qerror_conditions,
- Fcons (Qwrong_type_argument, Fcons (Qerror, Qnil)));
+ Fcons (Qwrong_type_argument, error_tail));
Fput (Qwrong_type_argument, Qerror_message,
build_string ("Wrong type argument"));
Fput (Qargs_out_of_range, Qerror_conditions,
- Fcons (Qargs_out_of_range, Fcons (Qerror, Qnil)));
+ Fcons (Qargs_out_of_range, error_tail));
Fput (Qargs_out_of_range, Qerror_message,
build_string ("Args out of range"));
Fput (Qvoid_function, Qerror_conditions,
- Fcons (Qvoid_function, Fcons (Qerror, Qnil)));
+ Fcons (Qvoid_function, error_tail));
Fput (Qvoid_function, Qerror_message,
build_string ("Symbol's function definition is void"));
Fput (Qcyclic_function_indirection, Qerror_conditions,
- Fcons (Qcyclic_function_indirection, Fcons (Qerror, Qnil)));
+ Fcons (Qcyclic_function_indirection, error_tail));
Fput (Qcyclic_function_indirection, Qerror_message,
build_string ("Symbol's chain of function indirections contains a loop"));
Fput (Qvoid_variable, Qerror_conditions,
- Fcons (Qvoid_variable, Fcons (Qerror, Qnil)));
+ Fcons (Qvoid_variable, error_tail));
Fput (Qvoid_variable, Qerror_message,
build_string ("Symbol's value as variable is void"));
Fput (Qsetting_constant, Qerror_conditions,
- Fcons (Qsetting_constant, Fcons (Qerror, Qnil)));
+ Fcons (Qsetting_constant, error_tail));
Fput (Qsetting_constant, Qerror_message,
build_string ("Attempt to set a constant symbol"));
Fput (Qinvalid_read_syntax, Qerror_conditions,
- Fcons (Qinvalid_read_syntax, Fcons (Qerror, Qnil)));
+ Fcons (Qinvalid_read_syntax, error_tail));
Fput (Qinvalid_read_syntax, Qerror_message,
build_string ("Invalid read syntax"));
Fput (Qinvalid_function, Qerror_conditions,
- Fcons (Qinvalid_function, Fcons (Qerror, Qnil)));
+ Fcons (Qinvalid_function, error_tail));
Fput (Qinvalid_function, Qerror_message,
build_string ("Invalid function"));
Fput (Qwrong_number_of_arguments, Qerror_conditions,
- Fcons (Qwrong_number_of_arguments, Fcons (Qerror, Qnil)));
+ Fcons (Qwrong_number_of_arguments, error_tail));
Fput (Qwrong_number_of_arguments, Qerror_message,
build_string ("Wrong number of arguments"));
Fput (Qno_catch, Qerror_conditions,
- Fcons (Qno_catch, Fcons (Qerror, Qnil)));
+ Fcons (Qno_catch, error_tail));
Fput (Qno_catch, Qerror_message,
build_string ("No catch for tag"));
Fput (Qend_of_file, Qerror_conditions,
- Fcons (Qend_of_file, Fcons (Qerror, Qnil)));
+ Fcons (Qend_of_file, error_tail));
Fput (Qend_of_file, Qerror_message,
build_string ("End of file during parsing"));
+ arith_tail = Fcons (Qarith_error, error_tail);
Fput (Qarith_error, Qerror_conditions,
- Fcons (Qarith_error, Fcons (Qerror, Qnil)));
+ arith_tail);
Fput (Qarith_error, Qerror_message,
build_string ("Arithmetic error"));
Fput (Qbeginning_of_buffer, Qerror_conditions,
- Fcons (Qbeginning_of_buffer, Fcons (Qerror, Qnil)));
+ Fcons (Qbeginning_of_buffer, error_tail));
Fput (Qbeginning_of_buffer, Qerror_message,
build_string ("Beginning of buffer"));
Fput (Qend_of_buffer, Qerror_conditions,
- Fcons (Qend_of_buffer, Fcons (Qerror, Qnil)));
+ Fcons (Qend_of_buffer, error_tail));
Fput (Qend_of_buffer, Qerror_message,
build_string ("End of buffer"));
Fput (Qbuffer_read_only, Qerror_conditions,
- Fcons (Qbuffer_read_only, Fcons (Qerror, Qnil)));
+ Fcons (Qbuffer_read_only, error_tail));
Fput (Qbuffer_read_only, Qerror_message,
build_string ("Buffer is read-only"));
+#ifdef LISP_FLOAT_TYPE
+ Qrange_error = intern ("range-error");
+ Qdomain_error = intern ("domain-error");
+ Qsingularity_error = intern ("singularity-error");
+ Qoverflow_error = intern ("overflow-error");
+ Qunderflow_error = intern ("underflow-error");
+
+ Fput (Qdomain_error, Qerror_conditions,
+ Fcons (Qdomain_error, arith_tail));
+ Fput (Qdomain_error, Qerror_message,
+ build_string ("Arithmetic domain error"));
+
+ Fput (Qrange_error, Qerror_conditions,
+ Fcons (Qrange_error, arith_tail));
+ Fput (Qrange_error, Qerror_message,
+ build_string ("Arithmetic range error"));
+
+ Fput (Qsingularity_error, Qerror_conditions,
+ Fcons (Qsingularity_error, Fcons (Qdomain_error, arith_tail)));
+ Fput (Qsingularity_error, Qerror_message,
+ build_string ("Arithmetic singularity error"));
+
+ Fput (Qoverflow_error, Qerror_conditions,
+ Fcons (Qoverflow_error, Fcons (Qdomain_error, arith_tail)));
+ Fput (Qoverflow_error, Qerror_message,
+ build_string ("Arithmetic overflow error"));
+
+ Fput (Qunderflow_error, Qerror_conditions,
+ Fcons (Qunderflow_error, Fcons (Qdomain_error, arith_tail)));
+ Fput (Qunderflow_error, Qerror_message,
+ build_string ("Arithmetic underflow error"));
+
+ staticpro (&Qrange_error);
+ staticpro (&Qdomain_error);
+ staticpro (&Qsingularity_error);
+ staticpro (&Qoverflow_error);
+ staticpro (&Qunderflow_error);
+#endif /* LISP_FLOAT_TYPE */
+
staticpro (&Qnil);
staticpro (&Qt);
staticpro (&Qquote);
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 (&Sstring_to_int);
+ defsubr (&Snumber_to_string);
+ defsubr (&Sstring_to_number);
defsubr (&Seqlsign);
defsubr (&Slss);
defsubr (&Sgtr);