comparison src/eval.c @ 71976:66a9a086ddbb

* eval.c (xsignal): New func. Like Fsignal, but marked no-return. (xsignal0, xsignal1, xsignal2, xsignal3): New no-return functions. (signal_error): New no-return function (from xfaces.c). (Fthrow): Use xsignal2 instead of Fsignal + abort. (error): Use xsignal1 instead of Fsignal + abort. (FletX, Flet, grow_specpdl): Use signal_error. (Feval, Ffuncall, funcall_lambda): Use xsignal1, xsignal2. * xfaces.c (signal_error): Move to eval.c. (resolve_face_name): Use xsignal1.

71975:6d29dff081c5

      QUIT;
      elt = Fcar (varlist);
      if (SYMBOLP (elt))
	specbind (elt, Qnil);
      else if (! NILP (Fcdr (Fcdr (elt))))
	Fsignal (Qerror,
		 Fcons (build_string ("`let' bindings can have only one value-form"),
			elt));
      else
	{
	  val = Feval (Fcar (Fcdr (elt)));
	  specbind (Fcar (elt), val);
	}

      QUIT;
      elt = Fcar (varlist);
      if (SYMBOLP (elt))
	temps [argnum++] = Qnil;
      else if (! NILP (Fcdr (Fcdr (elt))))
	Fsignal (Qerror,
		 Fcons (build_string ("`let' bindings can have only one value-form"),
			elt));
      else
	temps [argnum++] = Feval (Fcar (Fcdr (elt)));
      gcpro2.nvars = argnum;
    }
  UNGCPRO;

    for (c = catchlist; c; c = c->next)
      {
	if (EQ (c->tag, tag))
	  unwind_to_catch (c, value);
      }
  Fsignal (Qno_catch, list2 (tag, value));
  abort ();
}


DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
       doc: /* Do BODYFORM, protecting with UNWINDFORMS.

  string = Ferror_message_string (data);
  fatal ("%s", SDATA (string), 0);
}

/* Return nonzero iff LIST is a non-nil atom or
   a list containing one of CONDITIONS.  */

static int
wants_debugger (list, conditions)

  string = build_string (buffer);
  if (allocated)
    xfree (buffer);

  Fsignal (Qerror, Fcons (string, Qnil));
  abort ();
}

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.

      CHECK_CONS_LIST ();

      if (XINT (numargs) < XSUBR (fun)->min_args ||
	  (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
	Fsignal (Qwrong_number_of_arguments, list2 (original_fun, numargs));

      if (XSUBR (fun)->max_args == UNEVALLED)
	{
	  backtrace.evalargs = 0;
	  val = (*XSUBR (fun)->function) (args_left);

  if (COMPILEDP (fun))
    val = apply_lambda (fun, original_args, 1);
  else
    {
      if (EQ (fun, Qunbound))
	Fsignal (Qvoid_function, Fcons (original_fun, Qnil));
      if (!CONSP (fun))
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
      funcar = Fcar (fun);
      if (!SYMBOLP (funcar))
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
      if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, original_fun);
	  goto retry;
	}
      if (EQ (funcar, Qmacro))
	val = Feval (apply1 (Fcdr (fun), original_args));
      else if (EQ (funcar, Qlambda))
	val = apply_lambda (fun, original_args, 1);
      else
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
    }
 done:
  CHECK_CONS_LIST ();

  lisp_eval_depth--;

    {
       if (numargs < XSUBR (fun)->min_args
	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
	{
	  XSETFASTINT (lisp_numargs, numargs);
	  Fsignal (Qwrong_number_of_arguments, list2 (original_fun, lisp_numargs));
	}

      if (XSUBR (fun)->max_args == UNEVALLED)
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));

      if (XSUBR (fun)->max_args == MANY)
	{
	  val = (*XSUBR (fun)->function) (numargs, args + 1);
	  goto done;

  if (COMPILEDP (fun))
    val = funcall_lambda (fun, numargs, args + 1);
  else
    {
      if (EQ (fun, Qunbound))
	Fsignal (Qvoid_function, Fcons (original_fun, Qnil));
      if (!CONSP (fun))
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
      funcar = Fcar (fun);
      if (!SYMBOLP (funcar))
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
      if (EQ (funcar, Qlambda))
	val = funcall_lambda (fun, numargs, args + 1);
      else if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, original_fun);
	  CHECK_CONS_LIST ();
	  goto retry;
	}
      else
	Fsignal (Qinvalid_function, Fcons (original_fun, Qnil));
    }
 done:
  CHECK_CONS_LIST ();
  lisp_eval_depth--;
  if (backtrace.debug_on_exit)

    {
      syms_left = XCDR (fun);
      if (CONSP (syms_left))
	syms_left = XCAR (syms_left);
      else
	Fsignal (Qinvalid_function, Fcons (fun, Qnil));
    }
  else if (COMPILEDP (fun))
    syms_left = AREF (fun, COMPILED_ARGLIST);
  else
    abort ();

    {
      QUIT;

      next = XCAR (syms_left);
      if (!SYMBOLP (next))
	Fsignal (Qinvalid_function, Fcons (fun, Qnil));

      if (EQ (next, Qand_rest))
	rest = 1;
      else if (EQ (next, Qand_optional))
	optional = 1;

	  i = nargs;
	}
      else if (i < nargs)
	specbind (next, arg_vector[i++]);
      else if (!optional)
	Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs)));
      else
	specbind (next, Qnil);
    }

  if (!NILP (syms_left))
    Fsignal (Qinvalid_function, Fcons (fun, Qnil));
  else if (i < nargs)
    Fsignal (Qwrong_number_of_arguments, list2 (fun, make_number (nargs)));

  if (CONSP (fun))
    val = Fprogn (XCDR (XCDR (fun)));
  else
    {

  if (specpdl_size >= max_specpdl_size)
    {
      if (max_specpdl_size < 400)
	max_specpdl_size = 400;
      if (specpdl_size >= max_specpdl_size)
	Fsignal (Qerror,
		 Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
    }
  specpdl_size *= 2;
  if (specpdl_size > max_specpdl_size)
    specpdl_size = max_specpdl_size;
  specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));

