#include <config.h>
#include <limits.h>
#include <setjmp.h>
+#include <stdio.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
char debug_on_exit : 1;
};
-struct backtrace *backtrace_list;
+static struct backtrace *backtrace_list;
+
+#if !BYTE_MARK_STACK
+static
+#endif
struct catchtag *catchlist;
+/* Chain of condition handlers currently in effect.
+ The elements of this chain are contained in the stack frames
+ of Fcondition_case and internal_condition_case.
+ When an error is signaled (by calling Fsignal, below),
+ this chain is searched for an element that applies. */
+
+#if !BYTE_MARK_STACK
+static
+#endif
+struct handler *handlerlist;
+
#ifdef DEBUG_GCPRO
/* Count levels of GCPRO to detect failure to UNGCPRO. */
int gcpro_level;
static Lisp_Object Qdeclare;
Lisp_Object Qinternal_interpreter_environment, Qclosure;
-static Lisp_Object Qdebug;
+Lisp_Object Qdebug;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
/* Depth in Lisp evaluations and function calls. */
-EMACS_INT lisp_eval_depth;
+static EMACS_INT lisp_eval_depth;
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
signal the error instead of entering an infinite loop of debugger
invocations. */
-int when_entered_debugger;
+static int when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
static int interactive_p (int);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-INFUN (Ffetch_bytecode, 1);
+static Lisp_Object Ffetch_bytecode (Lisp_Object);
\f
void
init_eval_once (void)
return val;
}
-DEFUE ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
+DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: /* Eval BODY forms sequentially and return value of last one.
usage: (progn BODY...) */)
(Lisp_Object args)
}
-DEFUE ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
+DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
doc: /* Return t if the containing function was run directly by user input.
This means that the function was called with `call-interactively'
\(which includes being called as the binding of a key)
_longjmp (catch->jmp, 1);
}
-DEFUE ("throw", Fthrow, Sthrow, 2, 2, 0,
+DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
doc: /* Throw to the catch for TAG and return VALUE from it.
Both TAG and VALUE are evalled. */)
(register Lisp_Object tag, Lisp_Object value)
return unbind_to (count, val);
}
\f
-/* Chain of condition handlers currently in effect.
- The elements of this chain are contained in the stack frames
- of Fcondition_case and internal_condition_case.
- When an error is signaled (by calling Fsignal, below),
- this chain is searched for an element that applies. */
-
-struct handler *handlerlist;
-
DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
doc: /* Regain control when an error is signaled.
Executes BODYFORM and returns its value if no error happens.
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
- error ("Invalid condition handler");
+ error ("Invalid condition handler: %s",
+ SDATA (Fprin1_to_string (tem, Qt)));
}
c.tag = Qnil;
static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
Lisp_Object data);
-DEFUE ("signal", Fsignal, Ssignal, 2, 2, 0,
+DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
This function does not return.
{
char buf[4000];
size_t size = sizeof buf;
- size_t size_max =
- min (MOST_POSITIVE_FIXNUM, min (INT_MAX, SIZE_MAX - 1)) + 1;
+ size_t size_max = min (MOST_POSITIVE_FIXNUM, SIZE_MAX);
+ size_t mlen = strlen (m);
char *buffer = buf;
- int used;
+ size_t used;
Lisp_Object string;
while (1)
{
- used = vsnprintf (buffer, size, m, ap);
+ used = doprnt (buffer, size, m, m + mlen, ap);
- if (used < 0)
- {
- /* Non-C99 vsnprintf, such as w32, returns -1 when SIZE is too small.
- Guess a larger USED to work around the incompatibility. */
- used = (size <= size_max / 2 ? 2 * size
- : size < size_max ? size_max - 1
- : size_max);
- }
- else if (used < size)
+ /* Note: the -1 below is because `doprnt' returns the number of bytes
+ excluding the terminating null byte, and it always terminates with a
+ null byte, even when producing a truncated message. */
+ if (used < size - 1)
break;
- if (size_max <= used)
- memory_full ();
- size = used + 1;
+ if (size <= size_max / 2)
+ size *= 2;
+ else if (size < size_max)
+ size = size_max;
+ else
+ break; /* and leave the message truncated */
if (buffer != buf)
xfree (buffer);
va_end (ap);
}
\f
-DEFUE ("commandp", Fcommandp, Scommandp, 1, 2, 0,
+DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
This means it contains a description for how to read arguments to give it.
The value is nil for an invalid function or a symbol with no function
}
\f
-DEFUE ("eval", Feval, Seval, 1, 2, 0,
+DEFUN ("eval", Feval, Seval, 1, 2, 0,
doc: /* Evaluate FORM and return its value.
If LEXICAL is t, evaluate using lexical scoping. */)
(Lisp_Object form, Lisp_Object lexical)
return val;
}
\f
-DEFUE ("apply", Fapply, Sapply, 2, MANY, 0,
+DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
Then return the value FUNCTION returns.
Thus, (apply '+ 1 2 '(3 4)) returns 10.
return Qnil;
}
-DEFUE ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS.
Each argument should be a symbol, a hook variable.
These symbols are processed in the order specified.
return Qnil;
}
-DEFUE ("run-hook-with-args", Frun_hook_with_args,
+DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable. If HOOK has a non-nil
return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
}
-DEFUE ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
+DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: /* Run HOOK with the specified arguments ARGS.
HOOK should be a symbol, a hook variable. If HOOK has a non-nil
/* The caller should GCPRO all the elements of ARGS. */
-DEFUE ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
+DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
doc: /* Non-nil if OBJECT is a function. */)
(Lisp_Object object)
{
return Qnil;
}
-DEFUE ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
+DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
doc: /* Call first argument as a function, passing remaining arguments to it.
Return the value that function returns.
Thus, (funcall 'cons 'x 'y) returns (x . y).
}
\f
+#if BYTE_MARK_STACK
void
mark_backtrace (void)
{
mark_object (backlist->args[i]);
}
}
+#endif
void
syms_of_eval (void)
HCoop / bpt / emacs.git / blobdiff