* lisp.h (STRING_SET_CHARS): New macro.
[bpt/emacs.git] / src / eval.c
index 7c63a2d..3e3b3bd 100644 (file)
@@ -231,7 +231,7 @@ call_debugger (arg)
      Lisp_Object arg;
 {
   int debug_while_redisplaying;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   Lisp_Object val;
   
   if (lisp_eval_depth + 20 > max_lisp_eval_depth)
@@ -646,12 +646,24 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
 
 DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
        doc: /* Define NAME as a macro.
-The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
+The actual definition looks like
+ (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...).
 When the macro is called, as in (NAME ARGS...),
 the function (lambda ARGLIST BODY...) is applied to
 the list ARGS... as it appears in the expression,
 and the result should be a form to be evaluated instead of the original.
-usage: (defmacro NAME ARGLIST [DOCSTRING] BODY...)  */)
+
+DECL is a declaration, optional, which can specify how to indent
+calls to this macro and how Edebug should handle it.  It looks like this:
+  (declare SPECS...)
+The elements can look like this:
+  (indent INDENT)
+       Set NAME's `lisp-indent-function' property to INDENT.
+
+  (edebug DEBUG)
+       Set NAME's `edebug-form-spec' property to DEBUG.  (This is
+       equivalent to writing a `def-edebug-spec' for the macro.
+usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
      (args)
      Lisp_Object args;
 {
@@ -825,7 +837,7 @@ on its property list).  */)
   if (INTEGERP (documentation) && XINT (documentation) < 0)
     return Qt;
   if (STRINGP (documentation)
-      && ((unsigned char) XSTRING (documentation)->data[0] == '*'))
+      && ((unsigned char) SREF (documentation, 0) == '*'))
     return Qt;
   /* If it is (STRING . INTEGER), a negative integer means a user variable.  */
   if (CONSP (documentation)
@@ -852,7 +864,7 @@ usage: (let* VARLIST BODY...)  */)
      Lisp_Object args;
 {
   Lisp_Object varlist, val, elt;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   GCPRO3 (args, elt, varlist);
@@ -892,7 +904,7 @@ usage: (let VARLIST BODY...)  */)
 {
   Lisp_Object *temps, tem;
   register Lisp_Object elt, varlist;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   register int argnum;
   struct gcpro gcpro1, gcpro2;
 
@@ -1083,7 +1095,7 @@ internal_catch (tag, func, arg)
   c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
-  c.pdlcount = specpdl_ptr - specpdl;
+  c.pdlcount = SPECPDL_INDEX ();
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
   c.byte_stack = byte_stack_list;
@@ -1184,7 +1196,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
      Lisp_Object args;
 {
   Lisp_Object val;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 
   record_unwind_protect (0, Fcdr (args));
   val = Feval (Fcar (args));
@@ -1250,7 +1262,7 @@ usage: (condition-case VAR BODYFORM HANDLERS...)  */)
   c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
-  c.pdlcount = specpdl_ptr - specpdl;
+  c.pdlcount = SPECPDL_INDEX ();
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
   c.byte_stack = byte_stack_list;
@@ -1315,7 +1327,7 @@ internal_condition_case (bfun, handlers, hfun)
   c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
-  c.pdlcount = specpdl_ptr - specpdl;
+  c.pdlcount = SPECPDL_INDEX ();
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
   c.byte_stack = byte_stack_list;
@@ -1355,7 +1367,7 @@ internal_condition_case_1 (bfun, arg, handlers, hfun)
   c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
-  c.pdlcount = specpdl_ptr - specpdl;
+  c.pdlcount = SPECPDL_INDEX ();
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
   c.byte_stack = byte_stack_list;
@@ -1398,7 +1410,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
   c.backlist = backtrace_list;
   c.handlerlist = handlerlist;
   c.lisp_eval_depth = lisp_eval_depth;
-  c.pdlcount = specpdl_ptr - specpdl;
+  c.pdlcount = SPECPDL_INDEX ();
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
   c.byte_stack = byte_stack_list;
@@ -1441,7 +1453,8 @@ See also the function `condition-case'.  */)
      Lisp_Object error_symbol, data;
 {
   /* When memory is full, ERROR-SYMBOL is nil,
-     and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).  */
+     and DATA is (REAL-ERROR-SYMBOL . REAL-DATA).
+     That is a special case--don't do this in other situations.  */
   register struct handler *allhandlers = handlerlist;
   Lisp_Object conditions;
   extern int gc_in_progress;
@@ -1462,22 +1475,27 @@ See also the function `condition-case'.  */)
   else
     real_error_symbol = error_symbol;
 
+#if 0 /* rms: I don't know why this was here,
+        but it is surely wrong for an error that is handled.  */
 #ifdef HAVE_X_WINDOWS
   if (display_hourglass_p)
     cancel_hourglass ();
 #endif
+#endif 
 
   /* This hook is used by edebug.  */
-  if (! NILP (Vsignal_hook_function))
+  if (! NILP (Vsignal_hook_function)
+      && ! NILP (error_symbol))
     call2 (Vsignal_hook_function, error_symbol, data);
 
   conditions = Fget (real_error_symbol, Qerror_conditions);
 
   /* Remember from where signal was called.  Skip over the frame for
      `signal' itself.  If a frame for `error' follows, skip that,
-     too.  */
+     too.  Don't do this when ERROR_SYMBOL is nil, because that
+     is a memory-full error.  */
   Vsignaling_function = Qnil;
-  if (backtrace_list)
+  if (backtrace_list && !NILP (error_symbol))
     {
       bp = backtrace_list->next;
       if (bp && bp->function && EQ (*bp->function, Qerror))
@@ -1499,13 +1517,6 @@ See also the function `condition-case'.  */)
       clause = find_handler_clause (handlerlist->handler, conditions,
                                    error_symbol, data, &debugger_value);
 
-#if 0 /* Most callers are not prepared to handle gc if this returns.
-        So, since this feature is not very useful, take it out.  */
-      /* If have called debugger and user wants to continue,
-        just return nil.  */
-      if (EQ (clause, Qlambda))
-       return debugger_value;
-#else
       if (EQ (clause, Qlambda))
        {
          /* We can't return values to code which signaled an error, but we
@@ -1515,7 +1526,6 @@ See also the function `condition-case'.  */)
          else
            error ("Cannot return from the debugger in an error");
        }
-#endif
 
       if (!NILP (clause))
        {
@@ -1544,7 +1554,7 @@ See also the function `condition-case'.  */)
     data = Fcons (error_symbol, data);
 
   string = Ferror_message_string (data);
-  fatal ("%s", XSTRING (string)->data, 0);
+  fatal ("%s", SDATA (string), 0);
 }
 
 /* Return nonzero iff LIST is a non-nil atom or
@@ -1634,7 +1644,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
       || !NILP (Vdebug_on_signal)) /* This says call debugger even if
                                      there is a handler.  */
     {
-      int count = specpdl_ptr - specpdl;
+      int count = SPECPDL_INDEX ();
       int debugger_called = 0;
       Lisp_Object sig_symbol, combined_data;
       /* This is set to 1 if we are handling a memory-full error,
@@ -1902,7 +1912,7 @@ void
 do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   Lisp_Object fun, queue, first, second;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
@@ -1910,7 +1920,7 @@ do_autoload (fundef, funname)
      of what files are preloaded and when.  */
   if (! NILP (Vpurify_flag))
     error ("Attempt to autoload %s while preparing to dump",
-          XSYMBOL (funname)->name->data);
+          SDATA (SYMBOL_NAME (funname)));
 
   fun = funname;
   CHECK_SYMBOL (funname);
@@ -1949,7 +1959,7 @@ do_autoload (fundef, funname)
 
   if (!NILP (Fequal (fun, fundef)))
     error ("Autoloading failed to define function %s",
-          XSYMBOL (funname)->name->data);
+          SDATA (SYMBOL_NAME (funname)));
   UNGCPRO;
 }
 
@@ -2848,7 +2858,7 @@ funcall_lambda (fun, nargs, arg_vector)
      register Lisp_Object *arg_vector;
 {
   Lisp_Object val, syms_left, next;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   int i, optional, rest;
 
   if (CONSP (fun))
@@ -2928,7 +2938,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
        {
          tem = AREF (object, COMPILED_BYTECODE);
          if (CONSP (tem) && STRINGP (XCAR (tem)))
-           error ("Invalid byte code in %s", XSTRING (XCAR (tem))->data);
+           error ("Invalid byte code in %s", SDATA (XCAR (tem)));
          else
            error ("Invalid byte code");
        }
@@ -2941,7 +2951,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
 void
 grow_specpdl ()
 {
-  register int count = specpdl_ptr - specpdl;
+  register int count = SPECPDL_INDEX ();
   if (specpdl_size >= max_specpdl_size)
     {
       if (max_specpdl_size < 400)
@@ -3240,14 +3250,19 @@ syms_of_eval ()
   DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
              doc: /* *Limit on number of Lisp variable bindings & unwind-protects.
 If Lisp code tries to make more than this many at once,
-an error is signaled.  */);
+an error is signaled.
+You can safely use a value considerably larger than the default value,
+if that proves inconveniently small.  However, if you increase it too far,
+Emacs could run out of memory trying to make the stack bigger.  */);
 
   DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
              doc: /* *Limit on depth in `eval', `apply' and `funcall' before error.
-This limit is to catch infinite recursions for you before they cause
+
+This limit serves to catch infinite recursions for you before they cause
 actual stack overflow in C, which would be fatal for Emacs.
 You can safely make it considerably larger than its default value,
-if that proves inconveniently small.  */);
+if that proves inconveniently small.  However, if you increase it too far,
+Emacs could overflow the real C stack, and crash.  */);
 
   DEFVAR_LISP ("quit-flag", &Vquit_flag,
               doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.