71976:66a9a086ddbb

      QUIT;
      elt = Fcar (varlist);
      if (SYMBOLP (elt))
	specbind (elt, Qnil);
      else if (! NILP (Fcdr (Fcdr (elt))))
	signal_error ("`let' bindings can have only one value-form", elt);
      else
	{
	  val = Feval (Fcar (Fcdr (elt)));
	  specbind (Fcar (elt), val);
	}

      QUIT;
      elt = Fcar (varlist);
      if (SYMBOLP (elt))
	temps [argnum++] = Qnil;
      else if (! NILP (Fcdr (Fcdr (elt))))
	signal_error ("`let' bindings can have only one value-form", elt);
      else
	temps [argnum++] = Feval (Fcar (Fcdr (elt)));
      gcpro2.nvars = argnum;
    }
  UNGCPRO;

    for (c = catchlist; c; c = c->next)
      {
	if (EQ (c->tag, tag))
	  unwind_to_catch (c, value);
      }
  xsignal2 (Qno_catch, tag, value);
}


DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
       doc: /* Do BODYFORM, protecting with UNWINDFORMS.

  string = Ferror_message_string (data);
  fatal ("%s", SDATA (string), 0);
}

/* Internal version of Fsignal that never returns.
   Used for anything but Qquit (which can return from Fsignal).  */

void
xsignal (error_symbol, data)
     Lisp_Object error_symbol, data;
{
  Fsignal (error_symbol, data);
  abort ();
}

/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */

void
xsignal0 (error_symbol)
     Lisp_Object error_symbol;
{
  xsignal (error_symbol, Qnil);
}

void
xsignal1 (error_symbol, arg)
     Lisp_Object error_symbol, arg;
{
  xsignal (error_symbol, list1 (arg));
}

void
xsignal2 (error_symbol, arg1, arg2)
     Lisp_Object error_symbol, arg1, arg2;
{
  xsignal (error_symbol, list2 (arg1, arg2));
}

void
xsignal3 (error_symbol, arg1, arg2, arg3)
     Lisp_Object error_symbol, arg1, arg2, arg3;
{
  xsignal (error_symbol, list3 (arg1, arg2, arg3));
}

/* Signal `error' with message S, and additional arg ARG.
   If ARG is not a genuine list, make it a one-element list.  */

void
signal_error (s, arg)
     char *s;
     Lisp_Object arg;
{
  Lisp_Object tortoise, hare;

  hare = tortoise = arg;
  while (CONSP (hare))
    {
      hare = XCDR (hare);
      if (!CONSP (hare))
	break;

      hare = XCDR (hare);
      tortoise = XCDR (tortoise);

      if (EQ (hare, tortoise))
	break;
    }

  if (!NILP (hare))
    arg = Fcons (arg, Qnil);	/* Make it a list.  */

  xsignal (Qerror, Fcons (build_string (s), arg));
}


