mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 07:30:32 +02:00
Code Activity

* Makefile.in: Rebuilt.

Browse source 
* Makefile.am (libguile_la_SOURCES): Removed extchrs.c,
	mbstrings.c.
	(modinclude_HEADERS): Removed extchrs.h, mbstrings.h.
	* unif.c (scm_vector_set_length_x): Don't handle multibyte
	strings.
	* tag.c (scm_utag_mb_string, scm_utag_mb_substring): Removed.
	(scm_tag): Don't handle multibyte strings.
	* read.c: Don't include mbstrings.h.
	(scm_lreadr): Don't handle multibyte ports.
	* kw.c: Don't include mbstrings.h.
	* init.c: Don't include mbstrings.h.
	(scm_boot_guile_1): Don't init mbstrings module.
	* hash.c (scm_hasher): Don't handle mbstrings.
	* gscm.c (gscm_run_scm): Don't init mbstrings module.
	* gc.c (scm_gc_mark): Don't handle mbstrings.
	(scm_gc_sweep): Likewise.
	* eval.c (SCM_CEVAL): Don't handle mbstrings.
	* eq.c (scm_equal_p): Use SCM_TYP7S, not SCM_TYP7SD.
	* tags.h (SCM_TYP7SD): Removed.
	(SCM_TYP7D): Removed.
	(scm_tc7_mb_string): Removed.
	(scm_tc7_mb_substring): Removed.
	* print.c (scm_iprin1): Handle char printing directly.  Don't
	handle mbstrings.
	Don't include "mbstrings.h".
	* symbols.c (scm_intern_obarray_soft, scm_string_to_symbol,
	scm_string_to_obarray_symbol, msymbolize): Don't set symbol's
	multi-byte flag.
	Don't include "mbstrings.h".
	* symbols.h (SCM_SYMBOL_MULTI_BYTE_STRINGP): Removed.
	(SCM_SYMBOL_SLOTS): Define as 4.
	(SCM_ROSTRINGP): Use SCM_TYP7S, not SCM_TYP7SD.
	* arbiters.c, backtrace.c, debug.c, dynl.c, eval.c, fluids.c,
	gc.c, gsubr.c, ioext.c, kw.c, mallocs.c, numbers.c, ports.c,
	print.c, read.c, regex-posix.c, root.c, srcprop.c, stackchk.c,
	struct.c, threads.c, throw.c, unif.c, variable.c: Use new
	("gen"-less) I/O function names.
	* ports.c (scm_add_to_port_table): Don't set port's
	representation.
	* ports.h (scm_port_representation_type): Removed.
	(scm_string_representation_type): Removed.
	(struct scm_port_table ): Removed representation field.
	(SCM_PORT_REPRESENTATION): Removed.
	(SCM_SET_PORT_REPRESENTATION): Removed.
	* genio.h: Use new function names.
	* genio.c: Don't include "extchrs.h".
	(scm_gen_putc, scm_gen_puts, scm_gen_write, scm_get_getc):
	Removed.
	(scm_putc, scm_puts, scm_lfwrite): No longer static.
	(scm_getc): No longer static; handle line and column changes.
	(scm_ungetc): Renamed from scm_gen_ungetc.
	(scm_do_read_line): Renamed from scm_gen_read_line.
	* libguile.h: Don't include "extchrs.h" or "mbstrings.h"
	* extchrs.h, extchrs.c, mbstrings.h, mbstrings.c: Removed.
This commit is contained in:
Tom Tromey 1997-10-15 17:18:32 +00:00
parent 8d6787b6dc
commit b7f3516f99
46 changed files with 402 additions and 1447 deletions
Download patch file Download diff file Expand all files Collapse all files

159
libguile/print.c
View file

