Mercurial > hg > xemacs-beta

comparison src/print.c @ 802:19dfb459d51a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-04-03 10:47:37 by ben] fix tty problem et al internals/internals.texi: Add section on correctly merging a branch back into the trunk. console-tty.c, eval.c, event-unixoid.c, file-coding.c, file-coding.h, lisp.h, print.c, sysdep.c: Fix data corruption error in print.c from print_depth becoming negative. Borrow primitives internal_bind_int, internal_bind_lisp_object from my stderr-proc ws, soon to be integrated; use them to properly bind print_depth et al. First fix for TTY problem. The basic problem is I switched things so that the TTY I/O is filtered through a coding system, for the support of kterm and such, that speak JIS or similar encodings. (#### I ***swear*** I had this working way back in 19.12.) Anyway, this introduced buffering issues, in which instead of one char being read, it tried to read 1024 chars. I tried setting the stdin descriptor non-blocking, but it doesn't appear to work on Cygwin. (#### Andy, do you know anything about this?) So I fixed it elsewhere. If you get weirdness on the TTY, look in console-tty.c and see how it gets the coding system; maybe there's a way to change it (and if not, there should be!). Also fix warning in sysdep.c.
author ben
date Wed, 03 Apr 2002 10:47:52 +0000
parents a5954632b187
children 6728e641994e
comparison
equal deleted inserted replaced
801:2b676dc88c66 802:19dfb459d51a
760 /* This function can GC */ 760 /* This function can GC */
761 Lisp_Object frame = Qnil; 761 Lisp_Object frame = Qnil;
762 struct gcpro gcpro1, gcpro2; 762 struct gcpro gcpro1, gcpro2;
763 GCPRO2 (object, stream); 763 GCPRO2 (object, stream);
764 764
765 print_depth = 0;
766 stream = print_prepare (stream, &frame); 765 stream = print_prepare (stream, &frame);
767 print_internal (object, stream, 1); 766 print_internal (object, stream, 1);
768 print_finish (stream, frame); 767 print_finish (stream, frame);
769 768
770 UNGCPRO; 769 UNGCPRO;
785 Lstream *str = XLSTREAM (stream); 784 Lstream *str = XLSTREAM (stream);
786 /* gcpro OBJECT in case a caller forgot to do so */ 785 /* gcpro OBJECT in case a caller forgot to do so */
787 struct gcpro gcpro1, gcpro2, gcpro3; 786 struct gcpro gcpro1, gcpro2, gcpro3;
788 GCPRO3 (object, stream, result); 787 GCPRO3 (object, stream, result);
789 788
790 print_depth = 0;
791 RESET_PRINT_GENSYM; 789 RESET_PRINT_GENSYM;
792 print_internal (object, stream, NILP (noescape)); 790 print_internal (object, stream, NILP (noescape));
793 RESET_PRINT_GENSYM; 791 RESET_PRINT_GENSYM;
794 Lstream_flush (str); 792 Lstream_flush (str);
795 UNGCPRO; 793 UNGCPRO;
811 Lisp_Object frame = Qnil; 809 Lisp_Object frame = Qnil;
812 struct gcpro gcpro1, gcpro2; 810 struct gcpro gcpro1, gcpro2;
813 811
814 GCPRO2 (object, stream); 812 GCPRO2 (object, stream);
815 stream = print_prepare (stream, &frame); 813 stream = print_prepare (stream, &frame);
816 print_depth = 0;
817 print_internal (object, stream, 0); 814 print_internal (object, stream, 0);
818 print_finish (stream, frame); 815 print_finish (stream, frame);
819 UNGCPRO; 816 UNGCPRO;
820 return object; 817 return object;
821 } 818 }
832 Lisp_Object frame = Qnil; 829 Lisp_Object frame = Qnil;
833 struct gcpro gcpro1, gcpro2; 830 struct gcpro gcpro1, gcpro2;
834 831
835 GCPRO2 (object, stream); 832 GCPRO2 (object, stream);
836 stream = print_prepare (stream, &frame); 833 stream = print_prepare (stream, &frame);
837 print_depth = 0;
838 write_char_internal ("\n", stream); 834 write_char_internal ("\n", stream);
839 print_internal (object, stream, 1); 835 print_internal (object, stream, 1);
840 write_char_internal ("\n", stream); 836 write_char_internal ("\n", stream);
841 print_finish (stream, frame); 837 print_finish (stream, frame);
842 UNGCPRO; 838 UNGCPRO;
1386 1382
1387 void 1383 void
1388 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 1384 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1389 { 1385 {
1390 /* This function can GC */ 1386 /* This function can GC */
1387 int specdepth;
1391 1388
1392 QUIT; 1389 QUIT;
1393 1390
1394 #ifdef NO_PRINT_DURING_GC 1391 #ifdef NO_PRINT_DURING_GC
1395 /* Emacs won't print while GCing, but an external debugger might */ 1392 /* Emacs won't print while GCing, but an external debugger might */
1479 return; 1476 return;
1480 } 1477 }
1481 } 1478 }
1482 1479
1483 being_printed[print_depth] = obj; 1480 being_printed[print_depth] = obj;
1484 print_depth++; 1481 specdepth = internal_bind_int (&print_depth, print_depth + 1);
1485 1482
1486 if (print_depth > PRINT_CIRCLE) 1483 if (print_depth > PRINT_CIRCLE)
1487 signal_error (Qstack_overflow, "Apparently circular structure being printed", Qunbound); 1484 signal_error (Qstack_overflow, "Apparently circular structure being printed", Qunbound);
1488 1485
1489 switch (XTYPE (obj)) 1486 switch (XTYPE (obj))
1608 #endif /* not ERROR_CHECK_TYPES */ 1605 #endif /* not ERROR_CHECK_TYPES */
1609 break; 1606 break;
1610 } 1607 }
1611 } 1608 }
1612 1609
1613 print_depth--; 1610 unbind_to (specdepth);
1614 } 1611 }
1615 1612
1616 1613
1617 #ifdef LISP_FLOAT_TYPE 1614 #ifdef LISP_FLOAT_TYPE
1618 void 1615 void
1888 /* Debugging kludge -- unbuffered */ 1885 /* Debugging kludge -- unbuffered */
1889 static void 1886 static void
1890 debug_print_no_newline (Lisp_Object debug_print_obj) 1887 debug_print_no_newline (Lisp_Object debug_print_obj)
1891 { 1888 {
1892 /* This function can GC */ 1889 /* This function can GC */
1893 int save_print_readably = print_readably; 1890 int specdepth = internal_bind_int (&print_depth, 0);
1894 int save_print_depth = print_depth; 1891 internal_bind_int (&print_readably,
1895 Lisp_Object save_Vprint_length = Vprint_length; 1892 debug_print_readably != -1 ? debug_print_readably : 0);
1896 Lisp_Object save_Vprint_level = Vprint_level; 1893 internal_bind_int (&print_unbuffered, print_unbuffered + 1);
1897 Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
1898 struct gcpro gcpro1, gcpro2, gcpro3;
1899 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
1900
1901 print_depth = 0;
1902 print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
1903 print_unbuffered++;
1904 /* Could use unwind-protect, but why bother? */
1905 if (debug_print_length > 0) 1894 if (debug_print_length > 0)
1906 Vprint_length = make_int (debug_print_length); 1895 internal_bind_lisp_object (&Vprint_length, make_int (debug_print_length));
1907 if (debug_print_level > 0) 1896 if (debug_print_level > 0)
1908 Vprint_level = make_int (debug_print_level); 1897 internal_bind_lisp_object (&Vprint_level, make_int (debug_print_level));
1909 1898 /* #### Do we need this? It was in the old code. */
1899 internal_bind_lisp_object (&Vinhibit_quit, Vinhibit_quit);
1900
1910 print_internal (debug_print_obj, Qexternal_debugging_output, 1); 1901 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
1911 alternate_do_pointer = 0; 1902 alternate_do_pointer = 0;
1912 print_internal (debug_print_obj, Qalternate_debugging_output, 1); 1903 print_internal (debug_print_obj, Qalternate_debugging_output, 1);
1913 #ifdef WIN32_NATIVE 1904 #ifdef WIN32_NATIVE
1914 /* Write out to the debugger, as well */ 1905 /* Write out to the debugger, as well */
1915 print_internal (debug_print_obj, Qmswindows_debugging_output, 1); 1906 print_internal (debug_print_obj, Qmswindows_debugging_output, 1);
1916 #endif 1907 #endif
1917 1908
1918 Vinhibit_quit = save_Vinhibit_quit; 1909 unbind_to (specdepth);
1919 Vprint_level = save_Vprint_level;
1920 Vprint_length = save_Vprint_length;
1921 print_depth = save_print_depth;
1922 print_readably = save_print_readably;
1923 print_unbuffered--;
1924 UNGCPRO;
1925 } 1910 }
1926 1911
1927 void 1912 void
1928 debug_print (Lisp_Object debug_print_obj) 1913 debug_print (Lisp_Object debug_print_obj)
1929 { 1914 {
1935 /* This function provided for the benefit of the debugger. */ 1920 /* This function provided for the benefit of the debugger. */
1936 void 1921 void
1937 debug_backtrace (void) 1922 debug_backtrace (void)
1938 { 1923 {
1939 /* This function can GC */ 1924 /* This function can GC */
1940 int old_print_readably = print_readably; 1925 int specdepth = internal_bind_int (&print_depth, 0);
1941 int old_print_depth = print_depth; 1926 internal_bind_int (&print_readably, 0);
1942 Lisp_Object old_print_length = Vprint_length; 1927 internal_bind_int (&print_unbuffered, print_unbuffered + 1);
1943 Lisp_Object old_print_level = Vprint_level;
1944 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1945
1946 struct gcpro gcpro1, gcpro2, gcpro3;
1947 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
1948
1949 print_depth = 0;
1950 print_readably = 0;
1951 print_unbuffered++;
1952 /* Could use unwind-protect, but why bother? */
1953 if (debug_print_length > 0) 1928 if (debug_print_length > 0)
1954 Vprint_length = make_int (debug_print_length); 1929 internal_bind_lisp_object (&Vprint_length, make_int (debug_print_length));
1955 if (debug_print_level > 0) 1930 if (debug_print_level > 0)
1956 Vprint_level = make_int (debug_print_level); 1931 internal_bind_lisp_object (&Vprint_level, make_int (debug_print_level));
1932 /* #### Do we need this? It was in the old code. */
1933 internal_bind_lisp_object (&Vinhibit_quit, Vinhibit_quit);
1957 1934
1958 Fbacktrace (Qexternal_debugging_output, Qt); 1935 Fbacktrace (Qexternal_debugging_output, Qt);
1959 stderr_out ("\n"); 1936 stderr_out ("\n");
1960 1937
1961 Vinhibit_quit = old_inhibit_quit; 1938 unbind_to (specdepth);
1962 Vprint_level = old_print_level;
1963 Vprint_length = old_print_length;
1964 print_depth = old_print_depth;
1965 print_readably = old_print_readably;
1966 print_unbuffered--;
1967
1968 UNGCPRO;
1969 } 1939 }
1970 1940
1971 void 1941 void
1972 debug_short_backtrace (int length) 1942 debug_short_backtrace (int length)
1973 { 1943 {