unicode-internal-commit: cleanup debug printing, add debug_out_lisp, updates to `debug-coding-detection'
Ben Wing
ben at xemacs.org
Tue Mar 23 08:20:25 EDT 2010
changeset: 5259:5b61ece2c903
branch: ben-unicode-internal
user: Ben Wing <ben at xemacs.org>
date: Sun Mar 07 03:15:54 2010 -0600
files: src/ChangeLog src/file-coding.c src/file-coding.h src/fileio.c src/lisp.h src/lread.c src/print.c
description:
cleanup debug printing, add debug_out_lisp, updates to `debug-coding-detection'
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-07 Ben Wing <ben at xemacs.org>
* file-coding.c (output_bytes_in_ascii_and_hex):
* file-coding.c (detect_coding_type):
* file-coding.c (undecided_init_coding_stream):
* file-coding.c (undecided_rewind_coding_stream):
Use debug_out* instead of stderr_out*, in case print-readably has
been set.
* file-coding.h:
* file-coding.h (LSTREAM_FL_NO_INIT_CHAR_MODE_WHEN_READING):
extern Vdebug_coding_detection.
* fileio.c:
* lread.c (Fload_internal):
during load-internal, insert-file-contents-internal and
write-region-internal, if `debug-coding-detection', show arguments
to all calls.
* lisp.h:
* print.c:
* print.c (fatal):
* print.c (ext_print_begin):
* print.c (debug_out_lisp):
* print.c (debug_backtrace):
* print.c (debug_short_backtrace):
Clean up and rearrange; add debug_out_lisp(), for printf-like
output involving Lisp objects.
diff -r 6e6fff6b506b -r 5b61ece2c903 src/ChangeLog
--- a/src/ChangeLog Sat Mar 06 21:18:38 2010 -0600
+++ b/src/ChangeLog Sun Mar 07 03:15:54 2010 -0600
@@ -1,3 +1,32 @@
+2010-03-07 Ben Wing <ben at xemacs.org>
+
+ * file-coding.c (output_bytes_in_ascii_and_hex):
+ * file-coding.c (detect_coding_type):
+ * file-coding.c (undecided_init_coding_stream):
+ * file-coding.c (undecided_rewind_coding_stream):
+ Use debug_out* instead of stderr_out*, in case print-readably has
+ been set.
+
+ * file-coding.h:
+ * file-coding.h (LSTREAM_FL_NO_INIT_CHAR_MODE_WHEN_READING):
+ extern Vdebug_coding_detection.
+
+ * fileio.c:
+ * lread.c (Fload_internal):
+ during load-internal, insert-file-contents-internal and
+ write-region-internal, if `debug-coding-detection', show arguments
+ to all calls.
+
+ * lisp.h:
+ * print.c:
+ * print.c (fatal):
+ * print.c (ext_print_begin):
+ * print.c (debug_out_lisp):
+ * print.c (debug_backtrace):
+ * print.c (debug_short_backtrace):
+ Clean up and rearrange; add debug_out_lisp(), for printf-like
+ output involving Lisp objects.
+
2010-03-06 Ben Wing <ben at xemacs.org>
* charset.h (struct Lisp_Charset):
diff -r 6e6fff6b506b -r 5b61ece2c903 src/file-coding.c
--- a/src/file-coding.c Sat Mar 06 21:18:38 2010 -0600
+++ b/src/file-coding.c Sun Mar 07 03:15:54 2010 -0600
@@ -3406,7 +3406,7 @@
eicpy_ext(eistr_hex, hex, Qbinary);
eicpy_ext(eistr_ascii, ascii, Qbinary);
- stderr_out ("%s %s", eidata(eistr_ascii), eidata(eistr_hex));
+ debug_out ("%s %s", eidata(eistr_ascii), eidata(eistr_hex));
}
#endif /* DEBUG_XEMACS */
@@ -3432,12 +3432,12 @@
if (!NILP (Vdebug_coding_detection))
{
int bytes = min (16, n);
- stderr_out ("detect_coding_type: processing %ld bytes\n", n);
- stderr_out ("First %d: ", bytes);
+ debug_out ("detect_coding_type: processing %ld bytes\n", n);
+ debug_out ("First %d: ", bytes);
output_bytes_in_ascii_and_hex (src, bytes);
- stderr_out ("\nLast %d: ", bytes);
+ debug_out ("\nLast %d: ", bytes);
output_bytes_in_ascii_and_hex (src + n - bytes, bytes);
- stderr_out ("\n");
+ debug_out ("\n");
}
#endif /* DEBUG_XEMACS */
if (!st->seen_non_ascii)
@@ -3461,12 +3461,12 @@
#ifdef DEBUG_XEMACS
if (!NILP (Vdebug_coding_detection))
{
- stderr_out ("seen_non_ascii: %d\n", st->seen_non_ascii);
+ debug_out ("seen_non_ascii: %d\n", st->seen_non_ascii);
if (coding_detector_category_count <= 0)
- stderr_out ("found %d detector categories\n",
+ debug_out ("found %d detector categories\n",
coding_detector_category_count);
for (i = 0; i < coding_detector_category_count; i++)
- stderr_out_lisp
+ debug_out_lisp
("%s: %s\n",
2,
coding_category_id_to_symbol (i),
@@ -3491,7 +3491,7 @@
#ifdef DEBUG_XEMACS
if (!NILP (Vdebug_coding_detection))
- stderr_out ("detect_coding_type: returning %d (%s)\n",
+ debug_out ("detect_coding_type: returning %d (%s)\n",
retval, retval ? "stop" : "keep going");
#endif /* DEBUG_XEMACS */
@@ -3898,7 +3898,7 @@
#ifdef DEBUG_XEMACS
if (!NILP (Vdebug_coding_detection))
- stderr_out_lisp ("detected coding system: %s\n", 1, data->actual);
+ debug_out_lisp ("detected coding system: %s\n", 1, data->actual);
#endif /* DEBUG_XEMACS */
}
diff -r 6e6fff6b506b -r 5b61ece2c903 src/file-coding.h
--- a/src/file-coding.h Sat Mar 06 21:18:38 2010 -0600
+++ b/src/file-coding.h Sun Mar 07 03:15:54 2010 -0600
@@ -1216,6 +1216,9 @@
Lisp_Object type,
Lisp_Object description,
Lisp_Object props);
+#ifdef DEBUG_XEMACS
+extern Lisp_Object Vdebug_coding_detection;
+#endif /* DEBUG_XEMACS */
#define LSTREAM_FL_NO_CLOSE_OTHER (1 << 16)
#define LSTREAM_FL_READ_ONE_BYTE_AT_A_TIME (1 << 17)
diff -r 6e6fff6b506b -r 5b61ece2c903 src/fileio.c
--- a/src/fileio.c Sat Mar 06 21:18:38 2010 -0600
+++ b/src/fileio.c Sun Mar 07 03:15:54 2010 -0600
@@ -2917,6 +2917,13 @@
GCPRO4 (filename, val, visit, curbuf);
+#ifdef DEBUG_XEMACS
+ if (!NILP (Vdebug_coding_detection))
+ debug_out_lisp
+ ("Called: (insert-file-contents-internal %s %s %s %s %s %s %s)\n",
+ 7, filename, visit, start, end, replace, codesys, used_codesys);
+#endif /* DEBUG_XEMACS */
+
mc_count = (NILP (replace)) ?
begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) :
begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf));
@@ -3363,11 +3370,18 @@
struct gcpro ngcpro1, ngcpro2;
Lisp_Object curbuf = wrap_buffer (current_buffer);
-
/* start, end, visit, and append are never modified in this fun
so we don't protect them. */
GCPRO5 (visit_file, filename, codesys, lockname, annotations);
NGCPRO2 (curbuf, fn);
+
+#ifdef DEBUG_XEMACS
+ if (!NILP (Vdebug_coding_detection))
+ debug_out_lisp
+ ("Called: (write-region-internal %s %s %s %s %s %s %s %s)\n",
+ 8, start, end, filename, append, visit, lockname, codesys,
+ mustbenew);
+#endif /* DEBUG_XEMACS */
/* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
we should signal an error rather than blissfully continuing
diff -r 6e6fff6b506b -r 5b61ece2c903 src/lisp.h
--- a/src/lisp.h Sat Mar 06 21:18:38 2010 -0600
+++ b/src/lisp.h Sun Mar 07 03:15:54 2010 -0600
@@ -6117,11 +6117,6 @@
/* Lower-level ways to output data: */
void default_object_printer (Lisp_Object, Lisp_Object, int);
void print_internal (Lisp_Object, Lisp_Object, int);
-void debug_print (Lisp_Object);
-void debug_p4 (Lisp_Object obj);
-void debug_p3 (Lisp_Object obj);
-void debug_short_backtrace (int);
-void debug_backtrace (void);
/* NOTE: Do not call this with the data of a Lisp_String. Use princ.
* Note: stream should be defaulted before calling
* (eg Qnil means stdout, not Vstandard_output, etc) */
@@ -6143,6 +6138,12 @@
void stdout_out (const CIbyte *, ...) PRINTF_ARGS (1, 2);
void external_out (int dest, const CIbyte *fmt, ...) PRINTF_ARGS (2, 3);
void debug_out (const CIbyte *, ...) PRINTF_ARGS (1, 2);
+void debug_out_lisp (const CIbyte *, int nargs, ...);
+void debug_print (Lisp_Object);
+void debug_p4 (Lisp_Object obj);
+void debug_p3 (Lisp_Object obj);
+void debug_short_backtrace (int);
+void debug_backtrace (void);
DECLARE_DOESNT_RETURN (fatal (const CIbyte *, ...)) PRINTF_ARGS(1, 2);
/* Internal functions: */
diff -r 6e6fff6b506b -r 5b61ece2c903 src/lread.c
--- a/src/lread.c Sat Mar 06 21:18:38 2010 -0600
+++ b/src/lread.c Sun Mar 07 03:15:54 2010 -0600
@@ -553,6 +553,13 @@
CHECK_STRING (file);
PROFILE_RECORD_ENTERING_SECTION (Qload_internal);
+
+#ifdef DEBUG_XEMACS
+ if (!NILP (Vdebug_coding_detection))
+ debug_out_lisp ("Called: (load-internal %s %s %s %s %s %s)\n",
+ 6, file, noerror, nomessage, nosuffix, codesys,
+ used_codesys);
+#endif /* DEBUG_XEMACS */
/* If file name is magic, call the handler. */
handler = Ffind_file_name_handler (file, Qload);
diff -r 6e6fff6b506b -r 5b61ece2c903 src/print.c
--- a/src/print.c Sat Mar 06 21:18:38 2010 -0600
+++ b/src/print.c Sun Mar 07 03:15:54 2010 -0600
@@ -353,22 +353,6 @@
va_start (args, fmt);
write_string_to_external_output_va (fmt, args, dest);
va_end (args);
-}
-
-/* Output portably to stderr or its equivalent (i.e. may be a console
- window under MS Windows), as well as alternate-debugging-output and
- (under MS Windows) the C debugging output, i.e. OutputDebugString().
- Works like stderr_out(). */
-
-void
-debug_out (const CIbyte *fmt, ...)
-{
- int depth = begin_inhibit_non_essential_conversion_operations ();
- va_list args;
- va_start (args, fmt);
- write_string_to_external_output_va (fmt, args, EXT_PRINT_ALL);
- va_end (args);
- unbind_to (depth);
}
DOESNT_RETURN
@@ -2096,6 +2080,40 @@
}
+
+DEFUN ("set-device-clear-left-side", Fset_device_clear_left_side, 2, 2, 0, /*
+Set whether to output a newline before the next output to a stream device.
+This will happen only if the most recently-outputted character was not
+a newline -- i.e. it will make sure the left side is "clear" of text.
+*/
+ (device, value))
+{
+ if (!NILP (device))
+ CHECK_LIVE_DEVICE (device);
+ if (NILP (device) || DEVICE_STREAM_P (XDEVICE (device)))
+ /* #### This should be per-device */
+ stdout_clear_before_next_output = !NILP (value);
+ return Qnil;
+}
+
+DEFUN ("device-left-side-clear-p", Fdevice_left_side_clear_p, 0, 1, 0, /*
+For stream devices, true if the most recent-outputted character was a newline.
+*/
+ (device))
+{
+ if (!NILP (device))
+ CHECK_LIVE_DEVICE (device);
+ if (NILP (device) || DEVICE_STREAM_P (XDEVICE (device)))
+ /* #### This should be per-device */
+ return stdout_needs_newline ? Qt : Qnil;
+ return Qnil;
+}
+
+
+/*************************************************************************/
+/* debug-printing: implementation */
+/*************************************************************************/
+
/* Useful on systems or in places where writing to stdout is unavailable or
not working. */
@@ -2151,35 +2169,6 @@
memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
alternate_do_pointer += extlen;
alternate_do_string[alternate_do_pointer] = 0;
-}
-
-
-DEFUN ("set-device-clear-left-side", Fset_device_clear_left_side, 2, 2, 0, /*
-Set whether to output a newline before the next output to a stream device.
-This will happen only if the most recently-outputted character was not
-a newline -- i.e. it will make sure the left side is "clear" of text.
-*/
- (device, value))
-{
- if (!NILP (device))
- CHECK_LIVE_DEVICE (device);
- if (NILP (device) || DEVICE_STREAM_P (XDEVICE (device)))
- /* #### This should be per-device */
- stdout_clear_before_next_output = !NILP (value);
- return Qnil;
-}
-
-DEFUN ("device-left-side-clear-p", Fdevice_left_side_clear_p, 0, 1, 0, /*
-For stream devices, true if the most recent-outputted character was a newline.
-*/
- (device))
-{
- if (!NILP (device))
- CHECK_LIVE_DEVICE (device);
- if (NILP (device) || DEVICE_STREAM_P (XDEVICE (device)))
- /* #### This should be per-device */
- return stdout_needs_newline ? Qt : Qnil;
- return Qnil;
}
DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
@@ -2375,6 +2364,187 @@
unbind_to (specdepth);
}
+static int
+ext_print_begin (int dest)
+{
+ int depth = begin_inhibit_non_essential_conversion_operations ();
+ if (dest & EXT_PRINT_ALTERNATE)
+ alternate_do_pointer = 0;
+ if (dest & (EXT_PRINT_STDERR | EXT_PRINT_STDOUT))
+ stdout_clear_before_next_output = 1;
+ return depth;
+}
+
+static void
+ext_print_end (int dest, int depth)
+{
+ if (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR | EXT_PRINT_STDOUT))
+ external_out (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR |
+ EXT_PRINT_STDOUT), "\n");
+ unbind_to (depth);
+}
+
+static void
+external_debug_print (Lisp_Object object, int dest)
+{
+ int depth = ext_print_begin (dest);
+ debug_prin1 (object, dest);
+ ext_print_end (dest, depth);
+}
+
+
+/*************************************************************************/
+/* debug-printing: external entry points */
+/*************************************************************************/
+
+/* All of the following functions output simultaneously to the following
+ destinations:
+
+ (1) stderr
+ (2) alternate_do_string -- a string containing debug output, for situations
+ where stderr may be unavailable (e.g. on MS Windows)
+ (3) on MS Windows, the "debugging output" (output using OutputDebugString,
+ which shows up in a debugger)
+
+ Furthermore, they inhibit DFC-style conversion, so they will work during
+ initialization or death, or when called from within the DFC conversion
+ routines. */
+
+/* Printf-style debugging output. */
+
+void
+debug_out (const CIbyte *fmt, ...)
+{
+ int depth = begin_inhibit_non_essential_conversion_operations ();
+ va_list args;
+ va_start (args, fmt);
+ write_string_to_external_output_va (fmt, args, EXT_PRINT_ALL);
+ va_end (args);
+ unbind_to (depth);
+}
+
+/* Basic entry point: Print out a Lisp object to the debugging output. */
+
+void
+debug_print (Lisp_Object debug_print_obj)
+{
+ external_debug_print (debug_print_obj, EXT_PRINT_ALL);
+}
+
+/* Printf-style output when the objects being printed are Lisp objects.
+ Calling style is e.g.
+
+ debug_out_lisp ("Called foo(%s %s)\n", 2, arg0, arg1)
+*/
+
+void
+debug_out_lisp (const CIbyte *format, int nargs, ...)
+{
+ /* This function cannot GC, since GC is forbidden */
+ struct debug_bindings bindings;
+ int specdepth = debug_print_enter (&bindings);
+ Lisp_Object *args = alloca_array (Lisp_Object, nargs);
+ va_list va;
+ int i;
+ Ibyte *msgout;
+
+ va_start (va, nargs);
+ for (i = 0; i < nargs; i++)
+ args[i] = va_arg (va, Lisp_Object);
+ va_end (va);
+ msgout = emacs_vsprintf_malloc_lisp (format, Qnil, nargs, args, NULL);
+ debug_out ("%s", msgout);
+ xfree (msgout);
+ unbind_to (specdepth);
+}
+
+/* Getting tired of typing debug_print() ... */
+void dp (Lisp_Object debug_print_obj);
+void
+dp (Lisp_Object debug_print_obj)
+{
+ debug_print (debug_print_obj);
+}
+
+/* Alternate debug printer: Return a char * pointer to the output */
+char *dpa (Lisp_Object debug_print_obj);
+char *
+dpa (Lisp_Object debug_print_obj)
+{
+ external_debug_print (debug_print_obj, EXT_PRINT_ALTERNATE);
+
+ return alternate_do_string;
+}
+
+/* Do a backtrace to stderr. */
+void
+debug_backtrace (void)
+{
+ /* This function cannot GC, since GC is forbidden */
+ struct debug_bindings bindings;
+ int specdepth = debug_print_enter (&bindings);
+
+ Fbacktrace (Qexternal_debugging_output, Qt);
+ stderr_out ("\n");
+
+ unbind_to (specdepth);
+}
+
+/* Getting tired of typing debug_backtrace() ... */
+void db (void);
+void
+db (void)
+{
+ debug_backtrace ();
+}
+
+/* Do a "short" backtrace. */
+
+void
+debug_short_backtrace (int length)
+{
+ int first = 1;
+ struct backtrace *bt = backtrace_list;
+
+ debug_out (" [");
+ while (length > 0 && bt)
+ {
+ if (!first)
+ {
+ debug_out (", ");
+ }
+ if (COMPILED_FUNCTIONP (*bt->function))
+ {
+#if defined (COMPILED_FUNCTION_ANNOTATION_HACK)
+ Lisp_Object ann =
+ compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
+#else
+ Lisp_Object ann = Qnil;
+#endif
+ if (!NILP (ann))
+ {
+ debug_out ("<compiled-function from ");
+ debug_prin1 (ann, EXT_PRINT_ALL);
+ debug_out (">");
+ }
+ else
+ {
+ debug_out ("<compiled-function of unknown origin>");
+ }
+ }
+ else
+ debug_prin1 (*bt->function, EXT_PRINT_ALL);
+ first = 0;
+ length--;
+ bt = bt->next;
+ }
+ debug_out ("]\n");
+}
+
+/* Somewhat like debug_print() but looks at the contents of the objects
+ directly. Useful mainly when something has gone seriously wrong and
+ debug_print() crashes. */
+
void
debug_p4 (Lisp_Object obj)
{
@@ -2453,127 +2623,13 @@
}
}
-static int
-ext_print_begin (int dest)
-{
- int depth = begin_inhibit_non_essential_conversion_operations ();
- if (dest & EXT_PRINT_ALTERNATE)
- alternate_do_pointer = 0;
- if (dest & (EXT_PRINT_STDERR | EXT_PRINT_STDOUT))
- stdout_clear_before_next_output = 1;
- return depth;
-}
-
-static void
-ext_print_end (int dest, int depth)
-{
- if (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR | EXT_PRINT_STDOUT))
- external_out (dest & (EXT_PRINT_MSWINDOWS | EXT_PRINT_STDERR |
- EXT_PRINT_STDOUT), "\n");
- unbind_to (depth);
-}
-
-static void
-external_debug_print (Lisp_Object object, int dest)
-{
- int depth = ext_print_begin (dest);
- debug_prin1 (object, dest);
- ext_print_end (dest, depth);
-}
+/* Same as debug_p4() but output a newline at the end. */
void
debug_p3 (Lisp_Object obj)
{
debug_p4 (obj);
debug_out ("\n");
-}
-
-void
-debug_print (Lisp_Object debug_print_obj)
-{
- external_debug_print (debug_print_obj, EXT_PRINT_ALL);
-}
-
-/* Getting tired of typing debug_print() ... */
-void dp (Lisp_Object debug_print_obj);
-void
-dp (Lisp_Object debug_print_obj)
-{
- debug_print (debug_print_obj);
-}
-
-/* Alternate debug printer: Return a char * pointer to the output */
-char *dpa (Lisp_Object debug_print_obj);
-char *
-dpa (Lisp_Object debug_print_obj)
-{
- external_debug_print (debug_print_obj, EXT_PRINT_ALTERNATE);
-
- return alternate_do_string;
-}
-
-/* Debugging kludge -- unbuffered */
-/* This function provided for the benefit of the debugger. */
-void
-debug_backtrace (void)
-{
- /* This function cannot GC, since GC is forbidden */
- struct debug_bindings bindings;
- int specdepth = debug_print_enter (&bindings);
-
- Fbacktrace (Qexternal_debugging_output, Qt);
- stderr_out ("\n");
-
- unbind_to (specdepth);
-}
-
-/* Getting tired of typing debug_backtrace() ... */
-void db (void);
-void
-db (void)
-{
- debug_backtrace ();
-}
-
-void
-debug_short_backtrace (int length)
-{
- int first = 1;
- struct backtrace *bt = backtrace_list;
-
- debug_out (" [");
- while (length > 0 && bt)
- {
- if (!first)
- {
- debug_out (", ");
- }
- if (COMPILED_FUNCTIONP (*bt->function))
- {
-#if defined (COMPILED_FUNCTION_ANNOTATION_HACK)
- Lisp_Object ann =
- compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
-#else
- Lisp_Object ann = Qnil;
-#endif
- if (!NILP (ann))
- {
- debug_out ("<compiled-function from ");
- debug_prin1 (ann, EXT_PRINT_ALL);
- debug_out (">");
- }
- else
- {
- debug_out ("<compiled-function of unknown origin>");
- }
- }
- else
- debug_prin1 (*bt->function, EXT_PRINT_ALL);
- first = 0;
- length--;
- bt = bt->next;
- }
- debug_out ("]\n");
}
More information about the XEmacs-Patches
mailing list