xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 424:11054d720c21 r21-2-20

Import from CVS: tag r21-2-20

author	cvs
date	Mon, 13 Aug 2007 11:26:11 +0200
parents	41dbb7a9d5f2
children

comparison

equal deleted inserted replaced

-:28d9c139be4c
+:11054d720c21
 /* If subrs take more than 8 arguments, more cases need to be added
 to this switch.  (But wait - don't do it - if you really need
 a SUBR with more than 8 arguments, use max_args == MANY.
 See the DEFUN macro in lisp.h)  */
 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do {			\
-void (*PF_fn)() = (void (*)()) (fn);				\
+void (*PF_fn)(void) = (void (*)(void)) fn;			\
 Lisp_Object *PF_av = (av);					\
 switch (ac)							\
 {								\
 default: abort();						\
 case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break;	\
 /* Maximum size allowed for specpdl allocation */
 int max_specpdl_size;
 /* Depth in Lisp evaluations and function calls.  */
-int lisp_eval_depth;
+static int lisp_eval_depth;
 /* Maximum allowed depth in Lisp evaluations and function calls.  */
 int max_lisp_eval_depth;
 /* Nonzero means enter debugger before next function call */
 write_c_string (header,  printcharfun);
 write_c_string (name,    printcharfun);
 write_c_string (trailer, printcharfun);
 }
-DEFINE_LRECORD_IMPLEMENTATION ("subr", subr,
+static const struct lrecord_description subr_description[] = {
-this_one_is_unmarkable, print_subr, 0, 0, 0, 0,
+{ XD_DOC_STRING, offsetof(Lisp_Subr, doc)    },
-			       Lisp_Subr);
+{ XD_END }
+};
+DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr,
+				     this_one_is_unmarkable, print_subr, 0, 0, 0,
+				     subr_description,
+				     Lisp_Subr);
 /************************************************************************/
 /*			 Entering the debugger				*/
 /************************************************************************/
 /*			Defining functions/variables			*/
 /************************************************************************/
 static Lisp_Object
 define_function (Lisp_Object name, Lisp_Object defn)
 {
-if (purify_flag)
-defn = Fpurecopy (defn);
 Ffset (name, defn);
 LOADHIST_ATTACH (name);
 return name;
 }
 	}
 if (!NILP (args = XCDR (args)))
 	{
 	  Lisp_Object doc = XCAR (args);
-#if 0 /* FSFmacs */
-	  /* #### We should probably do this but it might be dangerous */
-	  if (purify_flag)
-	    doc = Fpurecopy (doc);
 	  Fput (sym, Qvariable_documentation, doc);
-#else
-	  pure_put (sym, Qvariable_documentation, doc);
-#endif
 	  if (!NILP (args = XCDR (args)))
 	    error ("too many arguments");
 	}
 }
 #ifdef I18N3
 if (!NILP (Vfile_domain))
-pure_put (sym, Qvariable_domain, Vfile_domain);
+Fput (sym, Qvariable_domain, Vfile_domain);
 #endif
 LOADHIST_ATTACH (sym);
 return sym;
 }
 UNGCPRO;
 if (!NILP (args = XCDR (args)))
 {
 Lisp_Object doc = XCAR (args);
-#if 0 /* FSFmacs */
-/* #### We should probably do this but it might be dangerous */
-if (purify_flag)
-	doc = Fpurecopy (doc);
 Fput (sym, Qvariable_documentation, doc);
-#else
-pure_put (sym, Qvariable_documentation, doc);
-#endif
 if (!NILP (args = XCDR (args)))
 	error ("too many arguments");
 }
 #ifdef I18N3
 if (!NILP (Vfile_domain))
