xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.

author	ben
date	Wed, 13 Mar 2002 08:54:06 +0000
parents	b1f74adcc1ff
children	e38acbeb1cae

comparison

equal deleted inserted replaced

-:336a418893b5
+:943eaba38521
 record_unwind_protect (restore_entering_debugger,
 (entering_debugger ? Qt : Qnil));
 entering_debugger = 1;
 val = internal_catch (Qdebugger, call_debugger_259, arg, &threw);
-return unbind_to (speccount, ((threw)
+return unbind_to_1 (speccount, ((threw)
 				? Qunbound /* Not returning a value */
 				: val));
 }
 /* Called when debug-on-exit behavior is called for.  Enter the debugger
 					     backtrace_259,
 					     Qnil,
 					     Qnil);
 else /* in batch mode, we want this going to stderr. */
 	backtrace_259 (Qnil);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 *stack_trace_displayed = 1;
 }
 if (!entering_debugger && !*debugger_entered && !signal_vars_only
 && (EQ (sig, Qquit)
 					     backtrace_259,
 					     Qnil,
 					     Qnil);
 else /* in batch mode, we want this going to stderr. */
 	backtrace_259 (Qnil);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 *stack_trace_displayed = 1;
 }
 if (!entering_debugger && !*debugger_entered
 && (EQ (sig, Qquit)
 *debugger_entered = 1;
 }
 UNGCPRO;
 Vcondition_handlers = all_handlers;
-return unbind_to (speccount, val);
+return unbind_to_1 (speccount, val);
 }
 /************************************************************************/
 /*		       The basic special forms				*/
 		  ("`let' bindings can have only one value-form", var);
 	    }
 	}
 specbind (symbol, value);
 }
-return unbind_to (speccount, Fprogn (body));
+return unbind_to_1 (speccount, Fprogn (body));
 }
 DEFUN ("let", Flet, 1, UNEVALLED, 0, /*
 \(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.
 The value of the last form in BODY is returned.
 }
 }
 UNGCPRO;
-return unbind_to (speccount, Fprogn (body));
+return unbind_to_1 (speccount, Fprogn (body));
 }
 DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /*
 \(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.
 The order of execution is thus TEST, BODY, TEST, BODY and so on
 {
 last_time = catchlist == c;
 /* Unwind the specpdl stack, and then restore the proper set of
 handlers.  */
-unbind_to (catchlist->pdlcount, Qnil);
+unbind_to (catchlist->pdlcount);
 catchlist = catchlist->next;
 #ifdef ERROR_CHECK_TYPECHECK
 check_error_state_sanity ();
 #endif
 }
 This would try to throw to the inner (catch 'bar)!
 --ben
 */
 /* Unwind the specpdl stack */
-unbind_to (c->pdlcount, Qnil);
+unbind_to (c->pdlcount);
 catchlist = c->next;
 #ifdef ERROR_CHECK_TYPECHECK
 check_error_state_sanity ();
 #endif
 #endif /* Former code */
 {
 /* This function can GC */
 int speccount = specpdl_depth();
 record_unwind_protect (Fprogn, XCDR (args));
-return unbind_to (speccount, Feval (XCAR (args)));
+return unbind_to_1 (speccount, Feval (XCAR (args)));
 }
 /************************************************************************/
 /*		      Signalling and trapping errors			*/
 check_error_state_sanity ();
 #endif
 /* Note: The unbind also resets Vcondition_handlers.  Maybe we should
 delete this here. */
 Vcondition_handlers = XCDR (c.tag);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 UNGCPRO;
 /* free the conses *after* the unbind, because the unbind will run
 condition_case_unwind above. */
 free_cons (XCONS (XCAR (c.tag)));
 val = Fprogn (Fcdr (h.chosen_clause));
 /* Note that this just undoes the binding of h.var; whoever
 longjmp()ed to us unwound the stack to c.pdlcount before
 throwing. */
-unbind_to (c.pdlcount, Qnil);
+unbind_to (c.pdlcount);
 return val;
 #else
 int speccount;
 CHECK_TRUE_LIST (val);
 return Fprogn (Fcdr (val)); /* tail call */
 speccount = specpdl_depth();
 specbind (var, Fcar (val));
 val = Fprogn (Fcdr (val));
-return unbind_to (speccount, val);
+return unbind_to_1 (speccount, val);
 #endif
 }
 /* Here for bytecode to call non-consfully.  This is exactly like
 condition-case except that it takes three arguments rather
 Usage looks like (condition-case VAR BODYFORM HANDLERS...).
 Executes BODYFORM and returns its value if no error happens.
 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
 where the BODY is made of Lisp expressions.
+A typical usage of `condition-case' looks like this:
+(condition-case nil
+;; you need a progn here if you want more than one statement ...
+(progn
+(do-something)
+(do-something-else))
+(error
+(issue-warning-or)
+;; but strangely, you don't need one here.
+(return-a-value-etc)
+))
 A handler is applicable to an error if CONDITION-NAME is one of the
 error's condition names.  If an error happens, the first applicable
 handler is run.  As a special case, a CONDITION-NAME of t matches
 all errors, even those without the `error' condition name on them
 \(e.g. `quit').
 tem = noseeum_cons (list1 (args[0]), Vcondition_handlers);
 record_unwind_protect (condition_bind_unwind, tem);
 Vcondition_handlers = tem;
 /* Caller should have GC-protected args */
