mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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

58
libguile/ChangeLog
View file

@ -1,3 +1,61 @@
Tue Oct 14 22:03:06 1997 Tom Tromey <tromey@cygnus.com>
* Makefile.in: Rebuilt.
* 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.
1997-10-12 Mark Galassi <rosalia@cygnus.com>
* gh_test_repl.c (c_vector_test): same as gh_test_c.c

8
libguile/Makefile.am
View file

@ -17,11 +17,11 @@ guile_LDADD = libguile.la ${THREAD_LIBS}
libguile_la_SOURCES = \
alist.c appinit.c arbiters.c async.c boolean.c chars.c \
continuations.c dynl.c dynwind.c eq.c error.c eval.c extchrs.c \
continuations.c dynl.c dynwind.c eq.c error.c eval.c \
feature.c filesys.c fports.c gc.c gdbint.c genio.c gh_data.c gh_eval.c \
gh_funcs.c gh_init.c gh_io.c gh_list.c gh_predicates.c gsubr.c hash.c \
hashtab.c init.c ioext.c kw.c list.c load.c mallocs.c markers.c \
mbstrings.c net_db.c numbers.c objects.c objprop.c options.c pairs.c \
net_db.c numbers.c objects.c objprop.c options.c pairs.c \
ports.c posix.c print.c procprop.c procs.c ramap.c read.c root.c \
scmsigs.c script.c simpos.c smob.c socket.c stackchk.c stime.c \
strings.c strop.c strorder.c strports.c struct.c symbols.c tag.c \
@ -53,9 +53,9 @@ pkginclude_HEADERS = gh.h
modincludedir = $(includedir)/libguile
modinclude_HEADERS = __scm.h alist.h arbiters.h async.h \
backtrace.h boolean.h chars.h continuations.h debug.h dynl.h dynwind.h \
eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \
eq.h error.h eval.h feature.h filesys.h fports.h gc.h \
gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \
ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \
ioext.h kw.h list.h load.h mallocs.h markers.h net_db.h \
numbers.h objects.h objprop.h options.h pairs.h ports.h posix.h \
regex-posix.h print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h \
script.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \

60
libguile/Makefile.in
View file

@ -96,11 +96,11 @@ guile_LDADD = libguile.la ${THREAD_LIBS}
libguile_la_SOURCES = \
alist.c appinit.c arbiters.c async.c boolean.c chars.c \
continuations.c dynl.c dynwind.c eq.c error.c eval.c extchrs.c \
continuations.c dynl.c dynwind.c eq.c error.c eval.c \
feature.c filesys.c fports.c gc.c gdbint.c genio.c gh_data.c gh_eval.c \
gh_funcs.c gh_init.c gh_io.c gh_list.c gh_predicates.c gsubr.c hash.c \
hashtab.c init.c ioext.c kw.c list.c load.c mallocs.c markers.c \
mbstrings.c net_db.c numbers.c objects.c objprop.c options.c pairs.c \
net_db.c numbers.c objects.c objprop.c options.c pairs.c \
ports.c posix.c print.c procprop.c procs.c ramap.c read.c root.c \
scmsigs.c script.c simpos.c smob.c socket.c stackchk.c stime.c \
strings.c strop.c strorder.c strports.c struct.c symbols.c tag.c \
@ -128,9 +128,9 @@ pkginclude_HEADERS = gh.h
modincludedir = $(includedir)/libguile
modinclude_HEADERS = __scm.h alist.h arbiters.h async.h \
backtrace.h boolean.h chars.h continuations.h debug.h dynl.h dynwind.h \
eq.h error.h eval.h extchrs.h feature.h filesys.h fports.h gc.h \
eq.h error.h eval.h feature.h filesys.h fports.h gc.h \
gdb_interface.h gdbint.h genio.h gsubr.h hash.h hashtab.h init.h \
ioext.h kw.h list.h load.h mallocs.h markers.h mbstrings.h net_db.h \
ioext.h kw.h list.h load.h mallocs.h markers.h net_db.h \
numbers.h objects.h objprop.h options.h pairs.h ports.h posix.h \
regex-posix.h print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h \
script.h simpos.h smob.h socket.h srcprop.h stackchk.h stacks.h \
@ -178,16 +178,15 @@ LDFLAGS = @LDFLAGS@
LIBS = @LIBS@
libguile_la_OBJECTS = alist.lo appinit.lo arbiters.lo async.lo \
boolean.lo chars.lo continuations.lo dynl.lo dynwind.lo eq.lo error.lo \
eval.lo extchrs.lo feature.lo filesys.lo fports.lo gc.lo gdbint.lo \
genio.lo gh_data.lo gh_eval.lo gh_funcs.lo gh_init.lo gh_io.lo \
gh_list.lo gh_predicates.lo gsubr.lo hash.lo hashtab.lo init.lo \
ioext.lo kw.lo list.lo load.lo mallocs.lo markers.lo mbstrings.lo \
net_db.lo numbers.lo objects.lo objprop.lo options.lo pairs.lo ports.lo \
posix.lo print.lo procprop.lo procs.lo ramap.lo read.lo root.lo \
scmsigs.lo script.lo simpos.lo smob.lo socket.lo stackchk.lo stime.lo \
strings.lo strop.lo strorder.lo strports.lo struct.lo symbols.lo tag.lo \
throw.lo unif.lo variable.lo vectors.lo version.lo vports.lo weaks.lo \
fluids.lo
eval.lo feature.lo filesys.lo fports.lo gc.lo gdbint.lo genio.lo \
gh_data.lo gh_eval.lo gh_funcs.lo gh_init.lo gh_io.lo gh_list.lo \
gh_predicates.lo gsubr.lo hash.lo hashtab.lo init.lo ioext.lo kw.lo \
list.lo load.lo mallocs.lo markers.lo net_db.lo numbers.lo objects.lo \
objprop.lo options.lo pairs.lo ports.lo posix.lo print.lo procprop.lo \
procs.lo ramap.lo read.lo root.lo scmsigs.lo script.lo simpos.lo \
smob.lo socket.lo stackchk.lo stime.lo strings.lo strop.lo strorder.lo \
strports.lo struct.lo symbols.lo tag.lo throw.lo unif.lo variable.lo \
vectors.lo version.lo vports.lo weaks.lo fluids.lo
PROGRAMS = $(bin_PROGRAMS)
guile_OBJECTS = guile.o
@ -221,23 +220,22 @@ GZIP = --best
DEP_FILES = .deps/alist.P .deps/alloca.P .deps/appinit.P \
.deps/arbiters.P .deps/async.P .deps/backtrace.P .deps/boolean.P \
.deps/chars.P .deps/continuations.P .deps/debug.P .deps/dynl.P \
.deps/dynwind.P .deps/eq.P .deps/error.P .deps/eval.P .deps/extchrs.P \
.deps/feature.P .deps/filesys.P .deps/fluids.P .deps/fports.P \
.deps/gc.P .deps/gdbint.P .deps/genio.P .deps/gh_data.P .deps/gh_eval.P \
.deps/gh_funcs.P .deps/gh_init.P .deps/gh_io.P .deps/gh_list.P \
.deps/gh_predicates.P .deps/gh_test_c.P .deps/gh_test_repl.P \
.deps/gsubr.P .deps/guile.P .deps/hash.P .deps/hashtab.P \
.deps/inet_aton.P .deps/init.P .deps/ioext.P .deps/kw.P .deps/list.P \
.deps/load.P .deps/mallocs.P .deps/markers.P .deps/mbstrings.P \
.deps/net_db.P .deps/numbers.P .deps/objects.P .deps/objprop.P \
.deps/options.P .deps/pairs.P .deps/ports.P .deps/posix.P .deps/print.P \
.deps/procprop.P .deps/procs.P .deps/putenv.P .deps/ramap.P \
.deps/read.P .deps/regex-posix.P .deps/root.P .deps/scmsigs.P \
.deps/script.P .deps/simpos.P .deps/smob.P .deps/socket.P \
.deps/srcprop.P .deps/stackchk.P .deps/stacks.P .deps/stime.P \
.deps/strerror.P .deps/strings.P .deps/strop.P .deps/strorder.P \
.deps/strports.P .deps/struct.P .deps/symbols.P .deps/tag.P \
.deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \
.deps/dynwind.P .deps/eq.P .deps/error.P .deps/eval.P .deps/feature.P \
.deps/filesys.P .deps/fluids.P .deps/fports.P .deps/gc.P .deps/gdbint.P \
.deps/genio.P .deps/gh_data.P .deps/gh_eval.P .deps/gh_funcs.P \
.deps/gh_init.P .deps/gh_io.P .deps/gh_list.P .deps/gh_predicates.P \
.deps/gh_test_c.P .deps/gh_test_repl.P .deps/gsubr.P .deps/guile.P \
.deps/hash.P .deps/hashtab.P .deps/inet_aton.P .deps/init.P \
.deps/ioext.P .deps/kw.P .deps/list.P .deps/load.P .deps/mallocs.P \
.deps/markers.P .deps/net_db.P .deps/numbers.P .deps/objects.P \
.deps/objprop.P .deps/options.P .deps/pairs.P .deps/ports.P \
.deps/posix.P .deps/print.P .deps/procprop.P .deps/procs.P \
.deps/putenv.P .deps/ramap.P .deps/read.P .deps/regex-posix.P \
.deps/root.P .deps/scmsigs.P .deps/script.P .deps/simpos.P .deps/smob.P \
.deps/socket.P .deps/srcprop.P .deps/stackchk.P .deps/stacks.P \
.deps/stime.P .deps/strerror.P .deps/strings.P .deps/strop.P \
.deps/strorder.P .deps/strports.P .deps/struct.P .deps/symbols.P \
.deps/tag.P .deps/threads.P .deps/throw.P .deps/unif.P .deps/variable.P \
.deps/vectors.P .deps/version.P .deps/vports.P .deps/weaks.P
SOURCES = $(libguile_la_SOURCES) $(EXTRA_libguile_la_SOURCES) $(guile_SOURCES) $(gh_test_c_SOURCES) $(gh_test_repl_SOURCES)
OBJECTS = $(libguile_la_OBJECTS) $(guile_OBJECTS) $(gh_test_c_OBJECTS) $(gh_test_repl_OBJECTS)