-pure_put (sym, Qvariable_domain, Vfile_domain);
+Fput (sym, Qvariable_domain, Vfile_domain);
 #endif
 LOADHIST_ATTACH (sym);
 return sym;
 }
 Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil);
 return
 ((INTP (documentation) && XINT (documentation) < 0) ||
-((STRINGP (documentation)) &&
+(STRINGP (documentation) &&
 (string_byte (XSTRING (documentation), 0) == '*')) ||
 /* If (STRING . INTEGER), a negative integer means a user variable. */
 (CONSP (documentation)
 && STRINGP (XCAR (documentation))
 }
 else
 {
 Fsignal (Qwrong_type_argument,
 	       Fcons (Qcommandp,
-		      ((EQ (cmd, final))
+		      (EQ (cmd, final)
 ? list1 (cmd)
 : list2 (cmd, final))));
 return Qnil;
 }
 }
 if (purify_flag)
 {
 /* Attempt to avoid consing identical (string=) pure strings. */
 file = Fsymbol_name (Fintern (file, Qnil));
 }
-return Ffset (function,
+return Ffset (function, Fcons (Qautoload, list4 (file,
-Fpurecopy (Fcons (Qautoload, list4 (file,
+						   docstring,
-docstring,
+						   interactive,
-interactive,
+						   type)));
-type))));
 }
 Lisp_Object
 un_autoload (Lisp_Object oldqueue)
 {
 	goto wrong_number_of_arguments;
 if (max_args == UNEVALLED) /* Optimize for the common case */
 	{
 	  backtrace.evalargs = 0;
-	  val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr)))
+	  val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr))
 		 (original_args));
 	}
 else if (nargs <= max_args)
 {
 struct gcpro gcpro1;
 	  }
 	  backtrace.args  = args;
 	  backtrace.nargs = nargs;
-	  val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+	  val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr))
 		 (nargs, args));
 	  UNGCPRO;
 	}
 else
 	  fun_args = spacious_args;
 	  goto funcall_subr;
 	}
 else if (max_args == MANY)
 	{
-	  val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+	  val = ((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr))
 	    (fun_nargs, fun_args);
 	}
 else if (max_args == UNEVALLED) /* Can't funcall a special form */
 	{
 	  goto invalid_function;
 args[0] = val;
 return Ffuncall (nargs, args);
 }
 else
 {
-struct gcpro gcpro1, gcpro2;
+struct gcpro gcpro1, gcpro2, gcpro3;
-GCPRO2 (sym, val);
+Lisp_Object globals = Qnil;
+GCPRO3 (sym, val, globals);
 for (;
 	   CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
 			   || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret)
 			       : !NILP (ret)));
 	{
 	  if (EQ (XCAR (val), Qt))
 	    {
 	      /* t indicates this hook has a local binding;
 		 it means to run the global binding too.  */
-	      Lisp_Object globals = Fdefault_value (sym);
+	      globals = Fdefault_value (sym);
 	      if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) &&
 		  ! NILP (globals))
 		{
 		  args[0] = globals;
 specbind (Qinhibit_quit, Qt);
 /* gc_currently_forbidden = 1; Currently no reason to do this; */
 cons = noseeum_cons (buffer, form);
-opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 GCPRO2 (cons, opaque);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_eval_in_buffer, cons,
 			  caught_a_squirmer, opaque);
 free_cons (XCONS (cons));
-if (OPAQUEP (opaque))
+if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
 /* gc_currently_forbidden = 0; */
 return unbind_to (speccount, tem);
 return Qnil;
 speccount = specpdl_depth();
 specbind (Qinhibit_quit, Qt);
-opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 GCPRO1 (opaque);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_run_hook, hook_symbol,
 caught_a_squirmer, opaque);
-if (OPAQUEP (opaque))
+if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
 return unbind_to (speccount, tem);
 }
 if (!allow_quit)
 specbind (Qinhibit_quit, Qt);
 cons = noseeum_cons (hook_symbol,
-		       warning_string ? make_opaque_ptr (warning_string)
+		       warning_string ? make_opaque_ptr ((void *)warning_string)
 		       : Qnil);
 GCPRO1 (cons);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_run_hook,
 			  hook_symbol,
 			  allow_quit ?
 			  allow_quit_safe_run_hook_caught_a_squirmer :
 safe_run_hook_caught_a_squirmer,
 			  cons);