-return unbind_to (speccount, Ffuncall (nargs - 1, args + 1));
+return unbind_to_1 (speccount, Ffuncall (nargs - 1, args + 1));
 }
 static int
 condition_type_p (Lisp_Object type, Lisp_Object conditions)
 {
 if (!initialized)
 {
 /* who knows how much has been initialized?  Safest bet is
 just to bomb out immediately. */
-/* let's not use stderr_out() here, because that does a bunch of
+stderr_out ("Error before initialization is complete!\n");
-	 things that might not be safe yet. */
-fprintf (stderr, "Error before initialization is complete!\n");
 abort ();
 }
 if (gc_in_progress || in_display)
 /* This is one of many reasons why you can't run lisp code from redisplay.
 			     Vcurrent_error_state);
 Vcurrent_error_state = no_error;
 }
 PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]),
 		     kludgy_args + 3, XINT (kludgy_args[1]));
-return unbind_to (speccount, val);
+return unbind_to_1 (speccount, val);
 }
 /* Many functions would like to do one of three things if an error
 occurs:
 free_opaque_ptr (opaque2);
 UNGCPRO;
 /* Use the returned value except in non-local exit, when
 RETVAL applies. */
 /* Some perverse compilers require the perverse cast below.  */
-return unbind_to (speccount,
+return unbind_to_1 (speccount,
 		      threw ? *((Lisp_Object*) &(retval)) : the_retval);
 }
 }
 /* Signal a non-continuable error or display a warning or do nothing,
 else
 frob = list1 (frob);
 if (!reason)
 return frob;
 else
-return Fcons (build_translated_string (reason), frob);
+return Fcons (build_msg_string (reason), frob);
 }
 DOESNT_RETURN
 signal_error (Lisp_Object type, const CIntbyte *reason, Lisp_Object frob)
 {
 DOESNT_RETURN
 signal_error_2 (Lisp_Object type, const CIntbyte *reason,
 		Lisp_Object frob0, Lisp_Object frob1)
 {
-signal_error_1 (type, list3 (build_translated_string (reason), frob0,
+signal_error_1 (type, list3 (build_msg_string (reason), frob0,
 			       frob1));
 }
 void
 maybe_signal_error_2 (Lisp_Object type, const CIntbyte *reason,
 		      Lisp_Object class, Error_Behavior errb)
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
-maybe_signal_error_1 (type, list3 (build_translated_string (reason), frob0,
+maybe_signal_error_1 (type, list3 (build_msg_string (reason), frob0,
 				     frob1), class, errb);
 }
 Lisp_Object
 signal_continuable_error_2 (Lisp_Object type, const CIntbyte *reason,
 			    Lisp_Object frob0, Lisp_Object frob1)
 {
-return Fsignal (type, list3 (build_translated_string (reason), frob0,
+return Fsignal (type, list3 (build_msg_string (reason), frob0,
 			       frob1));
 }
 Lisp_Object
 maybe_signal_continuable_error_2 (Lisp_Object type, const CIntbyte *reason,
 {
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return Qnil;
 return maybe_signal_continuable_error_1
-(type, list3 (build_translated_string (reason), frob0, frob1),
+(type, list3 (build_msg_string (reason), frob0, frob1),
 class, errb);
 }
 /****************** Error functions class 4 ******************/
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 signal_error (type, 0, obj);
 }
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 maybe_signal_error (type, 0, obj, class, errb);
 }
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 return Fsignal (type, list1 (obj));
 }
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return Qnil;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 return maybe_signal_continuable_error (type, 0, obj, class, errb);
 }
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 signal_error_1 (type, Fcons (obj, build_error_data (0, frob)));
 }
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 maybe_signal_error_1 (type, Fcons (obj, build_error_data (0, frob)), class,
 			errb);
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 return Fsignal (type, Fcons (obj, build_error_data (0, frob)));
 }
 /* Optimization: */
 if (ERRB_EQ (errb, ERROR_ME_NOT))
 return Qnil;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 return maybe_signal_continuable_error_1 (type,
 					   Fcons (obj,
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt), Qnil, -1,
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				args);
 va_end (args);
 /* Fsignal GC-protects its args */
 signal_error (Qprinting_unreadable_object, 0, obj);
 }
 }
 }
 /* Once loading finishes, don't undo it.  */
 Vautoload_queue = Qt;
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 fun = indirect_function (fun, 0);
 #if 0 /* FSFmacs */
 if (!NILP (Fequal (fun, fundef)))
 GCPRO4 (form, class, level, messij);
 if (!STRINGP (messij))
 	messij = Fprin1_to_string (messij, Qnil);
 call3 (Qdisplay_warning, class, messij, level);
 UNGCPRO;
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 }
 if (!CONSP (form))
 {
 if (SYMBOLP (form))
 }
 if (i < nargs)
 goto wrong_number_of_arguments;