8
libguile/arbiters.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -63,11 +63,11 @@ prinarb (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<arbiter ", port);
scm_puts ("#<arbiter ", port);
if (SCM_CAR (exp) & (1L << 16))
scm_gen_puts (scm_regular_string, "locked ", port);
scm_puts ("locked ", port);
scm_iprin1 (SCM_CDR (exp), port, pstate);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return !0;
}

4
libguile/async.c
View file

@ -273,9 +273,9 @@ print_async (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<async ", port);
scm_puts ("#<async ", port);
scm_intprint(exp, 16, port);
scm_gen_putc('>', port);
scm_putc('>', port);
return 1;
}

57
libguile/backtrace.c
View file

@ -79,14 +79,14 @@ display_header (source, port)
if (SCM_NIMP (fname) && SCM_STRINGP (fname))
{
scm_prin1 (fname, port, 0);
scm_gen_putc (':', port);
scm_putc (':', port);
scm_prin1 (scm_source_property (source, scm_i_line), port, 0);
scm_gen_putc (':', port);
scm_putc (':', port);
scm_prin1 (scm_source_property (source, scm_i_column), port, 0);
}
else
scm_gen_puts (scm_regular_string, "ERROR", port);
scm_gen_puts (scm_regular_string, ": ", port);
scm_puts ("ERROR", port);
scm_puts (": ", port);
}
@ -104,7 +104,7 @@ scm_display_error_message (message, args, port)
|| !scm_list_p (args))
{
scm_prin1 (message, port, 0);
scm_gen_putc ('\n', port);
scm_putc ('\n', port);
return;
}
@ -124,13 +124,13 @@ scm_display_error_message (message, args, port)
else
continue;
scm_gen_write (scm_regular_string, start, p - start - 1, port);
scm_lfwrite (start, p - start - 1, port);
scm_prin1 (SCM_CAR (args), port, writingp);
args = SCM_CDR (args);
start = p + 1;
}
scm_gen_write (scm_regular_string, start, p - start, port);
scm_gen_putc ('\n', port);
scm_lfwrite (start, p - start, port);
scm_putc ('\n', port);
}
static void display_expression SCM_P ((SCM frame, SCM pname, SCM source, SCM port));
@ -152,24 +152,24 @@ display_expression (frame, pname, source, port)
if (SCM_NIMP (frame)
&& SCM_FRAMEP (frame)
&& SCM_FRAME_EVAL_ARGS_P (frame))
scm_gen_puts (scm_regular_string, "While evaluating arguments to ", port);
scm_puts ("While evaluating arguments to ", port);
else
scm_gen_puts (scm_regular_string, "In procedure ", port);
scm_puts ("In procedure ", port);
scm_iprin1 (pname, port, pstate);
if (SCM_NIMP (source) && SCM_MEMOIZEDP (source))
{
scm_gen_puts (scm_regular_string, " in expression ", port);
scm_puts (" in expression ", port);
pstate->writingp = 1;
scm_iprin1 (scm_unmemoize (source), port, pstate);
}
}
else if (SCM_NIMP (source))
{
scm_gen_puts (scm_regular_string, "In expression ", port);
scm_puts ("In expression ", port);
pstate->writingp = 1;
scm_iprin1 (scm_unmemoize (source), port, pstate);
}
scm_gen_puts (scm_regular_string, ":\n", port);
scm_puts (":\n", port);
scm_free_print_state (print_state);
}
@ -229,13 +229,11 @@ display_error_handler (struct display_error_handler_data *data,
SCM tag, SCM args)
{
SCM print_state = scm_make_print_state ();
scm_gen_puts (scm_regular_string,
"\nException during displaying of ",
data->port);
scm_gen_puts (scm_regular_string, data->mode, data->port);
scm_gen_puts (scm_regular_string, ": ", data->port);
scm_puts ("\nException during displaying of ", data->port);
scm_puts (data->mode, data->port);
scm_puts (": ", data->port);
scm_iprin1 (tag, data->port, SCM_PRINT_STATE (print_state));
scm_gen_putc ('\n', data->port);
scm_putc ('\n', data->port);
return SCM_UNSPECIFIED;
}
@ -265,7 +263,7 @@ indent (n, port)
{
int i;
for (i = 0; i < n; ++i)
scm_gen_putc (' ', port);
scm_putc (' ', port);
}
static void display_frame_expr SCM_P ((char *hdr, SCM exp, char *tlr, int indentation, SCM sport, SCM port, scm_print_state *pstate));
@ -282,11 +280,11 @@ display_frame_expr (hdr, exp, tlr, indentation, sport, port, pstate)
if (SCM_NIMP (exp) && SCM_CONSP (exp))
{
scm_iprlist (hdr, exp, tlr[0], port, pstate);
scm_gen_puts (scm_regular_string, &tlr[1], port);
scm_puts (&tlr[1], port);
}
else
scm_iprin1 (exp, port, pstate);
scm_gen_putc ('\n', port);
scm_putc ('\n', port);
}
static void display_application SCM_P ((SCM frame, int indentation, SCM sport, SCM port, scm_print_state *pstate));
@ -356,7 +354,7 @@ display_frame (frame, nfield, indentation, sport, port, pstate)
if (!SCM_BACKWARDS_P && SCM_FRAME_OVERFLOW_P (frame))
{
indent (nfield + 1 + indentation, port);
scm_gen_puts (scm_regular_string, "...\n", port);
scm_puts ("...\n", port);
}
/* Check size of frame number. */
@ -370,7 +368,7 @@ display_frame (frame, nfield, indentation, sport, port, pstate)
scm_iprin1 (SCM_MAKINUM (n), port, pstate);
/* Real frame marker */
scm_gen_putc (SCM_FRAME_REAL_P (frame) ? '*' : ' ', port);
scm_putc (SCM_FRAME_REAL_P (frame) ? '*' : ' ', port);
/* Indentation. */
indent (indentation, port);
@ -398,7 +396,7 @@ display_frame (frame, nfield, indentation, sport, port, pstate)
if (SCM_BACKWARDS_P && SCM_FRAME_OVERFLOW_P (frame))
{
indent (nfield + 1 + indentation, port);
scm_gen_puts (scm_regular_string, "...\n", port);
scm_puts ("...\n", port);
}
}
@ -500,7 +498,7 @@ display_backtrace_body (struct display_backtrace_args *a, SCM jmpbuf)
for (i = 0; j > 0; ++i) j /= 10;
nfield = i ? i : 1;
scm_gen_puts (scm_regular_string, "Backtrace:\n", a->port);
scm_puts ("Backtrace:\n", a->port);
/* Print frames. */
frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
@ -549,8 +547,7 @@ scm_backtrace ()
if (SCM_FALSEP (SCM_CDR (scm_has_shown_backtrace_hint_p_var))
&& !SCM_BACKTRACE_P)
{
scm_gen_puts (scm_regular_string,
"Type \"(debug-enable 'backtrace)\" if you would like "
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
"a backtrace\n"
"automatically if an error occurs in the future.\n",
scm_cur_outp);
@ -559,9 +556,7 @@ scm_backtrace ()
}
else
{
scm_gen_puts (scm_regular_string,
"No backtrace available.\n",
scm_cur_outp);
scm_puts ("No backtrace available.\n", scm_cur_outp);
}
return SCM_UNSPECIFIED;
}

10
libguile/debug.c
View file

@ -1,5 +1,5 @@
/* Debugging extensions for Guile
* Copyright (C) 1995, 1996 Free Software Foundation
* Copyright (C) 1995, 1996, 1997 Free Software Foundation
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -140,11 +140,11 @@ prinmemoized (obj, port, pstate)
scm_print_state *pstate;
{
int writingp = SCM_WRITINGP (pstate);
scm_gen_puts (scm_regular_string, "#<memoized ", port);
scm_puts ("#<memoized ", port);
SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (scm_unmemoize (obj), port, pstate);
SCM_SET_WRITINGP (pstate, writingp);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}
@ -353,9 +353,9 @@ prindebugobj (obj, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<debug-object ", port);
scm_puts ("#<debug-object ", port);
scm_intprint (SCM_DEBUGOBJ_FRAME (obj), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}

6
libguile/dynl.c
View file

@ -321,11 +321,11 @@ print_dynl_obj (exp, port, pstate)
scm_print_state *pstate;
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
scm_gen_puts (scm_regular_string, "#<dynamic-object ", port);
scm_puts ("#<dynamic-object ", port);
scm_iprin1 (d->filename, port, pstate);
if (d->handle == NULL)
scm_gen_puts (scm_regular_string, " (unlinked)", port);
scm_gen_putc ('>', port);
scm_puts (" (unlinked)", port);
scm_putc ('>', port);
return 1;
}

4
libguile/eq.c
View file

@ -106,8 +106,8 @@ scm_equal_p (x, y)
y = SCM_CDR(y);
goto tailrecurse;
}
if (SCM_TYP7SD (x) == scm_tc7_string
&& SCM_TYP7SD (y) == scm_tc7_string)
if (SCM_TYP7S (x) == scm_tc7_string
&& SCM_TYP7S (y) == scm_tc7_string)
return scm_string_equal_p (x, y);
/* This ensures that types and scm_length are the same. */
if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;

6
libguile/eval.c
View file