/* Return nonzero iff LIST is a non-nil atom or
   a list containing one of CONDITIONS.  */

static int
wants_debugger (list, conditions)

  string = build_string (buffer);
  if (allocated)
    xfree (buffer);

  xsignal1 (Qerror, string);
}

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.

      CHECK_CONS_LIST ();

      if (XINT (numargs) < XSUBR (fun)->min_args ||
	  (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
	xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);

      if (XSUBR (fun)->max_args == UNEVALLED)
	{
	  backtrace.evalargs = 0;
	  val = (*XSUBR (fun)->function) (args_left);

  if (COMPILEDP (fun))
    val = apply_lambda (fun, original_args, 1);
  else
    {
      if (EQ (fun, Qunbound))
	xsignal1 (Qvoid_function, original_fun);
      if (!CONSP (fun))
	xsignal1 (Qinvalid_function, original_fun);
      funcar = XCAR (fun);
      if (!SYMBOLP (funcar))
	xsignal1 (Qinvalid_function, original_fun);
      if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, original_fun);
	  goto retry;
	}
      if (EQ (funcar, Qmacro))
	val = Feval (apply1 (Fcdr (fun), original_args));
      else if (EQ (funcar, Qlambda))
	val = apply_lambda (fun, original_args, 1);
      else
	xsignal1 (Qinvalid_function, original_fun);
    }
 done:
  CHECK_CONS_LIST ();

  lisp_eval_depth--;

    {
       if (numargs < XSUBR (fun)->min_args
	  || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
	{
	  XSETFASTINT (lisp_numargs, numargs);
	  xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
	}

      if (XSUBR (fun)->max_args == UNEVALLED)
	xsignal1 (Qinvalid_function, original_fun);

      if (XSUBR (fun)->max_args == MANY)
	{
	  val = (*XSUBR (fun)->function) (numargs, args + 1);
	  goto done;

  if (COMPILEDP (fun))
    val = funcall_lambda (fun, numargs, args + 1);
  else
    {
      if (EQ (fun, Qunbound))
	xsignal1 (Qvoid_function, original_fun);
      if (!CONSP (fun))
	xsignal1 (Qinvalid_function, original_fun);
      funcar = XCAR (fun);
      if (!SYMBOLP (funcar))
	xsignal1 (Qinvalid_function, original_fun);
      if (EQ (funcar, Qlambda))
	val = funcall_lambda (fun, numargs, args + 1);
      else if (EQ (funcar, Qautoload))
	{
	  do_autoload (fun, original_fun);
	  CHECK_CONS_LIST ();
	  goto retry;
	}
      else
	xsignal1 (Qinvalid_function, original_fun);
    }
 done:
  CHECK_CONS_LIST ();
  lisp_eval_depth--;
  if (backtrace.debug_on_exit)

    {
      syms_left = XCDR (fun);
      if (CONSP (syms_left))
	syms_left = XCAR (syms_left);
      else
	xsignal1 (Qinvalid_function, fun);
    }
  else if (COMPILEDP (fun))
    syms_left = AREF (fun, COMPILED_ARGLIST);
  else
    abort ();

    {
      QUIT;

      next = XCAR (syms_left);
      if (!SYMBOLP (next))
	xsignal1 (Qinvalid_function, fun);

      if (EQ (next, Qand_rest))
	rest = 1;
      else if (EQ (next, Qand_optional))
	optional = 1;

	  i = nargs;
	}
      else if (i < nargs)
	specbind (next, arg_vector[i++]);
      else if (!optional)
	xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
      else
	specbind (next, Qnil);
    }

  if (!NILP (syms_left))
    xsignal1 (Qinvalid_function, fun);
  else if (i < nargs)
    xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));

  if (CONSP (fun))
    val = Fprogn (XCDR (XCDR (fun)));
  else
    {

  if (specpdl_size >= max_specpdl_size)
    {
      if (max_specpdl_size < 400)
	max_specpdl_size = 400;
      if (specpdl_size >= max_specpdl_size)
	signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
    }
  specpdl_size *= 2;
  if (specpdl_size > max_specpdl_size)
    specpdl_size = max_specpdl_size;
  specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));