-return unbind_to (speccount, Fprogn (body));
+return unbind_to_1 (speccount, Fprogn (body));
 wrong_number_of_arguments:
 return signal_wrong_number_of_arguments_error (fun, nargs);
 invalid_function:
 /* Whenever gc_in_progress is true, preparing_for_armageddon
 will also be true unless something is really hosed. */
 assert (!gc_in_progress);
 sym = args[0];
-val = symbol_value_in_buffer (sym, make_buffer (buf));
+val = symbol_value_in_buffer (sym, wrap_buffer (buf));
 ret = (cond == RUN_HOOKS_UNTIL_FAILURE ? Qt : Qnil);
 if (UNBOUNDP (val) || NILP (val))
 return ret;
 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call0 (fn);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 Lisp_Object
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call1 (fn, arg0);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 Lisp_Object
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call2 (fn, arg0, arg1);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 Lisp_Object
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call3 (fn, arg0, arg1, arg2);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 Lisp_Object
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call4 (fn, arg0, arg1, arg2, arg3);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 Lisp_Object
 Lisp_Object val;
 int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = Feval (form);
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 return val;
 }
 }
 argument similar to Qt or Qerror for condition_case_1(). */
 static Lisp_Object
 caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
 {
+/* #### should be rewritten to work with emacs_sprintf_string_lisp(); but this
+whole stuff is getting junked and replaced from my stderr-proc ws */
 if (!NILP (errordata))
 {
 Lisp_Object args[2];
 if (!NILP (arg))
 {
-CIntbyte *str = (CIntbyte *) get_opaque_ptr (arg);
+Intbyte *str = (Intbyte *) get_opaque_ptr (arg);
-args[0] = build_string (str);
+args[0] = build_intstring (str);
 }
 else
-args[0] = build_string ("error");
+args[0] = build_msg_string ("error");
 /* #### This should call
 	 (with-output-to-string (display-error errordata))
 	 but that stuff is all in Lisp currently. */
 args[1] = errordata;
 warn_when_safe_lispobj
 	(Qerror, Qwarning,
-	 emacs_doprnt_string_lisp ((const Intbyte *) "%s: %s",
+	 emacs_vsprintf_string_lisp ("%s: %s", Qnil, 2, args));
-				   Qnil, -1, 2, args));
 }
 return Qunbound;
 }
 static Lisp_Object
 struct gcpro gcpro1, gcpro2;
 XSETBUFFER (buffer, buf);
 specbind (Qinhibit_quit, Qt);