@ -1938,9 +1938,7 @@ dispatch:
case scm_tc7_llvect:
#endif
case scm_tc7_string:
case scm_tc7_mb_string:
case scm_tc7_substring:
case scm_tc7_mb_substring:
case scm_tc7_smob:
case scm_tcs_closures:
case scm_tcs_subrs:
@ -3060,11 +3058,11 @@ prinprom (exp, port, pstate)
scm_print_state *pstate;
{
int writingp = SCM_WRITINGP (pstate);
scm_gen_puts (scm_regular_string, "#<promise ", port);
scm_puts ("#<promise ", port);
SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (SCM_CDR (exp), port, pstate);
SCM_SET_WRITINGP (pstate, writingp);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return !0;
}

0
libguile/extchrs.c
View file

0
libguile/extchrs.h
View file

6
libguile/fluids.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996 Free Software Foundation, Inc.
/* Copyright (C) 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -105,9 +105,9 @@ print_fluid (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<fluid ", port);
scm_puts ("#<fluid ", port);
scm_intprint (SCM_FLUID_NUM (exp), 10, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}

13
libguile/gc.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -712,12 +712,10 @@ gc_mark_nimp:
#endif
case scm_tc7_string:
case scm_tc7_mb_string:
SCM_SETGC8MARK (ptr);
break;
case scm_tc7_substring:
case scm_tc7_mb_substring:
if (SCM_GC8MARKP(ptr))
break;
SCM_SETGC8MARK (ptr);
@ -735,11 +733,8 @@ gc_mark_nimp:
sizeof (SCM *) * (scm_weak_size *= 2)));
if (scm_weak_vectors == NULL)
{
scm_gen_puts (scm_regular_string,
"weak vector table",
scm_cur_errp);
scm_gen_puts (scm_regular_string,
"\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
scm_puts ("weak vector table", scm_cur_errp);
scm_puts ("\nFATAL ERROR DURING CRITICAL SCM_CODE SECTION\n",
scm_cur_errp);
exit(SCM_EXIT_FAILURE);
}
@ -1173,12 +1168,10 @@ scm_gc_sweep ()
m += SCM_HUGE_LENGTH (scmptr) * 2 * sizeof (double);
goto freechars;
case scm_tc7_substring:
case scm_tc7_mb_substring:
if (SCM_GC8MARKP (scmptr))
goto c8mrkcontinue;
break;
case scm_tc7_string:
case scm_tc7_mb_string:
if (SCM_GC8MARKP (scmptr))
goto c8mrkcontinue;
m += SCM_HUGE_LENGTH (scmptr) + 1;

2
libguile/gdbint.c
View file

@ -1,5 +1,5 @@
/* GDB interface for Guile
* Copyright (C) 1996 Free Software Foundation
* Copyright (C) 1996, 1997 Free Software Foundation
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by

399
libguile/genio.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -39,7 +39,6 @@
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
#include "extchrs.h"
#include <stdio.h>
#include "_scm.h"
#include "chars.h"
@ -51,11 +50,7 @@
#endif
static void scm_putc SCM_P ((int c, SCM port));
static void
void
scm_putc (c, port)
int c;
SCM port;
@ -64,11 +59,7 @@ scm_putc (c, port)
SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
}
static void scm_puts SCM_P ((char *s, SCM port));
static void
void
scm_puts (s, port)
char *s;
SCM port;
@ -81,311 +72,24 @@ scm_puts (s, port)
#endif
}
static int scm_lfwrite SCM_P ((char *ptr, scm_sizet size, scm_sizet nitems, SCM port));
static int
scm_lfwrite (ptr, size, nitems, port)
void
scm_lfwrite (ptr, size, port)
char *ptr;
scm_sizet size;
scm_sizet nitems;
SCM port;
{
int ret;
scm_sizet i = SCM_PTOBNUM (port);
SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port))));
SCM_SYSCALL (scm_ptobs[i].fwrite(ptr, size, 1, SCM_STREAM (port)));
#ifdef TRANSCRIPT_SUPPORT
if (scm_trans && (port == def_outp || port == cur_errp))
SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans));
SCM_SYSCALL (fwrite (ptr, size, 1, scm_trans));
#endif
return ret;
}
void
scm_gen_putc (c, port)
int c;
SCM port;
{
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
{
/* Nothing good to do with extended chars here...
* just truncate them.
*/
scm_putc ((unsigned char)c, port);
break;
}
case scm_mb_port:
{
char buf[256];
int len;
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c),
"huge translation", "scm_gen_putc");
len = xwctomb (buf, c);
SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc");
if (len == 0)
scm_putc (0, port);
else
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
break;
}
case scm_wchar_port:
{
scm_putc (((unsigned char)(c >> 8) & 0xff), port);
scm_putc ((unsigned char)(c & 0xff), port);
break;
}
}
}
void
scm_gen_puts (rep, str_data, port)
enum scm_string_representation_type rep;
char *str_data;
SCM port;
{
switch (rep)
{
case scm_regular_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_puts (str_data, port);
return;
case scm_wchar_port:
{
while (*str_data)
{
scm_putc (0, port);
scm_putc (*str_data, port);
++str_data;
}
return;
}
}
case scm_mb_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_puts (str_data, port);
return;
case scm_wchar_port:
{
xwchar_t output;
int len;
int size;
size = strlen (str_data);
while (size)
{
len = xmbtowc (&output, str_data, size);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data),
"bogus character", "scm_gen_puts");
scm_putc ((output >> 8) & 0xff, port);
scm_putc (output & 0xff, port);
size -= len;
str_data += len;
}
return;
}
}
case scm_wchar_string:
{
xwchar_t * wstr_data;
wstr_data = (xwchar_t *) str_data;
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
while (*wstr_data)
{
scm_putc ((unsigned char) *wstr_data, port);
++wstr_data;
}
return;
case scm_mb_port:
{
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
while (*wstr_data)
{
int len;
len = xwctomb (buf, *wstr_data);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
++wstr_data;
}
return;
}
case scm_wchar_port:
{
int len;
for (len = 0; wstr_data[len]; ++len)
;
scm_lfwrite (str_data, sizeof (xwchar_t), len, port);
return;
}
}
}
}
}
void
scm_gen_write (rep, str_data, nitems, port)
enum scm_string_representation_type rep;
char *str_data;
scm_sizet nitems;
SCM port;
{
/* is nitems bytes or characters in the mb_string case? */
switch (rep)
{
case scm_regular_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_lfwrite (str_data, 1, nitems, port);
return;
case scm_wchar_port:
{
while (nitems)
{
scm_putc (0, port);
scm_putc (*str_data, port);
++str_data;
--nitems;
}
return;
}
}
case scm_mb_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_lfwrite (str_data, 1, nitems, port);
return;
case scm_wchar_port:
{
xwchar_t output;
int len;
while (nitems)
{
len = xmbtowc (&output, str_data, nitems);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
scm_putc ((output >> 8) & 0xff, port);
scm_putc (output & 0xff, port);
nitems -= len;
str_data += len;
}
return;
}
}
case scm_wchar_string:
{
xwchar_t * wstr_data;
wstr_data = (xwchar_t *) str_data;
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
while (nitems)
{
scm_putc ((unsigned char) *wstr_data, port);
++wstr_data;
--nitems;
}
return;
case scm_mb_port:
{
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
while (nitems)
{
int len;
len = xwctomb (buf, *wstr_data);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
++wstr_data;
--nitems;
}
return;
}
case scm_wchar_port:
{
scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port);
return;
}
}
}
}
}
static int scm_getc SCM_P ((SCM port));
static int
int
scm_getc (port)
SCM port;
{
@ -393,26 +97,19 @@ scm_getc (port)
int c;
scm_sizet i;
f = SCM_STREAM (port);
i = SCM_PTOBNUM (port);
SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
return c;
}
int
scm_gen_getc (port)
SCM port;
{
int c;
/* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
if (SCM_CRDYP (port))
{
c = SCM_CGETUN (port);
SCM_CLRDY (port); /* Clear ungetted char */
}
else
{
f = SCM_STREAM (port);
i = SCM_PTOBNUM (port);
SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
}
return_c:
if (c == '\n')
{
SCM_INCLINE (port);
@ -425,75 +122,17 @@ scm_gen_getc (port)
{
SCM_INCCOL (port);
}
return c;
}
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
c = scm_getc (port);
goto return_c;
case scm_mb_port:
{
int x;
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
x = 0;
while (1)
{
xwchar_t out;
c = scm_getc (port);
if (c == EOF)
return EOF;
buf[x] = c;
if (xmbtowc (&out, buf, x + 1) > 0)
{
c = out;
goto return_c;
}
SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_getc");
++x;
}
}
case scm_wchar_port:
{
int hi;
int lo;
hi = scm_getc (port);
lo = (hi == EOF
? EOF
: scm_getc (port));
c = ((hi == EOF)
? EOF
: ((hi << 8) | lo));
goto return_c;
}
default:
return EOF;
}
}
void
scm_gen_ungetc (c, port)
scm_ungetc (c, port)
int c;
SCM port;
{
/* SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/
/* SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_ungetc");*/
SCM_CUNGET (c, port);
if (c == '\n')
{
@ -508,7 +147,7 @@ scm_gen_ungetc (c, port)
char *
scm_gen_read_line (port)
scm_do_read_line (port)
SCM port;
{
char *s;

17
libguile/genio.h
View file

@ -2,7 +2,7 @@
#ifndef GENIOH
#define GENIOH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -48,13 +48,12 @@
extern void scm_gen_putc SCM_P ((int c, SCM port));
extern void scm_gen_puts SCM_P ((enum scm_string_representation_type rep,
char *str_data,
SCM port));
extern void scm_gen_write SCM_P ((enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port));
extern int scm_gen_getc SCM_P ((SCM port));
extern void scm_gen_ungetc SCM_P ((int c, SCM port));
extern char *scm_gen_read_line SCM_P ((SCM port));
extern void scm_putc SCM_P ((int c, SCM port));
extern void scm_puts SCM_P ((char *str_data, SCM port));
extern void scm_lfwrite SCM_P ((char *ptr, scm_sizet size, SCM port));
extern int scm_getc SCM_P ((SCM port));
extern void scm_ungetc SCM_P ((int c, SCM port));
/* FIXME: this is a terrible name. */
extern char *scm_do_read_line SCM_P ((SCM port));
#endif /* GENIOH */

594
libguile/gscm.c
View file

@ -1,594 +0,0 @@
/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
#include <stdio.h>
#include <sys/param.h>
#include "gscm.h"
#include "_scm.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
extern char *getenv ();
/* {Top Level Evaluation}
*
* Top level evaluation has to establish a dynamic root context,
* enable Scheme signal handlers, and catch global escapes (errors, quits,
* aborts, restarts, and execs) from the interpreter.
*/
/* {Printing Objects to Strings}
*/
static GSCM_status gscm_portprint_obj SCM_P ((SCM port, SCM obj));
static GSCM_status
gscm_portprint_obj (port, obj)
SCM port;
SCM obj;
{
scm_prin1 (obj, port, 1);
return GSCM_OK;
}
struct seval_str_frame
{
GSCM_status status;
SCM * answer;
GSCM_top_level top;
char * str;
};
static void _seval_str_fn SCM_P ((void * vframe));
static void
_seval_str_fn (vframe)
void * vframe;
{
struct seval_str_frame * frame;
frame = (struct seval_str_frame *)vframe;
frame->status = gscm_seval_str (frame->answer, frame->top, frame->str);
}
static GSCM_status gscm_strprint_obj SCM_P ((SCM * answer, SCM obj));
static GSCM_status
gscm_strprint_obj (answer, obj)
SCM * answer;
SCM obj;
{
SCM str;
SCM port;
GSCM_status stat;
str = scm_makstr (64, 0);
port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "gscm_strprint_obj");
stat = gscm_portprint_obj (port, obj);
if (stat == GSCM_OK)
*answer = str;
else
*answer = SCM_BOOL_F;
return stat;
}
static GSCM_status gscm_cstr SCM_P ((char ** answer, SCM obj));
static GSCM_status
gscm_cstr (answer, obj)
char ** answer;
SCM obj;
{
GSCM_status stat;
*answer = (char *)malloc (SCM_LENGTH (obj));
stat = GSCM_OK;
if (!*answer)
stat = GSCM_OUT_OF_MEM;
else
memcpy (*answer, SCM_CHARS (obj), SCM_LENGTH (obj));
return stat;
}
/* {Invoking The Interpreter}
*/
static SCM gscm_silent_repl SCM_P ((SCM env));
static SCM
gscm_silent_repl (env)
SCM env;
{
SCM source;
SCM answer;
answer = SCM_UNSPECIFIED;
while ((source = scm_read (SCM_UNDEFINED, SCM_UNDEFINED, SCM_UNDEFINED)) != SCM_EOF_VAL)
answer = scm_eval_x (source);
return answer;
}
#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif
static GSCM_status _eval_port SCM_P ((SCM * answer, GSCM_top_level toplvl, SCM port, int printp));
static GSCM_status
_eval_port (answer, toplvl, port, printp)
SCM * answer;
GSCM_top_level toplvl;
SCM port;
int printp;
{
SCM saved_inp;
GSCM_status status;
setjmp_type i;
static int deja_vu = 0;
SCM ignored;
if (deja_vu)
return GSCM_ILLEGALLY_REENTERED;
++deja_vu;
/* Take over signal handlers for all the interesting signals.
*/
scm_init_signals ();
/* Default return values:
*/
if (!answer)
answer = &ignored;
status = GSCM_OK;
*answer = SCM_BOOL_F;
/* Perform evalutation under a new dynamic root.
*
*/
SCM_BASE (scm_rootcont) = (SCM_STACKITEM *) & i;
#ifdef DEBUG_EXTENSIONS
SCM_DFRAME (scm_rootcont) = scm_last_debug_frame = 0;
#endif
saved_inp = scm_cur_inp;
i = setjmp (SCM_JMPBUF (scm_rootcont));
#ifdef STACK_CHECKING
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
#endif
if (!i)
{
scm_gc_heap_lock = 0;
scm_ints_disabled = 0;
/* need to close loading files here. */
scm_cur_inp = port;
{
SCM top_env;
top_env = SCM_EOL;
*answer = gscm_silent_repl (top_env);
}
scm_cur_inp = saved_inp;
if (printp)
status = gscm_strprint_obj (answer, *answer);
}
else
{
scm_cur_inp = saved_inp;
*answer = scm_exitval;
if (printp)
gscm_strprint_obj (answer, *answer);
status = GSCM_ERROR;
}
scm_gc_heap_lock = 1;
scm_ints_disabled = 1;
scm_restore_signals ();
--deja_vu;
return status;
}
static GSCM_status seval_str SCM_P ((SCM *answer, GSCM_top_level toplvl, char * str));
static GSCM_status
seval_str (answer, toplvl, str)
SCM *answer;
GSCM_top_level toplvl;
char * str;
{
SCM scheme_str;
SCM port;
GSCM_status status;
scheme_str = scm_makfromstr (str, strlen (str), 0);
port = scm_mkstrport (SCM_MAKINUM (0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_seval_str");
status = _eval_port (answer, toplvl, port, 0);
return status;
}
GSCM_status
gscm_seval_str (answer, toplvl, str)
SCM *answer;
GSCM_top_level toplvl;
char * str;
{
SCM_STACKITEM i;
GSCM_status status;
scm_stack_base = &i;
status = seval_str (answer, toplvl, str);
scm_stack_base = 0;
return status;
}
void
format_load_command (buf, file_name)
char * buf;
char *file_name;
{
char quoted_name[MAXPATHLEN + 1];
int source;
int dest;
for (source = dest = 0; file_name[source]; ++source)
{
if (file_name[source] == '"')
quoted_name[dest++] = '\\';
quoted_name[dest++] = file_name[source];
}
quoted_name[dest] = 0;
sprintf (buf, "(%%try-load \"%s\")", quoted_name);
}
GSCM_status
gscm_seval_file (answer, toplvl, file_name)
SCM *answer;
GSCM_top_level toplvl;
char * file_name;
{
char command[MAXPATHLEN * 3];
format_load_command (command, file_name);
return gscm_seval_str (answer, toplvl, command);
}
static GSCM_status eval_str SCM_P ((char ** answer, GSCM_top_level toplvl, char * str));
static GSCM_status
eval_str (answer, toplvl, str)
char ** answer;
GSCM_top_level toplvl;
char * str;
{
SCM sanswer;
SCM scheme_str;
SCM port;
GSCM_status status;
scheme_str = scm_makfromstr (str, strlen (str), 0);
port = scm_mkstrport (SCM_MAKINUM(0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_eval_str");
status = _eval_port (&sanswer, toplvl, port, 1);
if (answer)
{
if (status == GSCM_OK)
status = gscm_cstr (answer, sanswer);
else
*answer = 0;
}
return status;
}
GSCM_status
gscm_eval_str (answer, toplvl, str)
char ** answer;
GSCM_top_level toplvl;
char * str;
{
SCM_STACKITEM i;
GSCM_status status;
scm_stack_base = &i;
status = eval_str (answer, toplvl, str);
scm_stack_base = 0;
return status;
}
GSCM_status
gscm_eval_file (answer, toplvl, file_name)
char ** answer;
GSCM_top_level toplvl;
char * file_name;
{
char command[MAXPATHLEN * 3];
format_load_command (command, file_name);
return gscm_eval_str (answer, toplvl, command);
}
/* {Error Messages}
*/
#ifdef __GNUC__
# define AT(X) [X] =
#else
# define AT(X)
#endif
static char * gscm_error_msgs[] =
{
AT(GSCM_OK) "No error.",
AT(GSCM_ERROR) "ERROR in init file.",
AT(GSCM_ILLEGALLY_REENTERED) "Gscm function was illegally reentered.",
AT(GSCM_OUT_OF_MEM) "Out of memory.",
AT(GSCM_ERROR_OPENING_FILE) "Error opening file.",
AT(GSCM_ERROR_OPENING_INIT_FILE) "Error opening init file."
};
char *
gscm_error_msg (n)
int n;
{
if ((n < 0) || (n > (sizeof (gscm_error_msgs) / sizeof (char *))))
return "Unrecognized error.";
else
return gscm_error_msgs[n];
}
/* {Defining New Procedures}
*/
SCM
gscm_make_subr (fn, req, opt, varp, doc)
SCM (*fn)();
int req;
int opt;
int varp;
char * doc;
{
return scm_make_gsubr ("*anonymous*", req, opt, varp, fn);
}
int
gscm_2_char (c)
SCM c;
{
SCM_ASSERT (SCM_ICHRP (c), c, SCM_ARG1, "gscm_2_char");
return SCM_ICHR (c);
}
void
gscm_2_str (out, len_out, objp)
char ** out;
int * len_out;
SCM * objp;
{
SCM_ASSERT (SCM_NIMP (*objp) && SCM_STRINGP (*objp), *objp, SCM_ARG3, "gscm_2_str");
if (out)
*out = SCM_CHARS (*objp);
if (len_out)
*len_out = SCM_LENGTH (*objp);
}
void
gscm_error (message, args)
char * message;
SCM args;
{
SCM errsym;
SCM str;
errsym = SCM_CAR (scm_intern ("error", 5));
str = scm_makfrom0str (message);
scm_throw (errsym, scm_cons (str, args));
}
GSCM_status
gscm_run_scm (argc, argv, in, out, err, initfn, initfile, initcmd)
int argc;
char ** argv;
FILE * in;
FILE * out;
FILE * err;
GSCM_status (*initfn)();
char * initfile;
char * initcmd;
{
SCM_STACKITEM i;
GSCM_status status;
GSCM_top_level top;
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
scm_init_storage (0);
scm_start_stack (&i, in, out, err);
scm_init_gsubr ();
scm_init_curry ();
scm_init_feature ();
/* scm_init_debug (); */
scm_init_alist ();
scm_init_append ();
scm_init_arbiters ();
scm_init_async ();
scm_init_boolean ();
scm_init_chars ();
scm_init_continuations ();
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
scm_init_fports ();
scm_init_files ();
scm_init_gc ();
scm_init_hash ();
scm_init_hashtab ();
scm_init_kw ();
scm_init_list ();
scm_init_lvectors ();
scm_init_numbers ();
scm_init_pairs ();
scm_init_ports ();
scm_init_procs ();
scm_init_procprop ();
scm_init_scmsigs ();
scm_init_stackchk ();
scm_init_strports ();
scm_init_struct ();
scm_init_symbols ();
scm_init_load ();
scm_init_print ();
scm_init_read ();
scm_init_sequences ();
scm_init_stime ();
scm_init_strings ();
scm_init_strorder ();
scm_init_mbstrings ();
scm_init_strop ();
scm_init_throw ();
scm_init_variable ();
scm_init_vectors ();
scm_init_version ();
scm_init_weaks ();
scm_init_vports ();
scm_init_eval ();
scm_init_ramap ();
scm_init_unif ();
scm_init_simpos ();
scm_init_elisp ();
scm_init_mallocs ();
scm_init_cnsvobj ();
scm_init_guile ();
initfn ();
/* Save the argument list to be the return value of (program-arguments).
*/
scm_progargs = scm_makfromstrs (argc, argv);
scm_gc_heap_lock = 0;
errno = 0;
scm_ints_disabled = 1;
/* init_basic (); */
/* init_init(); */
if (initfile == NULL)
{
initfile = getenv ("GUILE_INIT_PATH");
if (initfile == NULL)
initfile = SCM_IMPLINIT;
}
if (initfile == NULL)
{
status = GSCM_OK;
}
else
{
SCM answer;
status = gscm_seval_file (&answer, -1, initfile);
if ((status == GSCM_OK) && (answer == SCM_BOOL_F))
status = GSCM_ERROR_OPENING_INIT_FILE;
}
top = SCM_EOL;
if (status == GSCM_OK)
{
scm_sysintern ("*stdin*", scm_cur_inp);
status = gscm_seval_str (0, top, initcmd);
}
return status;
}
void
scm_init_guile ()
{
#include "gscm.x"
}

10
libguile/gsubr.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -172,13 +172,13 @@ SCM
gsubr_21l(req1, req2, opt, rst)
SCM req1, req2, opt, rst;
{
scm_gen_puts (scm_regular_string, "gsubr-2-1-l:\n req1: ", scm_cur_outp);
scm_puts ("gsubr-2-1-l:\n req1: ", scm_cur_outp);
scm_display(req1, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n req2: ", scm_cur_outp);
scm_puts ("\n req2: ", scm_cur_outp);
scm_display(req2, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n opt: ", scm_cur_outp);
scm_puts ("\n opt: ", scm_cur_outp);
scm_display(opt, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n rest: ", scm_cur_outp);
scm_puts ("\n rest: ", scm_cur_outp);
scm_display(rst, scm_cur_outp);
scm_newline(scm_cur_outp);
return SCM_UNSPECIFIED;

4
libguile/hash.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -98,9 +98,7 @@ scm_hasher(obj, n, d)
}
case scm_tcs_symbols:
case scm_tc7_string:
case scm_tc7_mb_string:
case scm_tc7_substring:
case scm_tc7_mb_substring:
return scm_strhash(SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj), n);
case scm_tc7_wvect:
case scm_tc7_vector:

2
libguile/init.c
View file

@ -73,7 +73,6 @@
#include "list.h"
#include "load.h"
#include "mallocs.h"
#include "mbstrings.h"
#include "net_db.h"
#include "numbers.h"
#include "objects.h"
@ -443,7 +442,6 @@ scm_boot_guile_1 (base, closure)
scm_init_stime ();
scm_init_strings ();
scm_init_strorder ();
scm_init_mbstrings ();
scm_init_strop ();
scm_init_throw ();
scm_init_variable ();

6
libguile/ioext.c
View file

@ -117,13 +117,13 @@ scm_read_delimited_x (delims, buf, gobble, port, start, end)
{
int k;
c = scm_gen_getc (port);
c = scm_getc (port);
for (k = 0; k < num_delims; k++)
{
if (cdelims[k] == c)
{
if (SCM_FALSEP (gobble))
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
return scm_cons (SCM_MAKICHR (c),
scm_long2num (j - cstart));
@ -154,7 +154,7 @@ scm_read_line (port)
port, SCM_ARG1, s_read_line);
}
s = scm_gen_read_line (port);
s = scm_do_read_line (port);
return (s == NULL ? SCM_EOF_VAL : scm_makfrom0str (s));
}

11
libguile/kw.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -43,7 +43,6 @@
#include <stdio.h>
#include "_scm.h"
#include "genio.h"
#include "mbstrings.h"
#include "smob.h"
#include "kw.h"
@ -68,12 +67,8 @@ prin_kw (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#:", port);
scm_gen_puts((SCM_MB_STRINGP(SCM_CDR (exp))
? scm_mb_string
: scm_regular_string),
1 + SCM_CHARS (SCM_CDR (exp)),
port);
scm_puts ("#:", port);
scm_puts(1 + SCM_CHARS (SCM_CDR (exp)), port);
return 1;
}

4
libguile/libguile.h
View file

@ -1,7 +1,7 @@
#ifndef LIBGUILEH
#define LIBGUILEH
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -68,7 +68,6 @@
#include "libguile/eq.h"
#include "libguile/error.h"
#include "libguile/eval.h"
#include "libguile/extchrs.h"
#include "libguile/feature.h"
#include "libguile/filesys.h"
#include "libguile/fports.h"
@ -85,7 +84,6 @@
#include "libguile/load.h"
#include "libguile/mallocs.h"
#include "libguile/markers.h"
#include "libguile/mbstrings.h"
#include "libguile/net_db.h"
#include "libguile/numbers.h"
#include "libguile/objprop.h"

6
libguile/mallocs.c
View file

@ -1,6 +1,6 @@
/* classes: src_files */
/* Copyright (C) 1995 Free Software Foundation, Inc.
/* Copyright (C) 1995, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -58,9 +58,9 @@ prinmalloc (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts(scm_regular_string, "#<malloc ", port);
scm_puts("#<malloc ", port);
scm_intprint(SCM_CDR(exp), 16, port);
scm_gen_putc('>', port);
scm_putc('>', port);
return 1;
}

0
libguile/mbstrings.c
View file

0
libguile/mbstrings.h
View file

6
libguile/numbers.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -1441,7 +1441,7 @@ scm_floprint(sexp, port, pstate)
{
#ifdef SCM_FLOATS
char num_buf[SCM_FLOBUFLEN];
scm_gen_write (scm_regular_string, num_buf, iflo2str(sexp, num_buf), port);
scm_lfwrite (num_buf, iflo2str(sexp, num_buf), port);
#else
scm_ipruk("float", sexp, port);
#endif
@ -1458,7 +1458,7 @@ scm_bigprint(exp, port, pstate)
{
#ifdef SCM_BIGDIG
exp = big2str(exp, (unsigned int)10);
scm_gen_write (scm_regular_string, SCM_CHARS(exp), (scm_sizet)SCM_LENGTH(exp), port);
scm_lfwrite (SCM_CHARS(exp), (scm_sizet)SCM_LENGTH(exp), port);
#else
scm_ipruk("bignum", exp, port);
#endif

25
libguile/ports.c
View file

@ -258,7 +258,6 @@ scm_add_to_port_table (port)
scm_port_table[scm_port_table_size]->file_name = SCM_BOOL_F;
scm_port_table[scm_port_table_size]->line_number = 1;
scm_port_table[scm_port_table_size]->column_number = 0;
scm_port_table[scm_port_table_size]->representation = scm_regular_port;
return scm_port_table[scm_port_table_size++];
}
@ -543,7 +542,7 @@ scm_read_char (port)
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_read_char);
c = scm_gen_getc (port);
c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
return SCM_MAKICHR (c);
@ -561,10 +560,10 @@ scm_peek_char (port)
port = scm_cur_inp;
else
SCM_ASSERT (SCM_NIMP (port) && SCM_OPINPORTP (port), port, SCM_ARG1, s_peek_char);
c = scm_gen_getc (port);
c = scm_getc (port);
if (EOF == c)
return SCM_EOF_VAL;
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
return SCM_MAKICHR (c);
}
@ -642,7 +641,7 @@ scm_unread_char (cobj, port)
c = SCM_ICHR (cobj);
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
return cobj;
}
@ -765,25 +764,25 @@ scm_prinport (exp, port, type)
SCM port;
char *type;
{
scm_gen_puts (scm_regular_string, "#<", port);
scm_puts ("#<", port);
if (SCM_CLOSEDP (exp))
scm_gen_puts (scm_regular_string, "closed: ", port);
scm_puts ("closed: ", port);
else
{
if (SCM_RDNG & SCM_CAR (exp))
scm_gen_puts (scm_regular_string, "input: ", port);
scm_puts ("input: ", port);
if (SCM_WRTNG & SCM_CAR (exp))
scm_gen_puts (scm_regular_string, "output: ", port);
scm_puts ("output: ", port);
}
scm_gen_puts (scm_regular_string, type, port);
scm_gen_putc (' ', port);
scm_puts (type, port);
scm_putc (' ', port);
#ifndef MSDOS
#ifndef __EMX__
#ifndef _DCC
#ifndef AMIGA
#ifndef THINK_C
if (SCM_OPENP (exp) && scm_tc16_fport == SCM_TYP16 (exp) && isatty (fileno ((FILE *)SCM_STREAM (exp))))
scm_gen_puts (scm_regular_string, ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
scm_puts (ttyname (fileno ((FILE *)SCM_STREAM (exp))), port);
else
#endif
#endif
@ -794,7 +793,7 @@ scm_prinport (exp, port, type)
scm_intprint ((long) fileno ((FILE *)SCM_STREAM (exp)), 10, port);
else
scm_intprint (SCM_CDR (exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
}

19
libguile/ports.h
View file

@ -50,21 +50,6 @@
enum scm_port_representation_type
{
scm_regular_port,
scm_mb_port,
scm_wchar_port
};
enum scm_string_representation_type
{
scm_regular_string = scm_regular_port,
scm_mb_string = scm_mb_port,
scm_wchar_string = scm_wchar_port
};
struct scm_port_table
{
SCM port; /* Open port. */
@ -78,8 +63,6 @@ struct scm_port_table
int line_number; /* debugging support. */
int column_number; /* debugging support. */
enum scm_port_representation_type representation;
};
extern struct scm_port_table **scm_port_table;
@ -124,8 +107,6 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table. */
#define SCM_COL(x) SCM_PTAB_ENTRY(x)->column_number
#define SCM_REVEALED(x) SCM_PTAB_ENTRY(x)->revealed
#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = s)
#define SCM_PORT_REPRESENTATION(x) SCM_PTAB_ENTRY(x)->representation
#define SCM_SET_PORT_REPRESENTATION(x,s) (SCM_PTAB_ENTRY(x)->representation = s)
#define SCM_CRDYP(port) (SCM_CAR (port) & SCM_CRDY)
#define SCM_CLRDY(port) {SCM_SETAND_CAR (port, SCM_CUC);}
#define SCM_SETRDY(port) {SCM_SETOR_CAR (port, SCM_CRDY);}

157
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),
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)

100
libguile/read.c
View file

@ -40,14 +40,12 @@
* If you do not wish that, delete this exception notice. */
#include "extchrs.h"
#include <stdio.h>
#include "_scm.h"
#include "chars.h"
#include "genio.h"
#include "eval.h"
#include "unif.h"
#include "mbstrings.h"
#include "kw.h"
#include "alist.h"
#include "srcprop.h"
@ -109,7 +107,7 @@ scm_read (port)
c = scm_flush_ws (port, (char *) NULL);
if (EOF == c)
return SCM_EOF_VAL;
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
tok_buf = scm_makstr (30L, 0);
return scm_lreadr (&tok_buf, port, &copy);
@ -134,7 +132,7 @@ scm_flush_ws (port, eoferr)
{
register int c;
while (1)
switch (c = scm_gen_getc (port))
switch (c = scm_getc (port))
{
case EOF:
goteof:
@ -143,7 +141,7 @@ scm_flush_ws (port, eoferr)
return c;
case ';':
lp:
switch (c = scm_gen_getc (port))
switch (c = scm_getc (port))
{
case EOF:
goto goteof;
@ -254,7 +252,7 @@ skip_scsh_block_comment (port)
for (;;)
{
int c = scm_gen_getc (port);
int c = scm_getc (port);
if (c == EOF)
scm_wta (SCM_UNDEFINED,
@ -305,12 +303,12 @@ tryagain_no_flush_ws:
p = scm_i_quasiquote;
goto recquote;
case ',':
c = scm_gen_getc (port);
c = scm_getc (port);
if ('@' == c)
p = scm_i_uq_splicing;
else
{
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
p = scm_i_unquote;
}
recquote:
@ -331,7 +329,7 @@ tryagain_no_flush_ws:
SCM_EOL));
return p;
case '#':
c = scm_gen_getc (port);
c = scm_getc (port);
switch (c)
{
case '(':
@ -357,7 +355,7 @@ tryagain_no_flush_ws:
case 'I':
case 'e':
case 'E':
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
c = '#';
goto num;
@ -380,12 +378,10 @@ tryagain_no_flush_ws:
case '{':
j = scm_read_token (c, tok_buf, port, 1);
p = scm_intern (SCM_CHARS (*tok_buf), j);
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
return SCM_CAR (p);
case '\\':
c = scm_gen_getc (port);
c = scm_getc (port);
j = scm_read_token (c, tok_buf, port, 0);
if (j == 1)
return SCM_MAKICHR (c);
@ -405,8 +401,6 @@ tryagain_no_flush_ws:
case ':':
j = scm_read_token ('-', tok_buf, port, 0);
p = scm_intern (SCM_CHARS (*tok_buf), j);
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
default:
@ -439,15 +433,15 @@ tryagain_no_flush_ws:
case '"':
j = 0;
while ('"' != (c = scm_gen_getc (port)))
while ('"' != (c = scm_getc (port)))
{
SCM_ASSERT (EOF != c, SCM_UNDEFINED, "end of file in ", "string");
while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
while (j + 2 >= SCM_LENGTH (*tok_buf))
scm_grow_tok_buf (tok_buf);
if (c == '\\')
switch (c = scm_gen_getc (port))
switch (c = scm_getc (port))
{
case '\n':
continue;
@ -473,31 +467,15 @@ tryagain_no_flush_ws:
c = '\v';
break;
}
if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
{
SCM_CHARS (*tok_buf)[j] = c;
++j;
}
else
{
int len;
len = xwctomb (SCM_CHARS (*tok_buf) + j, c);
if (len == 0)
len = 1;
SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
j += len;
}
}
if (j == 0)
return scm_nullstr;
SCM_CHARS (*tok_buf)[j] = 0;
{
SCM str;
str = scm_makfromstr (SCM_CHARS (*tok_buf), j, 0);
if (SCM_PORT_REPRESENTATION(port) != scm_regular_port)
{
SCM_SETLENGTH (str, SCM_LENGTH (str), scm_tc7_mb_string);
}
return str;
}
@ -513,9 +491,9 @@ tryagain_no_flush_ws:
return p;
if (c == '#')
{
if ((j == 2) && (scm_gen_getc (port) == '('))
if ((j == 2) && (scm_getc (port) == '('))
{
scm_gen_ungetc ('(', port);
scm_ungetc ('(', port);
c = SCM_CHARS (*tok_buf)[1];
goto callshrp;
}
@ -528,8 +506,6 @@ tryagain_no_flush_ws:
{
j = scm_read_token ('-', tok_buf, port, 0);
p = scm_intern (SCM_CHARS (*tok_buf), j);
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
}
/* fallthrough */
@ -539,8 +515,6 @@ tryagain_no_flush_ws:
tok:
p = scm_intern (SCM_CHARS (*tok_buf), j);
if (SCM_PORT_REPRESENTATION (port) != scm_regular_port)
scm_set_symbol_multi_byte_x (SCM_CAR (p), SCM_BOOL_T);
return SCM_CAR (p);
}
}
@ -568,29 +542,17 @@ scm_read_token (ic, tok_buf, port, weird)
else
{
j = 0;
while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
while (j + 2 >= SCM_LENGTH (*tok_buf))
p = scm_grow_tok_buf (tok_buf);
if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
{
p[j] = c;
++j;
}
else
{
int len;
len = xwctomb (p + j, c);
if (len == 0)
len = 1;
SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
j += len;
}
}
while (1)
{
while (j + sizeof(xwchar_t) + XMB_CUR_MAX >= SCM_LENGTH (*tok_buf))
while (j + 2 >= SCM_LENGTH (*tok_buf))
p = scm_grow_tok_buf (tok_buf);
c = scm_gen_getc (port);
c = scm_getc (port);
switch (c)
{
case '(':
@ -602,7 +564,7 @@ scm_read_token (ic, tok_buf, port, weird)
if (weird)
goto default_case;
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
case EOF:
eof_case:
p[j] = 0;
@ -612,7 +574,7 @@ scm_read_token (ic, tok_buf, port, weird)
goto default_case;
else
{
c = scm_gen_getc (port);
c = scm_getc (port);
if (c == EOF)
goto eof_case;
else
@ -622,7 +584,7 @@ scm_read_token (ic, tok_buf, port, weird)
if (!weird)
goto default_case;
c = scm_gen_getc (port);
c = scm_getc (port);
if (c == '#')
{
p[j] = 0;
@ -630,7 +592,7 @@ scm_read_token (ic, tok_buf, port, weird)
}
else
{
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
c = '}';
goto default_case;
}
@ -639,21 +601,9 @@ scm_read_token (ic, tok_buf, port, weird)
default_case:
{
c = (SCM_CASE_INSENSITIVE_P ? scm_downcase(c) : c);
if (SCM_PORT_REPRESENTATION(port) == scm_regular_port)
{
p[j] = c;
++j;
}
else
{
int len;
len = xwctomb (p + j, c);
if (len == 0)
len = 1;
SCM_ASSERT (len > 0, SCM_MAKINUM (c), "bogus char", "read");
j += len;
}
}
}
}
@ -678,7 +628,7 @@ scm_lreadparen (tok_buf, port, name, copy)
c = scm_flush_ws (port, name);
if (')' == c)
return SCM_EOL;
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
{
ans = scm_lreadr (tok_buf, port, copy);
@ -690,7 +640,7 @@ scm_lreadparen (tok_buf, port, name, copy)
ans = tl = scm_cons (tmp, SCM_EOL);
while (')' != (c = scm_flush_ws (port, name)))
{
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
{
SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy));
@ -721,7 +671,7 @@ scm_lreadrecparen (tok_buf, port, name, copy)
c = scm_flush_ws (port, name);
if (')' == c)
return SCM_EOL;
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
{
ans = scm_lreadr (tok_buf, port, copy);
@ -738,7 +688,7 @@ scm_lreadrecparen (tok_buf, port, name, copy)
SCM_EOL);
while (')' != (c = scm_flush_ws (port, name)))
{
scm_gen_ungetc (c, port);
scm_ungetc (c, port);
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, copy)))
{
SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));

4
libguile/regex-posix.c
View file

@ -104,9 +104,9 @@ scm_print_regex_t (obj, port, pstate)
{
regex_t *r;
r = SCM_RGX (obj);
scm_gen_puts (scm_regular_string, "#<rgx ", port);
scm_puts ("#<rgx ", port);
scm_intprint (obj, 16, port);
scm_gen_puts (scm_regular_string, ">", port);
scm_puts (">", port);
return 1;
}

6
libguile/root.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -115,9 +115,9 @@ print_root (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<root ", port);
scm_puts ("#<root ", port);
scm_intprint(SCM_SEQ (SCM_ROOT_STATE (exp) -> rootcont), 16, port);
scm_gen_putc('>', port);
scm_putc('>', port);
return 1;
}

6
libguile/srcprop.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation
/* Copyright (C) 1995,1996, 1997 Free Software Foundation
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -114,11 +114,11 @@ prinsrcprops (obj, port, pstate)
scm_print_state *pstate;
{
int writingp = SCM_WRITINGP (pstate);
scm_gen_puts (scm_regular_string, "#<srcprops ", port);
scm_puts ("#<srcprops ", port);
SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (scm_srcprops_to_plist (obj), port, pstate);
SCM_SET_WRITINGP (pstate, writingp);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}

8
libguile/stackchk.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -87,11 +87,11 @@ scm_stack_report ()
SCM_STACKITEM stack;
scm_intprint (scm_stack_size (SCM_BASE (scm_rootcont)) * sizeof (SCM_STACKITEM),
16, scm_cur_errp);
scm_gen_puts (scm_regular_string, " of stack: 0x", scm_cur_errp);
scm_puts (" of stack: 0x", scm_cur_errp);
scm_intprint ((long) SCM_BASE (scm_rootcont), 16, scm_cur_errp);
scm_gen_puts (scm_regular_string, " - 0x", scm_cur_errp);
scm_puts (" - 0x", scm_cur_errp);
scm_intprint ((long) &stack, 16, scm_cur_errp);
scm_gen_puts (scm_regular_string, "\n", scm_cur_errp);
scm_puts ("\n", scm_cur_errp);
}

1
libguile/strop.c
View file

@ -257,7 +257,6 @@ SCM
scm_string_copy (str)
SCM str;
{
/* doesn't handle multibyte strings. */
SCM_ASSERT (SCM_NIMP (str) && (SCM_STRINGP (str) || SCM_SUBSTRP (str)),
str, SCM_ARG1, s_string_copy);
return scm_makfromstr (SCM_ROCHARS (str), (scm_sizet)SCM_ROLENGTH (str), 0);

9
libguile/struct.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996 Free Software Foundation, Inc.
/* Copyright (C) 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -607,12 +607,11 @@ scm_print_struct (exp, port, pstate)
scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate);
else
{
scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1,
port);
scm_lfwrite ("#<struct ", sizeof ("#<struct ") - 1, port);
scm_intprint (SCM_STRUCT_VTABLE (exp), 16, port);
scm_gen_putc (':', port);
scm_putc (':', port);
scm_intprint (exp, 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
}
}

17
libguile/symbols.c
View file

@ -46,7 +46,6 @@
#include "eval.h"
#include "variable.h"
#include "alist.h"
#include "mbstrings.h"
#include "weaks.h"
#include "symbols.h"
@ -298,7 +297,6 @@ scm_intern_obarray_soft (name, len, obarray, softness)
lsym = scm_makfromstr (name, len, SCM_SYMBOL_SLOTS);
SCM_SETLENGTH (lsym, (long) len, scm_tc7_msymbol);
SCM_SYMBOL_MULTI_BYTE_STRINGP (lsym) = SCM_BOOL_F;
SCM_SYMBOL_HASH (lsym) = scm_hash;
SCM_SYMBOL_PROPS (lsym) = SCM_EOL;
if (obarray == SCM_BOOL_F)
@ -474,13 +472,6 @@ scm_string_to_symbol(s)
SCM_ASSERT(SCM_NIMP(s) && SCM_ROSTRINGP(s), s, SCM_ARG1, s_string_to_symbol);
vcell = scm_intern(SCM_ROCHARS(s), (scm_sizet)SCM_LENGTH(s));
answer = SCM_CAR (vcell);
if (SCM_TYP7 (answer) == scm_tc7_msymbol)
{
if (SCM_REGULAR_STRINGP (s))
SCM_SYMBOL_MULTI_BYTE_STRINGP (answer) = SCM_BOOL_F;
else
SCM_SYMBOL_MULTI_BYTE_STRINGP (answer) = SCM_BOOL_T;
}
return answer;
}
@ -520,13 +511,6 @@ scm_string_to_obarray_symbol(o, s, softp)
if (vcell == SCM_BOOL_F)
return vcell;
answer = SCM_CAR (vcell);
if (SCM_TYP7 (s) == scm_tc7_msymbol)
{
if (SCM_REGULAR_STRINGP (s))
SCM_SYMBOL_MULTI_BYTE_STRINGP (answer) = SCM_BOOL_F;
else
SCM_SYMBOL_MULTI_BYTE_STRINGP (answer) = SCM_BOOL_T;
}
return answer;
}
@ -689,7 +673,6 @@ msymbolize (s)
string = scm_makfromstr (SCM_CHARS (s), SCM_LENGTH (s), SCM_SYMBOL_SLOTS);
SCM_SETCHARS (s, SCM_CHARS (string));
SCM_SETLENGTH (s, SCM_LENGTH (s), scm_tc7_msymbol);
SCM_SYMBOL_MULTI_BYTE_STRINGP (s) = SCM_BOOL_F;
SCM_SETCDR (string, SCM_EOL);
SCM_SETCAR (string, SCM_EOL);
SCM_SYMBOL_PROPS (s) = SCM_EOL;

10
libguile/symbols.h
View file

@ -59,9 +59,8 @@ extern int scm_symhash_dim;
and that's it. They use the scm_tc7_ssymbol tag (S bit clear).
Msymbols are symbols with extra slots. These slots hold a property
list and a function value (for Emacs Lisp compatibility), a hash
code, and a flag to indicate whether their name contains multibyte
characters. They use the scm_tc7_msymbol tag.
list and a function value (for Emacs Lisp compatibility), and a hash
code. They use the scm_tc7_msymbol tag.
We'd like SCM_CHARS to work on msymbols just as it does on
ssymbols, so we'll have it point to the symbol's name as usual, and
@ -82,13 +81,12 @@ extern int scm_symhash_dim;
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
#define SCM_UCHARS(x) ((unsigned char *)(SCM_CDR(x)))
#define SCM_SLOTS(x) ((SCM *) (* ((SCM *)SCM_CHARS(x) - 1)))
#define SCM_SYMBOL_SLOTS 5
#define SCM_SYMBOL_SLOTS 4
#define SCM_SYMBOL_FUNC(X) (SCM_SLOTS(X)[0])
#define SCM_SYMBOL_PROPS(X) (SCM_SLOTS(X)[1])
#define SCM_SYMBOL_HASH(X) (*(unsigned long*)(&SCM_SLOTS(X)[2]))
#define SCM_SYMBOL_MULTI_BYTE_STRINGP(X) (*(unsigned long*)(&SCM_SLOTS(X)[3]))
#define SCM_ROSTRINGP(x) ((SCM_TYP7SD(x)==scm_tc7_string) || (SCM_TYP7S(x) == scm_tc7_ssymbol))
#define SCM_ROSTRINGP(x) ((SCM_TYP7S(x)==scm_tc7_string) || (SCM_TYP7S(x) == scm_tc7_ssymbol))
#define SCM_ROCHARS(x) ((SCM_TYP7(x) == scm_tc7_substring) \
? SCM_INUM (SCM_CADR (x)) + SCM_CHARS (SCM_CDDR (x)) \
: SCM_CHARS (x))

8
libguile/tag.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996 Free Software Foundation, Inc.
/* Copyright (C) 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -63,9 +63,7 @@ SCM_CONST_LONG (scm_utag_fvect, "utag_fvect", 12);
SCM_CONST_LONG (scm_utag_dvect, "utag_dvect", 13);
SCM_CONST_LONG (scm_utag_cvect, "utag_cvect", 14);
SCM_CONST_LONG (scm_utag_string, "utag_string", 15);
SCM_CONST_LONG (scm_utag_mb_string, "utag_mb_string", 16);
SCM_CONST_LONG (scm_utag_substring, "utag_substring", 17);
SCM_CONST_LONG (scm_utag_mb_substring, "utag_mb_substring", 18);
SCM_CONST_LONG (scm_utag_asubr, "utag_asubr", 19);
SCM_CONST_LONG (scm_utag_subr_0, "utag_subr_0", 20);
SCM_CONST_LONG (scm_utag_subr_1, "utag_subr_1", 21);
@ -136,12 +134,8 @@ scm_tag (x)
return SCM_CDR (scm_utag_cvect) ;
case scm_tc7_string:
return SCM_CDR (scm_utag_string) ;
case scm_tc7_mb_string:
return SCM_CDR (scm_utag_mb_string) ;
case scm_tc7_substring:
return SCM_CDR (scm_utag_substring) ;
case scm_tc7_mb_substring:
return SCM_CDR (scm_utag_mb_substring) ;
case scm_tc7_asubr:
return SCM_CDR (scm_utag_asubr) ;
case scm_tc7_subr_0:

25
libguile/tags.h
View file

@ -2,7 +2,7 @@
#ifndef TAGSH
#define TAGSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -218,31 +218,20 @@ typedef long SCM;
* bits) can be masked off to reveal a common type.
*
* TYP7S(X) returns TYP7, but masking out the option bit S.
* TYP7D(X) returns TYP7, but masking out the option bit D.
* TYP7SD(X) masks out both option bits.
*
* For example, all strings have 001 in the 'xxx' bits in
* the diagram above, the D bit says whether it's a
* substring, and the S bit says whether it's a multibyte
* character string.
* substring.
*
* for example:
* D S
* S
* scm_tc7_string = G0010101
* scm_tc7_mb_string = G0010111
* scm_tc7_substring = G0011101
* scm_tc7_mb_substring = G0011111
*
* TYP7DS turns all string tags into tc7_string; thus,
* testing TYP7DS against tc7_string is a quick way to
* TYP7S turns all string tags into tc7_string; thus,
* testing TYP7S against tc7_string is a quick way to
* test for any kind of string.
*
* TYP7S turns tc7_mb_string into tc7_string and
* tc7_mb_substring into tc7_substring.
*
* TYP7D turns tc7_mb_substring into tc7_mb_string and
* tc7_substring into tc7_string.
*
* Some TC7 types are subdivided into 256 subtypes giving
* rise to the macros:
*
@ -312,8 +301,6 @@ typedef long SCM;
#define SCM_TYP7(x) (0x7f & (int)SCM_CAR(x))
#define SCM_TYP7S(x) (0x7d & (int)SCM_CAR(x))
#define SCM_TYP7SD(x) (0x75 & (int)SCM_CAR(x))
#define SCM_TYP7D(x) (0x77 & (int)SCM_CAR(x))
#define SCM_TYP16(x) (0xffff & (int)SCM_CAR(x))
@ -344,9 +331,7 @@ typedef long SCM;
/* a quad, two couples, two trists */
#define scm_tc7_string 21
#define scm_tc7_mb_string 23
#define scm_tc7_substring 29
#define scm_tc7_mb_substring 31
/* Many of the following should be turned
* into structs or smobs. We need back some

14
libguile/threads.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
/* Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -87,9 +87,9 @@ print_thread (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<thread ", port);
scm_puts ("#<thread ", port);
scm_intprint (SCM_CDR (exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}
@ -107,9 +107,9 @@ print_mutex (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<mutex ", port);
scm_puts ("#<mutex ", port);
scm_intprint (SCM_CDR (exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}
@ -127,9 +127,9 @@ print_condvar (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<condition-variable ", port);
scm_puts ("#<condition-variable ", port);
scm_intprint (SCM_CDR (exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}

18
libguile/throw.c
View file

@ -94,10 +94,10 @@ printjb (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_puts ("#<jmpbuffer ", port);
scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_intprint((SCM) JBJMPBUF(exp), 16, port);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1 ;
}
@ -273,7 +273,7 @@ print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate)
sprintf (buf, "#<lazy-catch 0x%lx 0x%lx>",
(long) c->handler, (long) c->handler_data);
scm_gen_puts (scm_regular_string, buf, port);
scm_puts (buf, port);
return 1;
}
@ -489,8 +489,8 @@ handler_message (void *handler_data, SCM tag, SCM args)
if (! prog_name)
prog_name = "guile";
scm_gen_puts (scm_regular_string, prog_name, p);
scm_gen_puts (scm_regular_string, ": ", p);
scm_puts (prog_name, p);
scm_puts (": ", p);
if (scm_ilength (args) >= 3)
{
@ -501,11 +501,11 @@ handler_message (void *handler_data, SCM tag, SCM args)
}
else
{
scm_gen_puts (scm_regular_string, "uncaught throw to ", p);
scm_puts ("uncaught throw to ", p);
scm_prin1 (tag, p, 0);
scm_gen_puts (scm_regular_string, ": ", p);
scm_puts (": ", p);
scm_prin1 (args, p, 1);
scm_gen_putc ('\n', p);
scm_putc ('\n', p);
}
}

65
libguile/unif.c
View file

@ -99,7 +99,6 @@ scm_vector_set_length_x (vect, len)
default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string:
case scm_tc7_mb_string:
SCM_ASRTGO (vect != scm_nullstr, badarg1);
sz = sizeof (char);
l++;
@ -2228,7 +2227,7 @@ tail:
scm_iprin1 (ra, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
SCM_ARRAY_BASE (ra) = j;
scm_iprin1 (ra, port, pstate);
}
@ -2240,16 +2239,16 @@ tail:
inc = SCM_ARRAY_DIMS (ra)[k].inc;
for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
{
scm_gen_putc ('(', port);
scm_putc ('(', port);
rapr1 (ra, j, k + 1, port, pstate);
scm_gen_puts (scm_regular_string, ") ", port);
scm_puts (") ", port);
j += inc;
}
if (i == SCM_ARRAY_DIMS (ra)[k].ubnd)
{ /* could be zero size. */
scm_gen_putc ('(', port);
scm_putc ('(', port);
rapr1 (ra, j, k + 1, port, pstate);
scm_gen_putc (')', port);
scm_putc (')', port);
}
break;
}
@ -2268,7 +2267,7 @@ tail:
scm_iprin1 (scm_uniform_vector_ref (ra, SCM_MAKINUM (j)), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_iprin1 (scm_cvref (ra, j, SCM_UNDEFINED), port, pstate);
}
break;
@ -2278,19 +2277,19 @@ tail:
if (SCM_WRITINGP (pstate))
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_iprin1 (SCM_MAKICHR (SCM_CHARS (ra)[j]), port, pstate);
}
else
for (j += inc; n-- > 0; j += inc)
scm_gen_putc (SCM_CHARS (ra)[j], port);
scm_putc (SCM_CHARS (ra)[j], port);
break;
case scm_tc7_byvect:
if (n-- > 0)
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
}
break;
@ -2301,7 +2300,7 @@ tail:
scm_intprint (SCM_VELTS (ra)[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_intprint (SCM_VELTS (ra)[j], 10, port);
}
break;
@ -2311,7 +2310,7 @@ tail:
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
}
break;
@ -2326,7 +2325,7 @@ tail:
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
SCM_FLO (z) = ((float *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
@ -2341,7 +2340,7 @@ tail:
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
SCM_REAL (z) = ((double *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
@ -2356,7 +2355,7 @@ tail:
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_gen_putc (' ', port);
scm_putc (' ', port);
SCM_REAL (z) = SCM_REAL (cz) = ((double *) SCM_VELTS (ra))[2 * j];
SCM_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
@ -2377,7 +2376,7 @@ scm_raprin1 (exp, port, pstate)
{
SCM v = exp;
scm_sizet base = 0;
scm_gen_putc ('#', port);
scm_putc ('#', port);
tail:
switch SCM_TYP7
(v)
@ -2390,9 +2389,9 @@ tail:
if (SCM_ARRAYP (v))
{
scm_gen_puts (scm_regular_string, "<enclosed-array ", port);
scm_puts ("<enclosed-array ", port);
rapr1 (exp, base, 0, port, pstate);
scm_gen_putc ('>', port);
scm_putc ('>', port);
return 1;
}
else
@ -2405,13 +2404,13 @@ tail:
if (exp == v)
{ /* a uve, not an scm_array */
register long i, j, w;
scm_gen_putc ('*', port);
scm_putc ('*', port);
for (i = 0; i < (SCM_LENGTH (exp)) / SCM_LONG_BIT; i++)
{
w = SCM_VELTS (exp)[i];
for (j = SCM_LONG_BIT; j; j--)
{
scm_gen_putc (w & 1 ? '1' : '0', port);
scm_putc (w & 1 ? '1' : '0', port);
w >>= 1;
}
}
@ -2421,52 +2420,52 @@ tail:
w = SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT];
for (; j; j--)
{
scm_gen_putc (w & 1 ? '1' : '0', port);
scm_putc (w & 1 ? '1' : '0', port);
w >>= 1;
}
}
return 1;
}
else
scm_gen_putc ('b', port);
scm_putc ('b', port);
break;
case scm_tc7_string:
scm_gen_putc ('a', port);
scm_putc ('a', port);
break;
case scm_tc7_byvect:
scm_gen_puts (scm_regular_string, "bytes", port);
scm_puts ("bytes", port);
break;
case scm_tc7_uvect:
scm_gen_putc ('u', port);
scm_putc ('u', port);
break;
case scm_tc7_ivect:
scm_gen_putc ('e', port);
scm_putc ('e', port);
break;
case scm_tc7_svect:
scm_gen_puts (scm_regular_string, "short", port);
scm_puts ("short", port);
break;
#ifdef LONGLONGS
case scm_tc7_llvect:
scm_gen_puts (scm_regular_string, "long_long", port);
scm_puts ("long_long", port);
break;
#endif
#ifdef SCM_FLOATS
#ifdef SCM_SINGLES
case scm_tc7_fvect:
scm_gen_putc ('s', port);
scm_putc ('s', port);
break;
#endif /*SCM_SINGLES*/
case scm_tc7_dvect:
scm_gen_putc ('i', port);
scm_putc ('i', port);
break;
case scm_tc7_cvect:
scm_gen_putc ('c', port);
scm_putc ('c', port);
break;
#endif /*SCM_FLOATS*/
}
scm_gen_putc ('(', port);
scm_putc ('(', port);
rapr1 (exp, base, 0, port, pstate);
scm_gen_putc (')', port);
scm_putc (')', port);
return 1;
}

10
libguile/variable.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@ -68,20 +68,20 @@ prin_var (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
scm_gen_puts (scm_regular_string, "#<variable ", port);
scm_puts ("#<variable ", port);
scm_intprint(exp, 16, port);
{
SCM val_cell;
val_cell = SCM_CDR(exp);
if (SCM_CAR (val_cell) != SCM_UNDEFINED)
{
scm_gen_puts (scm_regular_string, " name: ", port);
scm_puts (" name: ", port);
scm_iprin1 (SCM_CAR (val_cell), port, pstate);
}
scm_gen_puts (scm_regular_string, " binding: ", port);
scm_puts (" binding: ", port);
scm_iprin1 (SCM_CDR (val_cell), port, pstate);
}
scm_gen_putc('>', port);
scm_putc('>', port);
return 1;
}