@ -44,7 +44,6 @@
#include "_scm.h"
#include "chars.h"
#include "genio.h"
#include "mbstrings.h"
#include "smob.h"
#include "eval.h"
#include "procprop.h"
@ -146,7 +145,7 @@ scm_print_options (setting)
{ \
if (pstate->top - pstate->list_offset >= pstate->level) \
{ \
scm_gen_putc ('#', port); \
scm_putc ('#', port); \
return; \
} \
} \
@ -222,9 +221,9 @@ print_state_printer (obj, port)
SCM_ARG2,
s_print_state_printer);
port = SCM_COERCE_OPORT (port);
scm_gen_puts (scm_regular_string, "#<print-state ", port);
scm_puts ("#<print-state ", port);
scm_intprint (obj, 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return SCM_UNSPECIFIED;
}
@ -287,9 +286,9 @@ print_circref (port, pstate, ref)
for (i = pstate->top - 1; 1; --i)
if (pstate->ref_stack[i] == ref)
break;
scm_gen_putc ('#', port);
scm_putc ('#', port);
scm_intprint (i - self, 10, port);
scm_gen_putc ('#', port);
scm_putc ('#', port);
}
/* Print generally. Handles both write and display according to PSTATE.
@ -314,17 +313,27 @@ taloop:
if (SCM_ICHRP (exp))
{
i = SCM_ICHR (exp);
scm_put_wchar (i, port, SCM_WRITINGP (pstate));
if (SCM_WRITINGP (pstate))
{
scm_puts ("#\\", port);
if ((i >= 0) && (i <= ' ') && scm_charnames[i])
scm_puts (scm_charnames[i], port);
else if (i < 0 || i > '\177')
scm_intprint (i, 8, port);
else
scm_putc (i, port);
}
else
scm_putc (i, port);
}
else if (SCM_IFLAGP (exp)
&& (SCM_ISYMNUM (exp) < (sizeof scm_isymnames / sizeof (char *))))
scm_gen_puts (scm_regular_string, SCM_ISYMCHARS (exp), port);
scm_puts (SCM_ISYMCHARS (exp), port);
else if (SCM_ILOCP (exp))
{
scm_gen_puts (scm_regular_string, "#@", port);
scm_puts ("#@", port);
scm_intprint ((long) SCM_IFRAME (exp), 10, port);
scm_gen_putc (SCM_ICDRP (exp) ? '-' : '+', port);
scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
scm_intprint ((long) SCM_IDIST (exp), 10, port);
}
else
@ -332,7 +341,7 @@ taloop:
break;
case 1:
/* gloc */
scm_gen_puts (scm_regular_string, "#@", port);
scm_puts ("#@", port);
exp = SCM_CAR (exp - 1);
goto taloop;
default:
@ -380,21 +389,20 @@ taloop:
if (!SCM_CLOSUREP (SCM_CDR (exp)))
{
code = env = 0;
scm_gen_puts (scm_regular_string, "#<primitive-",
port);
scm_puts ("#<primitive-", port);
}
else
{
code = SCM_CODE (SCM_CDR (exp));
env = SCM_ENV (SCM_CDR (exp));
scm_gen_puts (scm_regular_string, "#<", port);
scm_puts ("#<", port);
}
if (SCM_CAR (exp) & (3L << 16))
scm_gen_puts (scm_regular_string, "macro", port);
scm_puts ("macro", port);
else
scm_gen_puts (scm_regular_string, "syntax", port);
scm_puts ("syntax", port);
if (SCM_CAR (exp) & (2L << 16))
scm_gen_putc ('!', port);
scm_putc ('!', port);
}
else
{
@ -402,13 +410,12 @@ taloop:
name = scm_procedure_name (exp);
code = SCM_CODE (exp);
env = SCM_ENV (exp);
scm_gen_puts (scm_regular_string, "#<procedure",
port);
scm_puts ("#<procedure", port);
}
if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{
scm_gen_putc (' ', port);
scm_gen_puts (scm_regular_string, SCM_ROCHARS (name), port);
scm_putc (' ', port);
scm_puts (SCM_ROCHARS (name), port);
}
if (code)
{
@ -426,49 +433,38 @@ taloop:
{
if (SCM_TYP16 (exp) != scm_tc16_macro)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_iprin1 (SCM_CAR (code), port, pstate);
}
scm_gen_putc ('>', port);
scm_putc ('>', port);
}
}
else
scm_gen_putc ('>', port);
scm_putc ('>', port);
}
break;
case scm_tc7_mb_string:
case scm_tc7_mb_substring:
scm_print_mb_string (exp, port, SCM_WRITINGP (pstate));
break;
case scm_tc7_substring:
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
scm_gen_putc ('"', port);
scm_putc ('"', port);
for (i = 0; i < SCM_ROLENGTH (exp); ++i)
switch (SCM_ROCHARS (exp)[i])
{
case '"':
case '\\':
scm_gen_putc ('\\', port);
scm_putc ('\\', port);
default:
scm_gen_putc (SCM_ROCHARS (exp)[i], port);
scm_putc (SCM_ROCHARS (exp)[i], port);
}
scm_gen_putc ('"', port);
scm_putc ('"', port);
break;
}
else
scm_gen_write (scm_regular_string, SCM_ROCHARS (exp),
(scm_sizet) SCM_ROLENGTH (exp),
port);
scm_lfwrite (SCM_ROCHARS (exp), (scm_sizet) SCM_ROLENGTH (exp),
port);
break;
case scm_tcs_symbols:
if (SCM_MB_STRINGP (exp))
{
scm_print_mb_symbol (exp, port);
break;
}
else
{
int pos;
int end;
@ -486,7 +482,7 @@ taloop:
maybe_weird = 0;
if (len == 0)
scm_gen_write (scm_regular_string, "#{}#", 4, port);
scm_lfwrite ("#{}#", 4, port);
for (end = pos; end < len; ++end)
switch (str[end])
@ -509,18 +505,18 @@ taloop:
}
if (!weird)
{
scm_gen_write (scm_regular_string, "#{", 2, port);
scm_lfwrite ("#{", 2, port);
weird = 1;
}
if (pos < end)
{
scm_gen_write (scm_regular_string, str + pos, end - pos, port);
scm_lfwrite (str + pos, end - pos, port);
}
{
char buf[2];
buf[0] = '\\';
buf[1] = str[end];
scm_gen_write (scm_regular_string, buf, 2, port);
scm_lfwrite (buf, 2, port);
}
pos = end + 1;
break;
@ -542,22 +538,22 @@ taloop:
break;
}
if (pos < end)
scm_gen_write (scm_regular_string, str + pos, end - pos, port);
scm_lfwrite (str + pos, end - pos, port);
if (weird)
scm_gen_write (scm_regular_string, "}#", 2, port);
scm_lfwrite ("}#", 2, port);
break;
}
case scm_tc7_wvect:
ENTER_NESTED_DATA (pstate, exp, circref);
if (SCM_IS_WHVEC (exp))
scm_gen_puts (scm_regular_string, "#wh(", port);
scm_puts ("#wh(", port);
else
scm_gen_puts (scm_regular_string, "#w(", port);
scm_puts ("#w(", port);
goto common_vector_printer;
case scm_tc7_vector:
ENTER_NESTED_DATA (pstate, exp, circref);
scm_gen_puts (scm_regular_string, "#(", port);
scm_puts ("#(", port);
common_vector_printer:
{
int last = SCM_LENGTH (exp) - 1;
@ -571,7 +567,7 @@ taloop:
{
/* CHECK_INTS; */
scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
scm_gen_putc (' ', port);
scm_putc (' ', port);
}
if (i == last)
{
@ -579,8 +575,8 @@ taloop:
scm_iprin1 (SCM_VELTS (exp)[i], port, pstate);
}
if (cutp)
scm_gen_puts (scm_regular_string, " ...", port);
scm_gen_putc (')', port);
scm_puts (" ...", port);
scm_putc (')', port);
}
EXIT_NESTED_DATA (pstate);
break;
@ -598,26 +594,23 @@ taloop:
scm_raprin1 (exp, port, pstate);
break;
case scm_tcs_subrs:
scm_gen_puts (scm_regular_string, "#<primitive-procedure ", port);
scm_gen_puts ((SCM_MB_STRINGP (SCM_SNAME(exp))
? scm_mb_string
: scm_regular_string),
SCM_CHARS (SCM_SNAME (exp)), port);
scm_gen_putc ('>', port);
scm_puts ("#<primitive-procedure ", port);
scm_puts (SCM_CHARS (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
#ifdef CCLO
case scm_tc7_cclo:
scm_gen_puts (scm_regular_string, "#<compiled-closure ", port);
scm_puts ("#<compiled-closure ", port);
scm_iprin1 (SCM_CCLO_SUBR (exp), port, pstate);
scm_gen_putc ('>', port);
scm_putc ('>', port);
break;
#endif
case scm_tc7_contin:
scm_gen_puts (scm_regular_string, "#<continuation ", port);
scm_puts ("#<continuation ", port);
scm_intprint (SCM_LENGTH (exp), 10, port);
scm_gen_puts (scm_regular_string, " @ ", port);
scm_puts (" @ ", port);
scm_intprint ((long) SCM_CHARS (exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
break;
case scm_tc7_port:
i = SCM_PTOBNUM (exp);
@ -718,7 +711,7 @@ scm_intprint (n, radix, port)
SCM port;
{
char num_buf[SCM_INTBUFLEN];
scm_gen_write (scm_regular_string, num_buf, scm_iint2str (n, radix, num_buf), port);
scm_lfwrite (num_buf, scm_iint2str (n, radix, num_buf), port);
}
/* Print an object of unrecognized type.
@ -730,19 +723,19 @@ scm_ipruk (hdr, ptr, port)
SCM ptr;
SCM port;
{
scm_gen_puts (scm_regular_string, "#<unknown-", port);
scm_gen_puts (scm_regular_string, hdr, port);
scm_puts ("#<unknown-", port);
scm_puts (hdr, port);
if (SCM_CELLP (ptr))
{
scm_gen_puts (scm_regular_string, " (0x", port);
scm_puts (" (0x", port);
scm_intprint (SCM_CAR (ptr), 16, port);
scm_gen_puts (scm_regular_string, " . 0x", port);
scm_puts (" . 0x", port);
scm_intprint (SCM_CDR (ptr), 16, port);
scm_gen_puts (scm_regular_string, ") @", port);
scm_puts (") @", port);
}
scm_gen_puts (scm_regular_string, " 0x", port);
scm_puts (" 0x", port);
scm_intprint (ptr, 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
}
/* Print a list.
@ -760,7 +753,7 @@ scm_iprlist (hdr, exp, tlr, port, pstate)
register int i;
register SCM hare, tortoise;
int floor = pstate->top - 2;
scm_gen_puts (scm_regular_string, hdr, port);
scm_puts (hdr, port);
/* CHECK_INTS; */
if (pstate->fancyp)
goto fancy_printing;
@ -791,18 +784,18 @@ scm_iprlist (hdr, exp, tlr, port, pstate)
if (pstate->ref_stack[i] == exp)
goto circref;
PUSH_REF (pstate, exp);
scm_gen_putc (' ', port);
scm_putc (' ', port);
/* CHECK_INTS; */
scm_iprin1 (SCM_CAR (exp), port, pstate);
}
if (SCM_NNULLP (exp))
{
scm_gen_puts (scm_regular_string, " . ", port);
scm_puts (" . ", port);
scm_iprin1 (exp, port, pstate);
}
end:
scm_gen_putc (tlr, port);
scm_putc (tlr, port);
pstate->top = floor + 2;
return;
@ -823,7 +816,7 @@ fancy_printing:
{
if (n == 0)
{
scm_gen_puts (scm_regular_string, " ...", port);
scm_puts (" ...", port);
goto skip_tail;
}
else
@ -831,14 +824,14 @@ fancy_printing:
}
PUSH_REF(pstate, exp);
++pstate->list_offset;
scm_gen_putc (' ', port);
scm_putc (' ', port);
/* CHECK_INTS; */
scm_iprin1 (SCM_CAR (exp), port, pstate);
}
}
if (SCM_NNULLP (exp))
{
scm_gen_puts (scm_regular_string, " . ", port);
scm_puts (" . ", port);
scm_iprin1 (exp, port, pstate);
}
skip_tail:
@ -849,7 +842,7 @@ fancy_circref:
pstate->list_offset -= pstate->top - floor - 2;
circref:
scm_gen_puts (scm_regular_string, " . ", port);
scm_puts (" . ", port);
print_circref (port, pstate, exp);
goto end;
}
@ -924,7 +917,7 @@ scm_newline (port)
else
SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG1, s_newline);
scm_gen_putc ('\n', SCM_COERCE_OPORT (port));
scm_putc ('\n', SCM_COERCE_OPORT (port));
#ifdef HAVE_PIPE
# ifdef EPIPE
if (EPIPE == errno)
@ -950,7 +943,7 @@ scm_write_char (chr, port)
SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write_char);
SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG1, s_write_char);
scm_gen_putc ((int) SCM_ICHR (chr), SCM_COERCE_OPORT (port));
scm_putc ((int) SCM_ICHR (chr), SCM_COERCE_OPORT (port));
#ifdef HAVE_PIPE
# ifdef EPIPE
if (EPIPE == errno)