-/* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* begin_gc_forbidden(); Currently no reason to do this; */
 cons = noseeum_cons (buffer, form);
 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 GCPRO2 (cons, opaque);
 /* Qerror not Qt, so you can get a backtrace */
 free_cons (XCONS (cons));
 if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
-/* gc_currently_forbidden = 0; */
+return unbind_to_1 (speccount, tem);
-return unbind_to (speccount, tem);
 }
 static Lisp_Object
 catch_them_squirmers_run_hook (Lisp_Object hook_symbol)
 {
 caught_a_squirmer, opaque);
 if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
-return unbind_to (speccount, tem);
+return unbind_to_1 (speccount, tem);
 }
 /* Same as run_hook_trapping_errors() but also set the hook to nil
 if an error occurs. */
 if (OPAQUE_PTRP (XCDR (cons)))
 free_opaque_ptr (XCDR (cons));
 free_cons (XCONS (cons));
 UNGCPRO;
-return unbind_to (speccount, tem);
+return unbind_to_1 (speccount, tem);
 }
 static Lisp_Object
 catch_them_squirmers_call0 (Lisp_Object function)
 {
 }
 GCPRO2 (opaque, function);
 speccount = specpdl_depth();
 specbind (Qinhibit_quit, Qt);
-/* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* begin_gc_forbidden(); Currently no reason to do this; */
 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 (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 UNGCPRO;
-/* gc_currently_forbidden = 0; */
+return unbind_to_1 (speccount, tem);
-return unbind_to (speccount, tem);
 }
 static Lisp_Object
 catch_them_squirmers_call1 (Lisp_Object cons)
 {
 }
 GCPRO4 (cons, opaque, function, object);
 specbind (Qinhibit_quit, Qt);
-/* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* begin_gc_forbidden(); Currently no reason to do this; */
 cons = noseeum_cons (function, object);
 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 free_cons (XCONS (cons));
 UNGCPRO;
-/* gc_currently_forbidden = 0; */
+return unbind_to_1 (speccount, tem);
-return unbind_to (speccount, tem);
 }
 Lisp_Object
 call2_trapping_errors (const CIntbyte *warning_string, Lisp_Object function,
 		       Lisp_Object object1, Lisp_Object object2)
 	return Qnil;
 }
 GCPRO5 (cons, opaque, function, object1, object2);
 specbind (Qinhibit_quit, Qt);
-/* gc_currently_forbidden = 1; Currently no reason to do this; */
+/* begin_gc_forbidden(); Currently no reason to do this; */
 cons = list3 (function, object1, object2);
 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
 /* Qerror not Qt, so you can get a backtrace */
 tem = condition_case_1 (Qerror,
 if (OPAQUE_PTRP (opaque))
 free_opaque_ptr (opaque);
 free_list (cons);
 UNGCPRO;
-/* gc_currently_forbidden = 0; */
+return unbind_to_1 (speccount, tem);
-return unbind_to (speccount, tem);
 }
 /************************************************************************/
 /*		       The special binding stack			*/
