Mercurial > hg > xemacs-beta

comparison src/eval.c @ 4959:bd169a24a554

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Thu, 28 Jan 2010 04:27:30 -0600
parents 19a72041c5ed
children e813cf16c015
comparison
equal deleted inserted replaced
4893:99f2102552d7 4959:bd169a24a554
424 424
425 static void 425 static void
426 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) 426 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag))
427 { 427 {
428 Lisp_Subr *subr = XSUBR (obj); 428 Lisp_Subr *subr = XSUBR (obj);
429 const CIbyte *header = 429 const Ascbyte *header =
430 (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr "; 430 (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr ";
431 const CIbyte *name = subr_name (subr); 431 const Ascbyte *name = subr_name (subr);
432 const CIbyte *trailer = subr->prompt ? " (interactive)>" : ">"; 432 const Ascbyte *trailer = subr->prompt ? " (interactive)>" : ">";
433 433
434 if (print_readably) 434 if (print_readably)
435 printing_unreadable_object ("%s%s%s", header, name, trailer); 435 printing_unreadable_object ("%s%s%s", header, name, trailer);
436 436
437 write_c_string (printcharfun, header); 437 write_ascstring (printcharfun, header);
438 write_c_string (printcharfun, name); 438 write_ascstring (printcharfun, name);
439 write_c_string (printcharfun, trailer); 439 write_ascstring (printcharfun, trailer);
440 } 440 }
441 441
442 static const struct memory_description subr_description[] = { 442 static const struct memory_description subr_description[] = {
443 { XD_DOC_STRING, offsetof (Lisp_Subr, doc), 0, { 0 }, XD_FLAG_NO_KKCC }, 443 { XD_DOC_STRING, offsetof (Lisp_Subr, doc), 0, { 0 }, XD_FLAG_NO_KKCC },
444 { XD_END } 444 { XD_END }
736 specbind (Qstack_trace_on_error, Qnil); 736 specbind (Qstack_trace_on_error, Qnil);
737 specbind (Qdebug_on_signal, Qnil); 737 specbind (Qdebug_on_signal, Qnil);
738 specbind (Qstack_trace_on_signal, Qnil); 738 specbind (Qstack_trace_on_signal, Qnil);
739 739
740 if (!noninteractive) 740 if (!noninteractive)
741 internal_with_output_to_temp_buffer (build_string ("*Backtrace*"), 741 internal_with_output_to_temp_buffer (build_ascstring ("*Backtrace*"),
742 backtrace_259, 742 backtrace_259,
743 Qnil, 743 Qnil,
744 Qnil); 744 Qnil);
745 else /* in batch mode, we want this going to stderr. */ 745 else /* in batch mode, we want this going to stderr. */
746 backtrace_259 (Qnil); 746 backtrace_259 (Qnil);
778 specbind (Qstack_trace_on_error, Qnil); 778 specbind (Qstack_trace_on_error, Qnil);
779 specbind (Qdebug_on_signal, Qnil); 779 specbind (Qdebug_on_signal, Qnil);
780 specbind (Qstack_trace_on_signal, Qnil); 780 specbind (Qstack_trace_on_signal, Qnil);
781 781
782 if (!noninteractive) 782 if (!noninteractive)
783 internal_with_output_to_temp_buffer (build_string ("*Backtrace*"), 783 internal_with_output_to_temp_buffer (build_ascstring ("*Backtrace*"),
784 backtrace_259, 784 backtrace_259,
785 Qnil, 785 Qnil,
786 Qnil); 786 Qnil);
787 else /* in batch mode, we want this going to stderr. */ 787 else /* in batch mode, we want this going to stderr. */
788 backtrace_259 (Qnil); 788 backtrace_259 (Qnil);
2652 2652
2653 /* Out of REASON and FROB, return a list of elements suitable for passing 2653 /* Out of REASON and FROB, return a list of elements suitable for passing
2654 to signal_error_1(). */ 2654 to signal_error_1(). */
2655 2655
2656 Lisp_Object 2656 Lisp_Object
2657 build_error_data (const CIbyte *reason, Lisp_Object frob) 2657 build_error_data (const Ascbyte *reason, Lisp_Object frob)
2658 { 2658 {
2659 if (EQ (frob, Qunbound)) 2659 if (EQ (frob, Qunbound))
2660 frob = Qnil; 2660 frob = Qnil;
2661 else if (CONSP (frob) && EQ (XCAR (frob), Qunbound)) 2661 else if (CONSP (frob) && EQ (XCAR (frob), Qunbound))
2662 frob = XCDR (frob); 2662 frob = XCDR (frob);
2667 else 2667 else
2668 return Fcons (build_msg_string (reason), frob); 2668 return Fcons (build_msg_string (reason), frob);
2669 } 2669 }
2670 2670
2671 DOESNT_RETURN 2671 DOESNT_RETURN
2672 signal_error (Lisp_Object type, const CIbyte *reason, Lisp_Object frob) 2672 signal_error (Lisp_Object type, const Ascbyte *reason, Lisp_Object frob)
2673 { 2673 {
2674 signal_error_1 (type, build_error_data (reason, frob)); 2674 signal_error_1 (type, build_error_data (reason, frob));
2675 } 2675 }
2676 2676
2677 void 2677 void
2678 maybe_signal_error (Lisp_Object type, const CIbyte *reason, 2678 maybe_signal_error (Lisp_Object type, const Ascbyte *reason,
2679 Lisp_Object frob, Lisp_Object class_, 2679 Lisp_Object frob, Lisp_Object class_,
2680 Error_Behavior errb) 2680 Error_Behavior errb)
2681 { 2681 {
2682 /* Optimization: */ 2682 /* Optimization: */
2683 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2683 if (ERRB_EQ (errb, ERROR_ME_NOT))
2684 return; 2684 return;
2685 maybe_signal_error_1 (type, build_error_data (reason, frob), class_, errb); 2685 maybe_signal_error_1 (type, build_error_data (reason, frob), class_, errb);
2686 } 2686 }
2687 2687
2688 Lisp_Object 2688 Lisp_Object
2689 signal_continuable_error (Lisp_Object type, const CIbyte *reason, 2689 signal_continuable_error (Lisp_Object type, const Ascbyte *reason,
2690 Lisp_Object frob) 2690 Lisp_Object frob)
2691 { 2691 {
2692 return Fsignal (type, build_error_data (reason, frob)); 2692 return Fsignal (type, build_error_data (reason, frob));
2693 } 2693 }
2694 2694
2695 Lisp_Object 2695 Lisp_Object
2696 maybe_signal_continuable_error (Lisp_Object type, const CIbyte *reason, 2696 maybe_signal_continuable_error (Lisp_Object type, const Ascbyte *reason,
2697 Lisp_Object frob, Lisp_Object class_, 2697 Lisp_Object frob, Lisp_Object class_,
2698 Error_Behavior errb) 2698 Error_Behavior errb)
2699 { 2699 {
2700 /* Optimization: */ 2700 /* Optimization: */
2701 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2701 if (ERRB_EQ (errb, ERROR_ME_NOT))
2713 is three objects, a string and two related Lisp objects. 2713 is three objects, a string and two related Lisp objects.
2714 (The equivalent could be accomplished using the class 2 functions, 2714 (The equivalent could be accomplished using the class 2 functions,
2715 but these are more convenient in this particular case.) */ 2715 but these are more convenient in this particular case.) */
2716 2716
2717 DOESNT_RETURN 2717 DOESNT_RETURN
2718 signal_error_2 (Lisp_Object type, const CIbyte *reason, 2718 signal_error_2 (Lisp_Object type, const Ascbyte *reason,
2719 Lisp_Object frob0, Lisp_Object frob1) 2719 Lisp_Object frob0, Lisp_Object frob1)
2720 { 2720 {
2721 signal_error_1 (type, list3 (build_msg_string (reason), frob0, 2721 signal_error_1 (type, list3 (build_msg_string (reason), frob0,
2722 frob1)); 2722 frob1));
2723 } 2723 }
2724 2724
2725 void 2725 void
2726 maybe_signal_error_2 (Lisp_Object type, const CIbyte *reason, 2726 maybe_signal_error_2 (Lisp_Object type, const Ascbyte *reason,
2727 Lisp_Object frob0, Lisp_Object frob1, 2727 Lisp_Object frob0, Lisp_Object frob1,
2728 Lisp_Object class_, Error_Behavior errb) 2728 Lisp_Object class_, Error_Behavior errb)
2729 { 2729 {
2730 /* Optimization: */ 2730 /* Optimization: */
2731 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2731 if (ERRB_EQ (errb, ERROR_ME_NOT))
2733 maybe_signal_error_1 (type, list3 (build_msg_string (reason), frob0, 2733 maybe_signal_error_1 (type, list3 (build_msg_string (reason), frob0,
2734 frob1), class_, errb); 2734 frob1), class_, errb);
2735 } 2735 }
2736 2736
2737 Lisp_Object 2737 Lisp_Object
2738 signal_continuable_error_2 (Lisp_Object type, const CIbyte *reason, 2738 signal_continuable_error_2 (Lisp_Object type, const Ascbyte *reason,
2739 Lisp_Object frob0, Lisp_Object frob1) 2739 Lisp_Object frob0, Lisp_Object frob1)
2740 { 2740 {
2741 return Fsignal (type, list3 (build_msg_string (reason), frob0, 2741 return Fsignal (type, list3 (build_msg_string (reason), frob0,
2742 frob1)); 2742 frob1));
2743 } 2743 }
2744 2744
2745 Lisp_Object 2745 Lisp_Object
2746 maybe_signal_continuable_error_2 (Lisp_Object type, const CIbyte *reason, 2746 maybe_signal_continuable_error_2 (Lisp_Object type, const Ascbyte *reason,
2747 Lisp_Object frob0, Lisp_Object frob1, 2747 Lisp_Object frob0, Lisp_Object frob1,
2748 Lisp_Object class_, Error_Behavior errb) 2748 Lisp_Object class_, Error_Behavior errb)
2749 { 2749 {
2750 /* Optimization: */ 2750 /* Optimization: */
2751 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2751 if (ERRB_EQ (errb, ERROR_ME_NOT))
2761 /* Class 4: Printf-like functions that signal an error. 2761 /* Class 4: Printf-like functions that signal an error.
2762 These functions signal an error of a specified type, whose data 2762 These functions signal an error of a specified type, whose data
2763 is a single string, created using the arguments. */ 2763 is a single string, created using the arguments. */
2764 2764
2765 DOESNT_RETURN 2765 DOESNT_RETURN
2766 signal_ferror (Lisp_Object type, const CIbyte *fmt, ...) 2766 signal_ferror (Lisp_Object type, const Ascbyte *fmt, ...)
2767 { 2767 {
2768 Lisp_Object obj; 2768 Lisp_Object obj;
2769 va_list args; 2769 va_list args;
2770 2770
2771 va_start (args, fmt); 2771 va_start (args, fmt);
2772 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2772 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2773 va_end (args); 2773 va_end (args);
2774 2774
2775 /* Fsignal GC-protects its args */ 2775 /* Fsignal GC-protects its args */
2776 signal_error (type, 0, obj); 2776 signal_error (type, 0, obj);
2777 } 2777 }
2778 2778
2779 void 2779 void
2780 maybe_signal_ferror (Lisp_Object type, Lisp_Object class_, Error_Behavior errb, 2780 maybe_signal_ferror (Lisp_Object type, Lisp_Object class_, Error_Behavior errb,
2781 const CIbyte *fmt, ...) 2781 const Ascbyte *fmt, ...)
2782 { 2782 {
2783 Lisp_Object obj; 2783 Lisp_Object obj;
2784 va_list args; 2784 va_list args;
2785 2785
2786 /* Optimization: */ 2786 /* Optimization: */
2787 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2787 if (ERRB_EQ (errb, ERROR_ME_NOT))
2788 return; 2788 return;
2789 2789
2790 va_start (args, fmt); 2790 va_start (args, fmt);
2791 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2791 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2792 va_end (args); 2792 va_end (args);
2793 2793
2794 /* Fsignal GC-protects its args */ 2794 /* Fsignal GC-protects its args */
2795 maybe_signal_error (type, 0, obj, class_, errb); 2795 maybe_signal_error (type, 0, obj, class_, errb);
2796 } 2796 }
2797 2797
2798 Lisp_Object 2798 Lisp_Object
2799 signal_continuable_ferror (Lisp_Object type, const CIbyte *fmt, ...) 2799 signal_continuable_ferror (Lisp_Object type, const Ascbyte *fmt, ...)
2800 { 2800 {
2801 Lisp_Object obj; 2801 Lisp_Object obj;
2802 va_list args; 2802 va_list args;
2803 2803
2804 va_start (args, fmt); 2804 va_start (args, fmt);
2805 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2805 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2806 va_end (args); 2806 va_end (args);
2807 2807
2808 /* Fsignal GC-protects its args */ 2808 /* Fsignal GC-protects its args */
2809 return Fsignal (type, list1 (obj)); 2809 return Fsignal (type, list1 (obj));
2810 } 2810 }
2811 2811
2812 Lisp_Object 2812 Lisp_Object
2813 maybe_signal_continuable_ferror (Lisp_Object type, Lisp_Object class_, 2813 maybe_signal_continuable_ferror (Lisp_Object type, Lisp_Object class_,
2814 Error_Behavior errb, const CIbyte *fmt, ...) 2814 Error_Behavior errb, const Ascbyte *fmt, ...)
2815 { 2815 {
2816 Lisp_Object obj; 2816 Lisp_Object obj;
2817 va_list args; 2817 va_list args;
2818 2818
2819 /* Optimization: */ 2819 /* Optimization: */
2820 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2820 if (ERRB_EQ (errb, ERROR_ME_NOT))
2821 return Qnil; 2821 return Qnil;
2822 2822
2823 va_start (args, fmt); 2823 va_start (args, fmt);
2824 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2824 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2825 va_end (args); 2825 va_end (args);
2826 2826
2827 /* Fsignal GC-protects its args */ 2827 /* Fsignal GC-protects its args */
2828 return maybe_signal_continuable_error (type, 0, obj, class_, errb); 2828 return maybe_signal_continuable_error (type, 0, obj, class_, errb);
2829 } 2829 }
2842 elements, the first of which is Qunbound), and these functions are 2842 elements, the first of which is Qunbound), and these functions are
2843 not commonly used. 2843 not commonly used.
2844 */ 2844 */
2845 2845
2846 DOESNT_RETURN 2846 DOESNT_RETURN
2847 signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob, const CIbyte *fmt, 2847 signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob, const Ascbyte *fmt,
2848 ...) 2848 ...)
2849 { 2849 {
2850 Lisp_Object obj; 2850 Lisp_Object obj;
2851 va_list args; 2851 va_list args;
2852 2852
2853 va_start (args, fmt); 2853 va_start (args, fmt);
2854 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2854 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2855 va_end (args); 2855 va_end (args);
2856 2856
2857 /* Fsignal GC-protects its args */ 2857 /* Fsignal GC-protects its args */
2858 signal_error_1 (type, Fcons (obj, build_error_data (0, frob))); 2858 signal_error_1 (type, Fcons (obj, build_error_data (0, frob)));
2859 } 2859 }
2860 2860
2861 void 2861 void
2862 maybe_signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob, 2862 maybe_signal_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
2863 Lisp_Object class_, Error_Behavior errb, 2863 Lisp_Object class_, Error_Behavior errb,
2864 const CIbyte *fmt, ...) 2864 const Ascbyte *fmt, ...)
2865 { 2865 {
2866 Lisp_Object obj; 2866 Lisp_Object obj;
2867 va_list args; 2867 va_list args;
2868 2868
2869 /* Optimization: */ 2869 /* Optimization: */
2870 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2870 if (ERRB_EQ (errb, ERROR_ME_NOT))
2871 return; 2871 return;
2872 2872
2873 va_start (args, fmt); 2873 va_start (args, fmt);
2874 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2874 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2875 va_end (args); 2875 va_end (args);
2876 2876
2877 /* Fsignal GC-protects its args */ 2877 /* Fsignal GC-protects its args */
2878 maybe_signal_error_1 (type, Fcons (obj, build_error_data (0, frob)), class_, 2878 maybe_signal_error_1 (type, Fcons (obj, build_error_data (0, frob)), class_,
2879 errb); 2879 errb);
2880 } 2880 }
2881 2881
2882 Lisp_Object 2882 Lisp_Object
2883 signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob, 2883 signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
2884 const CIbyte *fmt, ...) 2884 const Ascbyte *fmt, ...)
2885 { 2885 {
2886 Lisp_Object obj; 2886 Lisp_Object obj;
2887 va_list args; 2887 va_list args;
2888 2888
2889 va_start (args, fmt); 2889 va_start (args, fmt);
2890 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2890 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2891 va_end (args); 2891 va_end (args);
2892 2892
2893 /* Fsignal GC-protects its args */ 2893 /* Fsignal GC-protects its args */
2894 return Fsignal (type, Fcons (obj, build_error_data (0, frob))); 2894 return Fsignal (type, Fcons (obj, build_error_data (0, frob)));
2895 } 2895 }
2896 2896
2897 Lisp_Object 2897 Lisp_Object
2898 maybe_signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob, 2898 maybe_signal_continuable_ferror_with_frob (Lisp_Object type, Lisp_Object frob,
2899 Lisp_Object class_, 2899 Lisp_Object class_,
2900 Error_Behavior errb, 2900 Error_Behavior errb,
2901 const CIbyte *fmt, ...) 2901 const Ascbyte *fmt, ...)
2902 { 2902 {
2903 Lisp_Object obj; 2903 Lisp_Object obj;
2904 va_list args; 2904 va_list args;
2905 2905
2906 /* Optimization: */ 2906 /* Optimization: */
2907 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2907 if (ERRB_EQ (errb, ERROR_ME_NOT))
2908 return Qnil; 2908 return Qnil;
2909 2909
2910 va_start (args, fmt); 2910 va_start (args, fmt);
2911 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 2911 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
2912 va_end (args); 2912 va_end (args);
2913 2913
2914 /* Fsignal GC-protects its args */ 2914 /* Fsignal GC-protects its args */
2915 return maybe_signal_continuable_error_1 (type, 2915 return maybe_signal_continuable_error_1 (type,
2916 Fcons (obj, 2916 Fcons (obj,
2985 signal_error (Qcircular_property_list, 0, list); 2985 signal_error (Qcircular_property_list, 0, list);
2986 } 2986 }
2987 2987
2988 /* Called from within emacs_doprnt_1, so REASON is not formatted. */ 2988 /* Called from within emacs_doprnt_1, so REASON is not formatted. */
2989 DOESNT_RETURN 2989 DOESNT_RETURN
2990 syntax_error (const CIbyte *reason, Lisp_Object frob) 2990 syntax_error (const Ascbyte *reason, Lisp_Object frob)
2991 { 2991 {
2992 signal_error (Qsyntax_error, reason, frob); 2992 signal_error (Qsyntax_error, reason, frob);
2993 } 2993 }
2994 2994
2995 DOESNT_RETURN 2995 DOESNT_RETURN
2996 syntax_error_2 (const CIbyte *reason, Lisp_Object frob1, Lisp_Object frob2) 2996 syntax_error_2 (const Ascbyte *reason, Lisp_Object frob1, Lisp_Object frob2)
2997 { 2997 {
2998 signal_error_2 (Qsyntax_error, reason, frob1, frob2); 2998 signal_error_2 (Qsyntax_error, reason, frob1, frob2);
2999 } 2999 }
3000 3000
3001 void 3001 void
3002 maybe_syntax_error (const CIbyte *reason, Lisp_Object frob, 3002 maybe_syntax_error (const Ascbyte *reason, Lisp_Object frob,
3003 Lisp_Object class_, Error_Behavior errb) 3003 Lisp_Object class_, Error_Behavior errb)
3004 { 3004 {
3005 maybe_signal_error (Qsyntax_error, reason, frob, class_, errb); 3005 maybe_signal_error (Qsyntax_error, reason, frob, class_, errb);
3006 } 3006 }
3007 3007
3008 DOESNT_RETURN 3008 DOESNT_RETURN
3009 sferror (const CIbyte *reason, Lisp_Object frob) 3009 sferror (const Ascbyte *reason, Lisp_Object frob)
3010 { 3010 {
3011 signal_error (Qstructure_formation_error, reason, frob); 3011 signal_error (Qstructure_formation_error, reason, frob);
3012 } 3012 }
3013 3013
3014 DOESNT_RETURN 3014 DOESNT_RETURN
3015 sferror_2 (const CIbyte *reason, Lisp_Object frob1, Lisp_Object frob2) 3015 sferror_2 (const Ascbyte *reason, Lisp_Object frob1, Lisp_Object frob2)
3016 { 3016 {
3017 signal_error_2 (Qstructure_formation_error, reason, frob1, frob2); 3017 signal_error_2 (Qstructure_formation_error, reason, frob1, frob2);
3018 } 3018 }
3019 3019
3020 void 3020 void
3021 maybe_sferror (const CIbyte *reason, Lisp_Object frob, 3021 maybe_sferror (const Ascbyte *reason, Lisp_Object frob,
3022 Lisp_Object class_, Error_Behavior errb) 3022 Lisp_Object class_, Error_Behavior errb)
3023 { 3023 {
3024 maybe_signal_error (Qstructure_formation_error, reason, frob, class_, errb); 3024 maybe_signal_error (Qstructure_formation_error, reason, frob, class_, errb);
3025 } 3025 }
3026 3026
3027 DOESNT_RETURN 3027 DOESNT_RETURN
3028 invalid_argument (const CIbyte *reason, Lisp_Object frob) 3028 invalid_argument (const Ascbyte *reason, Lisp_Object frob)
3029 { 3029 {
3030 signal_error (Qinvalid_argument, reason, frob); 3030 signal_error (Qinvalid_argument, reason, frob);
3031 } 3031 }
3032 3032
3033 DOESNT_RETURN 3033 DOESNT_RETURN
3034 invalid_argument_2 (const CIbyte *reason, Lisp_Object frob1, 3034 invalid_argument_2 (const Ascbyte *reason, Lisp_Object frob1,
3035 Lisp_Object frob2) 3035 Lisp_Object frob2)
3036 { 3036 {
3037 signal_error_2 (Qinvalid_argument, reason, frob1, frob2); 3037 signal_error_2 (Qinvalid_argument, reason, frob1, frob2);
3038 } 3038 }
3039 3039
3040 void 3040 void
3041 maybe_invalid_argument (const CIbyte *reason, Lisp_Object frob, 3041 maybe_invalid_argument (const Ascbyte *reason, Lisp_Object frob,
3042 Lisp_Object class_, Error_Behavior errb) 3042 Lisp_Object class_, Error_Behavior errb)
3043 { 3043 {
3044 maybe_signal_error (Qinvalid_argument, reason, frob, class_, errb); 3044 maybe_signal_error (Qinvalid_argument, reason, frob, class_, errb);
3045 } 3045 }
3046 3046
3047 DOESNT_RETURN 3047 DOESNT_RETURN
3048 invalid_constant (const CIbyte *reason, Lisp_Object frob) 3048 invalid_constant (const Ascbyte *reason, Lisp_Object frob)
3049 { 3049 {
3050 signal_error (Qinvalid_constant, reason, frob); 3050 signal_error (Qinvalid_constant, reason, frob);
3051 } 3051 }
3052 3052
3053 DOESNT_RETURN 3053 DOESNT_RETURN
3054 invalid_constant_2 (const CIbyte *reason, Lisp_Object frob1, 3054 invalid_constant_2 (const Ascbyte *reason, Lisp_Object frob1,
3055 Lisp_Object frob2) 3055 Lisp_Object frob2)
3056 { 3056 {
3057 signal_error_2 (Qinvalid_constant, reason, frob1, frob2); 3057 signal_error_2 (Qinvalid_constant, reason, frob1, frob2);
3058 } 3058 }
3059 3059
3060 void 3060 void
3061 maybe_invalid_constant (const CIbyte *reason, Lisp_Object frob, 3061 maybe_invalid_constant (const Ascbyte *reason, Lisp_Object frob,
3062 Lisp_Object class_, Error_Behavior errb) 3062 Lisp_Object class_, Error_Behavior errb)
3063 { 3063 {
3064 maybe_signal_error (Qinvalid_constant, reason, frob, class_, errb); 3064 maybe_signal_error (Qinvalid_constant, reason, frob, class_, errb);
3065 } 3065 }
3066 3066
3067 DOESNT_RETURN 3067 DOESNT_RETURN
3068 invalid_operation (const CIbyte *reason, Lisp_Object frob) 3068 invalid_operation (const Ascbyte *reason, Lisp_Object frob)
3069 { 3069 {
3070 signal_error (Qinvalid_operation, reason, frob); 3070 signal_error (Qinvalid_operation, reason, frob);
3071 } 3071 }
3072 3072
3073 DOESNT_RETURN 3073 DOESNT_RETURN
3074 invalid_operation_2 (const CIbyte *reason, Lisp_Object frob1, 3074 invalid_operation_2 (const Ascbyte *reason, Lisp_Object frob1,
3075 Lisp_Object frob2) 3075 Lisp_Object frob2)
3076 { 3076 {
3077 signal_error_2 (Qinvalid_operation, reason, frob1, frob2); 3077 signal_error_2 (Qinvalid_operation, reason, frob1, frob2);
3078 } 3078 }
3079 3079
3080 void 3080 void
3081 maybe_invalid_operation (const CIbyte *reason, Lisp_Object frob, 3081 maybe_invalid_operation (const Ascbyte *reason, Lisp_Object frob,
3082 Lisp_Object class_, Error_Behavior errb) 3082 Lisp_Object class_, Error_Behavior errb)
3083 { 3083 {
3084 maybe_signal_error (Qinvalid_operation, reason, frob, class_, errb); 3084 maybe_signal_error (Qinvalid_operation, reason, frob, class_, errb);
3085 } 3085 }
3086 3086
3087 DOESNT_RETURN 3087 DOESNT_RETURN
3088 invalid_change (const CIbyte *reason, Lisp_Object frob) 3088 invalid_change (const Ascbyte *reason, Lisp_Object frob)
3089 { 3089 {
3090 signal_error (Qinvalid_change, reason, frob); 3090 signal_error (Qinvalid_change, reason, frob);
3091 } 3091 }
3092 3092
3093 DOESNT_RETURN 3093 DOESNT_RETURN
3094 invalid_change_2 (const CIbyte *reason, Lisp_Object frob1, Lisp_Object frob2) 3094 invalid_change_2 (const Ascbyte *reason, Lisp_Object frob1, Lisp_Object frob2)
3095 { 3095 {
3096 signal_error_2 (Qinvalid_change, reason, frob1, frob2); 3096 signal_error_2 (Qinvalid_change, reason, frob1, frob2);
3097 } 3097 }
3098 3098
3099 void 3099 void
3100 maybe_invalid_change (const CIbyte *reason, Lisp_Object frob, 3100 maybe_invalid_change (const Ascbyte *reason, Lisp_Object frob,
3101 Lisp_Object class_, Error_Behavior errb) 3101 Lisp_Object class_, Error_Behavior errb)
3102 { 3102 {
3103 maybe_signal_error (Qinvalid_change, reason, frob, class_, errb); 3103 maybe_signal_error (Qinvalid_change, reason, frob, class_, errb);
3104 } 3104 }
3105 3105
3106 DOESNT_RETURN 3106 DOESNT_RETURN
3107 invalid_state (const CIbyte *reason, Lisp_Object frob) 3107 invalid_state (const Ascbyte *reason, Lisp_Object frob)
3108 { 3108 {
3109 signal_error (Qinvalid_state, reason, frob); 3109 signal_error (Qinvalid_state, reason, frob);
3110 } 3110 }
3111 3111
3112 DOESNT_RETURN 3112 DOESNT_RETURN
3113 invalid_state_2 (const CIbyte *reason, Lisp_Object frob1, Lisp_Object frob2) 3113 invalid_state_2 (const Ascbyte *reason, Lisp_Object frob1, Lisp_Object frob2)
3114 { 3114 {
3115 signal_error_2 (Qinvalid_state, reason, frob1, frob2); 3115 signal_error_2 (Qinvalid_state, reason, frob1, frob2);
3116 } 3116 }
3117 3117
3118 void 3118 void
3119 maybe_invalid_state (const CIbyte *reason, Lisp_Object frob, 3119 maybe_invalid_state (const Ascbyte *reason, Lisp_Object frob,
3120 Lisp_Object class_, Error_Behavior errb) 3120 Lisp_Object class_, Error_Behavior errb)
3121 { 3121 {
3122 maybe_signal_error (Qinvalid_state, reason, frob, class_, errb); 3122 maybe_signal_error (Qinvalid_state, reason, frob, class_, errb);
3123 } 3123 }
3124 3124
3125 DOESNT_RETURN 3125 DOESNT_RETURN
3126 wtaerror (const CIbyte *reason, Lisp_Object frob) 3126 wtaerror (const Ascbyte *reason, Lisp_Object frob)
3127 { 3127 {
3128 signal_error (Qwrong_type_argument, reason, frob); 3128 signal_error (Qwrong_type_argument, reason, frob);
3129 } 3129 }
3130 3130
3131 DOESNT_RETURN 3131 DOESNT_RETURN
3132 stack_overflow (const CIbyte *reason, Lisp_Object frob) 3132 stack_overflow (const Ascbyte *reason, Lisp_Object frob)
3133 { 3133 {
3134 signal_error (Qstack_overflow, reason, frob); 3134 signal_error (Qstack_overflow, reason, frob);
3135 } 3135 }
3136 3136
3137 DOESNT_RETURN 3137 DOESNT_RETURN
3138 out_of_memory (const CIbyte *reason, Lisp_Object frob) 3138 out_of_memory (const Ascbyte *reason, Lisp_Object frob)
3139 { 3139 {
3140 signal_error (Qout_of_memory, reason, frob); 3140 signal_error (Qout_of_memory, reason, frob);
3141 } 3141 }
3142 3142
3143 3143
4570 printing_unreadable_object ("multiple values"); 4570 printing_unreadable_object ("multiple values");
4571 } 4571 }
4572 4572
4573 if (0 == count) 4573 if (0 == count)
4574 { 4574 {
4575 write_c_string (printcharfun, "#<zero-length multiple value>"); 4575 write_msg_string (printcharfun, "#<zero-length multiple value>");
4576 } 4576 }
4577 4577
4578 for (index = 0; index < count;) 4578 for (index = 0; index < count;)
4579 { 4579 {
4580 if (index != 0 && 4580 if (index != 0 &&
4592 4592
4593 ++index; 4593 ++index;
4594 4594
4595 if (count > 1 && index < count) 4595 if (count > 1 && index < count)
4596 { 4596 {
4597 write_c_string (printcharfun, " ;\n"); 4597 write_ascstring (printcharfun, " ;\n");
4598 } 4598 }
4599 } 4599 }
4600 } 4600 }
4601 4601
4602 static Lisp_Object 4602 static Lisp_Object
5711 Lisp_Object errstr = 5711 Lisp_Object errstr =
5712 emacs_sprintf_string_lisp 5712 emacs_sprintf_string_lisp
5713 ("%s: Attempt to throw outside of function:" 5713 ("%s: Attempt to throw outside of function:"
5714 "To catch `%s' with value `%s'\n\nBacktrace follows:\n\n%s", 5714 "To catch `%s' with value `%s'\n\nBacktrace follows:\n\n%s",
5715 Qnil, 4, 5715 Qnil, 4,
5716 build_msg_string (warning_string ? warning_string : "error"), 5716 build_msg_cistring (warning_string ? warning_string : "error"),
5717 p->thrown_tag, p->thrown_value, p->backtrace); 5717 p->thrown_tag, p->thrown_value, p->backtrace);
5718 warn_when_safe_lispobj (Qerror, current_warning_level (), errstr); 5718 warn_when_safe_lispobj (Qerror, current_warning_level (), errstr);
5719 } 5719 }
5720 else if (p->caught_error && !EQ (p->error_conditions, Qquit)) 5720 else if (p->caught_error && !EQ (p->error_conditions, Qquit))
5721 { 5721 {
5726 but that stuff is all in Lisp currently. */ 5726 but that stuff is all in Lisp currently. */
5727 errstr = 5727 errstr =
5728 emacs_sprintf_string_lisp 5728 emacs_sprintf_string_lisp
5729 ("%s: (%s %s)\n\nBacktrace follows:\n\n%s", 5729 ("%s: (%s %s)\n\nBacktrace follows:\n\n%s",
5730 Qnil, 4, 5730 Qnil, 4,
5731 build_msg_string (warning_string ? warning_string : "error"), 5731 build_msg_cistring (warning_string ? warning_string : "error"),
5732 p->error_conditions, p->data, p->backtrace); 5732 p->error_conditions, p->data, p->backtrace);
5733 5733
5734 warn_when_safe_lispobj (warning_class, current_warning_level (), 5734 warn_when_safe_lispobj (warning_class, current_warning_level (),
5735 errstr); 5735 errstr);
5736 } 5736 }
6998 { 6998 {
6999 if (specpdl[speccount - 1].func == 0 6999 if (specpdl[speccount - 1].func == 0
7000 || specpdl[speccount - 1].func == specbind_unwind_local 7000 || specpdl[speccount - 1].func == specbind_unwind_local
7001 || specpdl[speccount - 1].func == specbind_unwind_wasnt_local) 7001 || specpdl[speccount - 1].func == specbind_unwind_wasnt_local)
7002 { 7002 {
7003 write_c_string (stream, !printing_bindings ? " # bind (" : " "); 7003 write_ascstring (stream, !printing_bindings ? " # bind (" : " ");
7004 Fprin1 (specpdl[speccount - 1].symbol, stream); 7004 Fprin1 (specpdl[speccount - 1].symbol, stream);
7005 printing_bindings = 1; 7005 printing_bindings = 1;
7006 } 7006 }
7007 else 7007 else
7008 { 7008 {
7009 if (printing_bindings) write_c_string (stream, ")\n"); 7009 if (printing_bindings) write_ascstring (stream, ")\n");
7010 write_c_string (stream, " # (unwind-protect ...)\n"); 7010 write_ascstring (stream, " # (unwind-protect ...)\n");
7011 printing_bindings = 0; 7011 printing_bindings = 0;
7012 } 7012 }
7013 } 7013 }
7014 if (printing_bindings) write_c_string (stream, ")\n"); 7014 if (printing_bindings) write_ascstring (stream, ")\n");
7015 } 7015 }
7016 7016
7017 static Lisp_Object 7017 static Lisp_Object
7018 backtrace_unevalled_args (Lisp_Object *args) 7018 backtrace_unevalled_args (Lisp_Object *args)
7019 { 7019 {
7020 if (args) 7020 if (args)
7021 return *args; 7021 return *args;
7022 else 7022 else
7023 return list1 (build_string ("[internal]")); 7023 return list1 (build_ascstring ("[internal]"));
7024 } 7024 }
7025 7025
7026 DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* 7026 DEFUN ("backtrace", Fbacktrace, 0, 2, "", /*
7027 Print a trace of Lisp function calls currently active. 7027 Print a trace of Lisp function calls currently active.
7028 Optional arg STREAM specifies the output stream to send the backtrace to, 7028 Optional arg STREAM specifies the output stream to send the backtrace to,
7076 backtrace_specials (speccount, catchpdl, stream); 7076 backtrace_specials (speccount, catchpdl, stream);
7077 7077
7078 speccount = catches->pdlcount; 7078 speccount = catches->pdlcount;
7079 if (catchpdl == speccount) 7079 if (catchpdl == speccount)
7080 { 7080 {
7081 write_c_string (stream, " # (catch "); 7081 write_ascstring (stream, " # (catch ");
7082 Fprin1 (catches->tag, stream); 7082 Fprin1 (catches->tag, stream);
7083 write_c_string (stream, " ...)\n"); 7083 write_ascstring (stream, " ...)\n");
7084 } 7084 }
7085 else 7085 else
7086 { 7086 {
7087 write_c_string (stream, " # (condition-case ... . "); 7087 write_ascstring (stream, " # (condition-case ... . ");
7088 Fprin1 (Fcdr (Fcar (catches->tag)), stream); 7088 Fprin1 (Fcdr (Fcar (catches->tag)), stream);
7089 write_c_string (stream, ")\n"); 7089 write_ascstring (stream, ")\n");
7090 } 7090 }
7091 catches = catches->next; 7091 catches = catches->next;
7092 } 7092 }
7093 else if (!backlist) 7093 else if (!backlist)
7094 break; 7094 break;
7097 if (!NILP (detailed) && backlist->pdlcount < speccount) 7097 if (!NILP (detailed) && backlist->pdlcount < speccount)
7098 { 7098 {
7099 backtrace_specials (speccount, backlist->pdlcount, stream); 7099 backtrace_specials (speccount, backlist->pdlcount, stream);
7100 speccount = backlist->pdlcount; 7100 speccount = backlist->pdlcount;
7101 } 7101 }
7102 write_c_string (stream, backlist->debug_on_exit ? "* " : " "); 7102 write_ascstring (stream, backlist->debug_on_exit ? "* " : " ");
7103 if (backlist->nargs == UNEVALLED) 7103 if (backlist->nargs == UNEVALLED)
7104 { 7104 {
7105 Fprin1 (Fcons (*backlist->function, 7105 Fprin1 (Fcons (*backlist->function,
7106 backtrace_unevalled_args (backlist->args)), 7106 backtrace_unevalled_args (backlist->args)),
7107 stream); 7107 stream);
7108 write_c_string (stream, "\n"); /* from FSFmacs 19.30 */ 7108 write_ascstring (stream, "\n"); /* from FSFmacs 19.30 */
7109 } 7109 }
7110 else 7110 else
7111 { 7111 {
7112 Lisp_Object tem = *backlist->function; 7112 Lisp_Object tem = *backlist->function;
7113 Fprin1 (tem, stream); /* This can QUIT */ 7113 Fprin1 (tem, stream); /* This can QUIT */
7114 write_c_string (stream, "("); 7114 write_ascstring (stream, "(");
7115 if (backlist->nargs == MANY) 7115 if (backlist->nargs == MANY)
7116 { 7116 {
7117 int i; 7117 int i;
7118 Lisp_Object tail = Qnil; 7118 Lisp_Object tail = Qnil;
7119 struct gcpro ngcpro1; 7119 struct gcpro ngcpro1;
7121 NGCPRO1 (tail); 7121 NGCPRO1 (tail);
7122 for (tail = *backlist->args, i = 0; 7122 for (tail = *backlist->args, i = 0;
7123 !NILP (tail); 7123 !NILP (tail);
7124 tail = Fcdr (tail), i++) 7124 tail = Fcdr (tail), i++)
7125 { 7125 {
7126 if (i != 0) write_c_string (stream, " "); 7126 if (i != 0) write_ascstring (stream, " ");
7127 Fprin1 (Fcar (tail), stream); 7127 Fprin1 (Fcar (tail), stream);
7128 } 7128 }
7129 NUNGCPRO; 7129 NUNGCPRO;
7130 } 7130 }
7131 else 7131 else
7133 int i; 7133 int i;
7134 for (i = 0; i < backlist->nargs; i++) 7134 for (i = 0; i < backlist->nargs; i++)
7135 { 7135 {
7136 if (!i && EQ (tem, Qbyte_code)) 7136 if (!i && EQ (tem, Qbyte_code))
7137 { 7137 {
7138 write_c_string (stream, "\"...\""); 7138 write_ascstring (stream, "\"...\"");
7139 continue; 7139 continue;
7140 } 7140 }
7141 if (i != 0) write_c_string (stream, " "); 7141 if (i != 0) write_ascstring (stream, " ");
7142 Fprin1 (backlist->args[i], stream); 7142 Fprin1 (backlist->args[i], stream);
7143 } 7143 }
7144 } 7144 }
7145 write_c_string (stream, ")\n"); 7145 write_ascstring (stream, ")\n");
7146 } 7146 }
7147 backlist = backlist->next; 7147 backlist = backlist->next;
7148 } 7148 }
7149 } 7149 }
7150 Vprint_level = old_level; 7150 Vprint_level = old_level;
7232 An alternative approach is to just pass some non-string type of 7232 An alternative approach is to just pass some non-string type of
7233 Lisp_Object to warn_when_safe_lispobj(); `prin1-to-string' will 7233 Lisp_Object to warn_when_safe_lispobj(); `prin1-to-string' will
7234 automatically be called when it is safe to do so. */ 7234 automatically be called when it is safe to do so. */
7235 7235
7236 void 7236 void
7237 warn_when_safe (Lisp_Object class_, Lisp_Object level, const CIbyte *fmt, ...) 7237 warn_when_safe (Lisp_Object class_, Lisp_Object level, const Ascbyte *fmt, ...)
7238 { 7238 {
7239 Lisp_Object obj; 7239 Lisp_Object obj;
7240 va_list args; 7240 va_list args;
7241 7241
7242 if (warning_will_be_discarded (level)) 7242 if (warning_will_be_discarded (level))
7243 return; 7243 return;
7244 7244
7245 va_start (args, fmt); 7245 va_start (args, fmt);
7246 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 7246 obj = emacs_vsprintf_string (GETTEXT (fmt), args);
7247 va_end (args); 7247 va_end (args);
7248 7248
7249 warn_when_safe_lispobj (class_, level, obj); 7249 warn_when_safe_lispobj (class_, level, obj);
7250 } 7250 }
7251 7251