-if (OPAQUEP (XCDR (cons)))
+if (OPAQUE_PTRP (XCDR (cons)))
 free_opaque_ptr (XCDR (cons));
 free_cons (XCONS (cons));
 UNGCPRO;
 return unbind_to (speccount, tem);
 GCPRO2 (opaque, function);
 speccount = specpdl_depth();
 specbind (Qinhibit_quit, Qt);
 /* gc_currently_forbidden = 1; Currently no reason to do this; */
-opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_call0, function,
 caught_a_squirmer, opaque);
-if (OPAQUEP (opaque))
+if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
 /* gc_currently_forbidden = 0; */
 return unbind_to (speccount, tem);
 specbind (Qinhibit_quit, Qt);
 /* gc_currently_forbidden = 1; Currently no reason to do this; */
 cons = noseeum_cons (function, object);
-opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_call1, cons,
 caught_a_squirmer, opaque);
-if (OPAQUEP (opaque))
+if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 free_cons (XCONS (cons));
 UNGCPRO;
 /* gc_currently_forbidden = 0; */
 GCPRO5 (cons, opaque, function, object1, object2);
 specbind (Qinhibit_quit, Qt);
 /* gc_currently_forbidden = 1; Currently no reason to do this; */
 cons = list3 (function, object1, object2);
-opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 catch_them_squirmers_call2, cons,
 caught_a_squirmer, opaque);
-if (OPAQUEP (opaque))
+if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 free_list (cons);
 UNGCPRO;
 /* gc_currently_forbidden = 0; */
 lisp_eval_depth = 0;
 entering_debugger = 0;
 }
 void
+reinit_vars_of_eval (void)
+{
+preparing_for_armageddon = 0;
+in_warnings = 0;
+Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag);
+staticpro_nodump (&Qunbound_suspended_errors_tag);
+specpdl_size = 50;
+specpdl = xnew_array (struct specbinding, specpdl_size);
+/* XEmacs change: increase these values. */
+max_specpdl_size = 3000;
+max_lisp_eval_depth = 500;
+#if 0 /* no longer used */
+throw_level = 0;
+#endif
+}
+void
 vars_of_eval (void)
 {
+reinit_vars_of_eval ();
 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /*
 Limit on number of Lisp variable bindings & unwind-protects before error.
 */ );
 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /*
 If due to `apply' or `funcall' entry, one arg, `lambda'.
 If due to `eval' entry, one arg, t.
 */ );
 Vdebugger = Qnil;
-preparing_for_armageddon = 0;
 staticpro (&Vpending_warnings);
 Vpending_warnings = Qnil;
-Vpending_warnings_tail = Qnil; /* no need to protect this */
+pdump_wire (&Vpending_warnings_tail);
+Vpending_warnings_tail = Qnil;
-in_warnings = 0;
 staticpro (&Vautoload_queue);
 Vautoload_queue = Qnil;
 staticpro (&Vcondition_handlers);
 Vcurrent_warning_class = Qnil;
 staticpro (&Vcurrent_error_state);
 Vcurrent_error_state = Qnil; /* errors as normal */
-Qunbound_suspended_errors_tag = make_opaque_long (0);
-staticpro (&Qunbound_suspended_errors_tag);
-specpdl_size = 50;
-specpdl_depth_counter = 0;
-specpdl = xnew_array (struct specbinding, specpdl_size);
-/* XEmacs change: increase these values. */
-max_specpdl_size = 3000;
-max_lisp_eval_depth = 500;
-#if 0 /* no longer used */
-throw_level = 0;
-#endif
 reinit_eval ();
 }

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 424:11054d720c21 r21-2-20