-/* Most C code should simply use specbind() and unbind_to().		*/
+/* Most C code should simply use specbind() and unbind_to_1().		*/
 /* When performance is critical, use the macros in backtrace.h.		*/
 /************************************************************************/
 #define min_max_specpdl_size 400
 symbol_value_buffer_local_info (symbol, current_buffer);
 if (buffer_local == 0)
 {
 specpdl_ptr->old_value = find_symbol_value (symbol);
-specpdl_ptr->func = 0;      /* Handled specially by unbind_to */
+specpdl_ptr->func = 0;      /* Handled specially by unbind_to_1 */
 }
 else if (buffer_local > 0)
 {
 /* Already buffer-local */
 specpdl_ptr->old_value = noseeum_cons (Fcurrent_buffer (),
 specpdl_depth_counter++;
 Fset (symbol, value);
 }
-/* Note: As long as the unwind-protect exists, its arg is automatically
+/* Record an unwind-protect -- FUNCTION will be called with ARG no matter
-GCPRO'd. */
+whether a normal or non-local exit occurs. (You need to call unbind_to_1()
+before your function returns normally, passing in the integer returned
-void
+by this function.) Note: As long as the unwind-protect exists, ARG is
+automatically GCPRO'd.  The return value from FUNCTION is completely
+ignored. #### We should eliminate it entirely. */
+int
 record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg),
 Lisp_Object arg)
 {
 SPECPDL_RESERVE (1);
 specpdl_ptr->func = function;
 specpdl_ptr->symbol = Qnil;
 specpdl_ptr->old_value = arg;
 specpdl_ptr++;
 specpdl_depth_counter++;
-}
+return specpdl_depth_counter - 1;
+}
-extern int check_sigio (void);
+static Lisp_Object
+free_pointer (Lisp_Object opaque)
+{
+xfree (get_opaque_ptr (opaque));
+free_opaque_ptr (opaque);
+return Qnil;
+}
+/* Establish an unwind-protect which will free the specified block.
+*/
+int
+record_unwind_protect_freeing (void *ptr)
+{
+Lisp_Object opaque = make_opaque_ptr (ptr);
+return record_unwind_protect (free_pointer, opaque);
+}
+static Lisp_Object
+free_dynarr (Lisp_Object opaque)
+{
+Dynarr_free (get_opaque_ptr (opaque));
+free_opaque_ptr (opaque);
+return Qnil;
+}
+int
+record_unwind_protect_freeing_dynarr (void *ptr)
+{
+Lisp_Object opaque = make_opaque_ptr (ptr);
+return record_unwind_protect (free_dynarr, opaque);
+}
 /* Unwind the stack till specpdl_depth() == COUNT.
 VALUE is not used, except that, purely as a convenience to the
-caller, it is protected from garbage-protection. */
+caller, it is protected from garbage-protection and returned. */
 Lisp_Object
-unbind_to (int count, Lisp_Object value)
+unbind_to_1 (int count, Lisp_Object value)
 {
 UNBIND_TO_GCPRO (count, value);
 return value;
 }
 /* Don't call this directly.
 Only for use by UNBIND_TO* macros in backtrace.h */
 void
 unbind_to_hairy (int count)
 {
-int quitf;
+Lisp_Object oquit;
 ++specpdl_ptr;
 ++specpdl_depth_counter;
+/* Allow QUIT within unwind-protect routines, but defer any existing QUIT
+until afterwards. */
 check_quit (); /* make Vquit_flag accurate */
-quitf = !NILP (Vquit_flag);
+oquit = Vquit_flag;
 Vquit_flag = Qnil;
 while (specpdl_depth_counter != count)
 {
 --specpdl_ptr;
 /* Don't mess with gcprolist, backtrace_list here */
 }
 #endif
 #endif
 }
-if (quitf)
+Vquit_flag = oquit;
-Vquit_flag = Qt;
 }
 /* Get the value of symbol's global binding, even if that binding is
 {
 Lisp_Object obj;
 va_list args;
 va_start (args, fmt);
-obj = emacs_doprnt_string_va ((const Intbyte *) GETTEXT (fmt),
+obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
-				Qnil, -1, args);
 va_end (args);
 warn_when_safe_lispobj (class, level, obj);
 }
 DEFSUBR (Fbacktrace);
 DEFSUBR (Fbacktrace_frame);
 }
 void
-reinit_eval (void)
+init_eval_early (void)
 {
 specpdl_ptr = specpdl;
 specpdl_depth_counter = 0;
 catchlist = 0;
 Vcondition_handlers = Qnil;
 a `condition-case'.
 If the value is a list, an error only means to enter the debugger
 if one of its condition symbols appears in the list.
 This variable is overridden by `debug-ignored-errors'.
 See also variables `debug-on-quit' and `debug-on-signal'.
+If this variable is set while XEmacs is running noninteractively,
+an unhandled error will cause a backtrace to be output and the C
+debugger entered using `force-debugging-signal'.  This can be very
+useful when debugging noninteractive errors in tricky situations,
+e.g. makefiles, since you can set this variable using an environment
+variable, like this:
+\(using csh)      setenv XEMACSDEBUG '(setq debug-on-error t)'
+\(using bash)     export XEMACSDEBUG='(setq debug-on-error t)'
 */ );
 Vdebug_on_error = Qnil;
 DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal /*
 *Non-nil means enter debugger if an error is signalled.
 staticpro (&Vcurrent_warning_class);
 Vcurrent_warning_class = Qnil;
 staticpro (&Vcurrent_error_state);
 Vcurrent_error_state = Qnil; /* errors as normal */
+}
-reinit_eval ();
-}

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 771:943eaba38521