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

locking for putc, puts

Browse source 
* libguile/ports.c (scm_putc, scm_puts):
* libguile/ports.h (scm_putc_unlocked, scm_puts_unlocked): Separate into
  _unlocked and locked variants.  Change all callers to use the
  _unlocked versions.
This commit is contained in:
Andy Wingo 2011-11-08 00:36:48 +01:00
parent 4251ae2e28
commit 0607ebbfcf
44 changed files with 233 additions and 215 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/arbiters.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996, 1997, 2000, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. /* Copyright (C) 1995,1996, 1997, 2000, 2001, 2004, 2005, 2006, 2008, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -89,11 +89,11 @@ static scm_t_bits scm_tc16_arbiter;
static int static int
arbiter_print (SCM exp, SCM port, scm_print_state *pstate) arbiter_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<arbiter ", port); scm_puts_unlocked ("#<arbiter ", port);
if (SCM_ARB_LOCKED (exp)) if (SCM_ARB_LOCKED (exp))
scm_puts ("locked ", port); scm_puts_unlocked ("locked ", port);
scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate); scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return !0; return !0;
} }

16
libguile/arrays.c
View file

@ -727,15 +727,15 @@ scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
else else
{ {
ssize_t i; ssize_t i;
scm_putc ('(', port); scm_putc_unlocked ('(', port);
for (i = h->dims[dim].lbnd; i <= h->dims[dim].ubnd; for (i = h->dims[dim].lbnd; i <= h->dims[dim].ubnd;
i++, pos += h->dims[dim].inc) i++, pos += h->dims[dim].inc)
{ {
scm_i_print_array_dimension (h, dim+1, pos, port, pstate); scm_i_print_array_dimension (h, dim+1, pos, port, pstate);
if (i < h->dims[dim].ubnd) if (i < h->dims[dim].ubnd)
scm_putc (' ', port); scm_putc_unlocked (' ', port);
} }
scm_putc (')', port); scm_putc_unlocked (')', port);
} }
return 1; return 1;
} }
@ -752,7 +752,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
scm_array_get_handle (array, &h); scm_array_get_handle (array, &h);
scm_putc ('#', port); scm_putc_unlocked ('#', port);
if (h.ndims != 1 || h.dims[0].lbnd != 0) if (h.ndims != 1 || h.dims[0].lbnd != 0)
scm_intprint (h.ndims, 10, port); scm_intprint (h.ndims, 10, port);
if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
@ -773,12 +773,12 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
{ {
if (print_lbnds) if (print_lbnds)
{ {
scm_putc ('@', port); scm_putc_unlocked ('@', port);
scm_intprint (h.dims[i].lbnd, 10, port); scm_intprint (h.dims[i].lbnd, 10, port);
} }
if (print_lens) if (print_lens)
{ {
scm_putc (':', port); scm_putc_unlocked (':', port);
scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1, scm_intprint (h.dims[i].ubnd - h.dims[i].lbnd + 1,
10, port); 10, port);
} }
@ -806,9 +806,9 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
not really the same as Scheme values since they are boxed and not really the same as Scheme values since they are boxed and
can be modified with array-set!, say. can be modified with array-set!, say.
*/ */
scm_putc ('(', port); scm_putc_unlocked ('(', port);
scm_i_print_array_dimension (&h, 0, 0, port, pstate); scm_i_print_array_dimension (&h, 0, 0, port, pstate);
scm_putc (')', port); scm_putc_unlocked (')', port);
return 1; return 1;
} }
else else

32
libguile/backtrace.c
View file

@ -59,9 +59,9 @@ static SCM
boot_print_exception (SCM port, SCM frame, SCM key, SCM args) boot_print_exception (SCM port, SCM frame, SCM key, SCM args)
#define FUNC_NAME "boot-print-exception" #define FUNC_NAME "boot-print-exception"
{ {
scm_puts ("Throw to key ", port); scm_puts_unlocked ("Throw to key ", port);
scm_write (key, port); scm_write (key, port);
scm_puts (" with args ", port); scm_puts_unlocked (" with args ", port);
scm_write (args, port); scm_write (args, port);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -207,7 +207,7 @@ indent (int n, SCM port)
{ {
int i; int i;
for (i = 0; i < n; ++i) for (i = 0; i < n; ++i)
scm_putc (' ', port); scm_putc_unlocked (' ', port);
} }
static void static void
@ -223,7 +223,7 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
{ {
pstate->level = print_params[i].level - 1; pstate->level = print_params[i].level - 1;
scm_iprlist (hdr, exp, tlr[0], sport, pstate); scm_iprlist (hdr, exp, tlr[0], sport, pstate);
scm_puts (&tlr[1], sport); scm_puts_unlocked (&tlr[1], sport);
} }
else else
{ {
@ -328,19 +328,19 @@ display_backtrace_file (frame, last_file, port, pstate)
*last_file = file; *last_file = file;
scm_puts ("In ", port); scm_puts_unlocked ("In ", port);
if (scm_is_false (file)) if (scm_is_false (file))
if (scm_is_false (line)) if (scm_is_false (line))
scm_puts ("unknown file", port); scm_puts_unlocked ("unknown file", port);
else else
scm_puts ("current input", port); scm_puts_unlocked ("current input", port);
else else
{ {
pstate->writingp = 0; pstate->writingp = 0;
scm_iprin1 (file, port, pstate); scm_iprin1 (file, port, pstate);
pstate->writingp = 1; pstate->writingp = 1;
} }
scm_puts (":\n", port); scm_puts_unlocked (":\n", port);
} }
static void static void
@ -355,9 +355,9 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
if (scm_is_false (file)) if (scm_is_false (file))
{ {
if (scm_is_false (line)) if (scm_is_false (line))
scm_putc ('?', port); scm_putc_unlocked ('?', port);
else else
scm_puts ("<stdin>", port); scm_puts_unlocked ("<stdin>", port);
} }
else else
{ {
@ -372,7 +372,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
pstate -> writingp = 1; pstate -> writingp = 1;
} }
scm_putc (':', port); scm_putc_unlocked (':', port);
} }
else if (scm_is_true (line)) else if (scm_is_true (line))
{ {
@ -383,10 +383,10 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
} }
if (scm_is_false (line)) if (scm_is_false (line))
scm_puts (" ?", port); scm_puts_unlocked (" ?", port);
else else
scm_intprint (scm_to_int (line) + 1, 10, port); scm_intprint (scm_to_int (line) + 1, 10, port);
scm_puts (": ", port); scm_puts_unlocked (": ", port);
} }
static void static void
@ -413,7 +413,7 @@ display_frame (SCM frame, int n, int nfield, int indentation,
/* Display an application. */ /* Display an application. */
display_application (frame, nfield + 1 + indentation, sport, port, pstate); display_application (frame, nfield + 1 + indentation, sport, port, pstate);
scm_putc ('\n', port); scm_putc_unlocked ('\n', port);
} }
struct display_backtrace_args { struct display_backtrace_args {
@ -513,7 +513,7 @@ error_during_backtrace (void *data, SCM tag, SCM throw_args)
{ {
SCM port = SCM_PACK_POINTER (data); SCM port = SCM_PACK_POINTER (data);
scm_puts ("Exception thrown while printing backtrace:\n", port); scm_puts_unlocked ("Exception thrown while printing backtrace:\n", port);
scm_print_exception (port, SCM_BOOL_F, tag, throw_args); scm_print_exception (port, SCM_BOOL_F, tag, throw_args);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -574,7 +574,7 @@ SCM_DEFINE (scm_backtrace_with_highlights, "backtrace", 0, 1, 0,
highlights = SCM_EOL; highlights = SCM_EOL;
scm_newline (port); scm_newline (port);
scm_puts ("Backtrace:\n", port); scm_puts_unlocked ("Backtrace:\n", port);
scm_display_backtrace_with_highlights (stack, port, SCM_BOOL_F, SCM_BOOL_F, scm_display_backtrace_with_highlights (stack, port, SCM_BOOL_F, SCM_BOOL_F,
highlights); highlights);
scm_newline (port); scm_newline (port);

6
libguile/bitvectors.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -53,12 +53,12 @@ bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
scm_t_uint32 *bits = BITVECTOR_BITS (vec); scm_t_uint32 *bits = BITVECTOR_BITS (vec);
size_t i, j; size_t i, j;
scm_puts ("#*", port); scm_puts_unlocked ("#*", port);
for (i = 0; i < word_len; i++, bit_len -= 32) for (i = 0; i < word_len; i++, bit_len -= 32)
{ {
scm_t_uint32 mask = 1; scm_t_uint32 mask = 1;
for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1) for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
scm_putc ((bits[i] & mask)? '1' : '0', port); scm_putc_unlocked ((bits[i] & mask)? '1' : '0', port);
} }
return 1; return 1;

8
libguile/bytevectors.c
View file

@ -415,17 +415,17 @@ scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
scm_array_get_handle (bv, &h); scm_array_get_handle (bv, &h);
scm_putc ('#', port); scm_putc_unlocked ('#', port);
scm_write (scm_array_handle_element_type (&h), port); scm_write (scm_array_handle_element_type (&h), port);
scm_putc ('(', port); scm_putc_unlocked ('(', port);
for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc; for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
i <= ubnd; i += inc) i <= ubnd; i += inc)
{ {
if (i > 0) if (i > 0)
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_write (scm_array_handle_ref (&h, i), port); scm_write (scm_array_handle_ref (&h, i), port);
} }
scm_putc (')', port); scm_putc_unlocked (')', port);
return 1; return 1;
} }

8
libguile/continuations.c
View file

@ -174,11 +174,11 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
{ {
scm_t_contregs *continuation = SCM_CONTREGS (obj); scm_t_contregs *continuation = SCM_CONTREGS (obj);
scm_puts ("#<continuation ", port); scm_puts_unlocked ("#<continuation ", port);
scm_intprint (continuation->num_stack_items, 10, port); scm_intprint (continuation->num_stack_items, 10, port);
scm_puts (" @ ", port); scm_puts_unlocked (" @ ", port);
scm_uintprint (SCM_SMOB_DATA_1 (obj), 16, port); scm_uintprint (SCM_SMOB_DATA_1 (obj), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }
@ -498,7 +498,7 @@ print_exception_and_backtrace (SCM port, SCM tag, SCM args)
if (should_print_backtrace (tag, stack)) if (should_print_backtrace (tag, stack))
{ {
scm_puts ("Backtrace:\n", port); scm_puts_unlocked ("Backtrace:\n", port);
scm_display_backtrace_with_highlights (stack, port, scm_display_backtrace_with_highlights (stack, port,
SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F,
SCM_EOL); SCM_EOL);

4
libguile/control.c
View file

@ -269,9 +269,9 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM args),
void void
scm_i_prompt_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_i_prompt_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<prompt ", port); scm_puts_unlocked ("#<prompt ", port);
scm_intprint (SCM_UNPACK (exp), 16, port); scm_intprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
void void

2
libguile/deprecation.c
View file

@ -89,7 +89,7 @@ scm_c_issue_deprecation_warning (const char *msg)
fprintf (stderr, "%s\n", msg); fprintf (stderr, "%s\n", msg);
else else
{ {
scm_puts (msg, scm_current_error_port ()); scm_puts_unlocked (msg, scm_current_error_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_error_port ());
} }
} }

6
libguile/dynl.c
View file

@ -185,11 +185,11 @@ scm_t_bits scm_tc16_dynamic_obj;
static int static int
dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate) dynl_obj_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<dynamic-object ", port); scm_puts_unlocked ("#<dynamic-object ", port);
scm_iprin1 (DYNL_FILENAME (exp), port, pstate); scm_iprin1 (DYNL_FILENAME (exp), port, pstate);
if (DYNL_HANDLE (exp) == NULL) if (DYNL_HANDLE (exp) == NULL)
scm_puts (" (unlinked)", port); scm_puts_unlocked (" (unlinked)", port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

6
libguile/eval.c
View file

@ -913,16 +913,16 @@ static int
boot_closure_print (SCM closure, SCM port, scm_print_state *pstate) boot_closure_print (SCM closure, SCM port, scm_print_state *pstate)
{ {
SCM args; SCM args;
scm_puts ("#<boot-closure ", port); scm_puts_unlocked ("#<boot-closure ", port);
scm_uintprint (SCM_UNPACK (closure), 16, port); scm_uintprint (SCM_UNPACK (closure), 16, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure)), args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure)),
scm_from_latin1_symbol ("_")); scm_from_latin1_symbol ("_"));
if (!BOOT_CLOSURE_IS_FIXED (closure) && BOOT_CLOSURE_HAS_REST_ARGS (closure)) if (!BOOT_CLOSURE_IS_FIXED (closure) && BOOT_CLOSURE_HAS_REST_ARGS (closure))
args = scm_cons_star (scm_from_latin1_symbol ("_"), args); args = scm_cons_star (scm_from_latin1_symbol ("_"), args);
/* FIXME: optionals and rests */ /* FIXME: optionals and rests */
scm_display (args, port); scm_display (args, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

8
libguile/filesys.c
View file

@ -1797,12 +1797,12 @@ SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
static int static int
scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
if (!SCM_DIR_OPEN_P (exp)) if (!SCM_DIR_OPEN_P (exp))
scm_puts ("closed: ", port); scm_puts_unlocked ("closed: ", port);
scm_puts ("directory stream ", port); scm_puts_unlocked ("directory stream ", port);
scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port); scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

12
libguile/fluids.c
View file

@ -79,25 +79,25 @@ grow_dynamic_state (SCM state)
void void
scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_i_fluid_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<fluid ", port); scm_puts_unlocked ("#<fluid ", port);
scm_intprint ((int) FLUID_NUM (exp), 10, port); scm_intprint ((int) FLUID_NUM (exp), 10, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
void void
scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_i_dynamic_state_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<dynamic-state ", port); scm_puts_unlocked ("#<dynamic-state ", port);
scm_intprint (SCM_UNPACK (exp), 16, port); scm_intprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
void void
scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_i_with_fluids_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<with-fluids ", port); scm_puts_unlocked ("#<with-fluids ", port);
scm_intprint (SCM_UNPACK (exp), 16, port); scm_intprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }

4
libguile/foreign.c
View file

@ -330,9 +330,9 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0,
void void
scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate) scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<pointer 0x", port); scm_puts_unlocked ("#<pointer 0x", port);
scm_uintprint (scm_to_uintptr (scm_pointer_address (pointer)), 16, port); scm_uintprint (scm_to_uintptr (scm_pointer_address (pointer)), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }

12
libguile/fports.c
View file

@ -636,7 +636,7 @@ fport_input_waiting (SCM port)
static int static int
fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
scm_print_port_mode (exp, port); scm_print_port_mode (exp, port);
if (SCM_OPFPORTP (exp)) if (SCM_OPFPORTP (exp))
{ {
@ -645,8 +645,8 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
if (scm_is_string (name) || scm_is_symbol (name)) if (scm_is_string (name) || scm_is_symbol (name))
scm_display (name, port); scm_display (name, port);
else else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
fdes = (SCM_FSTREAM (exp))->fdes; fdes = (SCM_FSTREAM (exp))->fdes;
#if (defined HAVE_TTYNAME) && (defined HAVE_POSIX) #if (defined HAVE_TTYNAME) && (defined HAVE_POSIX)
@ -658,11 +658,11 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
} }
else else
{ {
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); scm_puts_unlocked (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port); scm_uintprint ((scm_t_bits) SCM_PTAB_ENTRY (exp), 16, port);
} }
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

6
libguile/frames.c
View file

@ -45,12 +45,12 @@ scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
void void
scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate) scm_i_frame_print (SCM frame, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<frame ", port); scm_puts_unlocked ("#<frame ", port);
scm_uintprint (SCM_UNPACK (frame), 16, port); scm_uintprint (SCM_UNPACK (frame), 16, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_write (scm_frame_procedure (frame), port); scm_write (scm_frame_procedure (frame), port);
/* don't write args, they can get us into trouble. */ /* don't write args, they can get us into trouble. */
scm_puts (">", port); scm_puts_unlocked (">", port);
} }

2
libguile/gdbint.c
View file

@ -150,7 +150,7 @@ gdb_read (char *str)
SCM_BEGIN_FOREIGN_BLOCK; SCM_BEGIN_FOREIGN_BLOCK;
unmark_port (gdb_input_port); unmark_port (gdb_input_port);
scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET)); scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET));
scm_puts (str, gdb_input_port); scm_puts_unlocked (str, gdb_input_port);
scm_truncate_file (gdb_input_port, SCM_UNDEFINED); scm_truncate_file (gdb_input_port, SCM_UNDEFINED);
scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET)); scm_seek (gdb_input_port, SCM_INUM0, scm_from_int (SEEK_SET));

8
libguile/gsubr.c
View file

@ -858,13 +858,13 @@ scm_c_define_gsubr_with_generic (const char *name,
SCM SCM
gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst) gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst)
{ {
scm_puts ("gsubr-2-1-l:\n req1: ", scm_cur_outp); scm_puts_unlocked ("gsubr-2-1-l:\n req1: ", scm_cur_outp);
scm_display(req1, scm_cur_outp); scm_display(req1, scm_cur_outp);
scm_puts ("\n req2: ", scm_cur_outp); scm_puts_unlocked ("\n req2: ", scm_cur_outp);
scm_display(req2, scm_cur_outp); scm_display(req2, scm_cur_outp);
scm_puts ("\n opt: ", scm_cur_outp); scm_puts_unlocked ("\n opt: ", scm_cur_outp);
scm_display(opt, scm_cur_outp); scm_display(opt, scm_cur_outp);
scm_puts ("\n rest: ", scm_cur_outp); scm_puts_unlocked ("\n rest: ", scm_cur_outp);
scm_display(rst, scm_cur_outp); scm_display(rst, scm_cur_outp);
scm_newline(scm_cur_outp); scm_newline(scm_cur_outp);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;

10
libguile/guardians.c
View file

@ -86,16 +86,16 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
t_guardian *g = GUARDIAN_DATA (guardian); t_guardian *g = GUARDIAN_DATA (guardian);
scm_puts ("#<guardian ", port); scm_puts_unlocked ("#<guardian ", port);
scm_uintprint ((scm_t_bits) g, 16, port); scm_uintprint ((scm_t_bits) g, 16, port);
scm_puts (" (reachable: ", port); scm_puts_unlocked (" (reachable: ", port);
scm_display (scm_from_uint (g->live), port); scm_display (scm_from_uint (g->live), port);
scm_puts (" unreachable: ", port); scm_puts_unlocked (" unreachable: ", port);
scm_display (scm_length (g->zombies), port); scm_display (scm_length (g->zombies), port);
scm_puts (")", port); scm_puts_unlocked (")", port);
scm_puts (">", port); scm_puts_unlocked (">", port);
return 1; return 1;
} }

6
libguile/hashtab.c
View file

@ -167,12 +167,12 @@ scm_i_rehash (SCM table,
void void
scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate) scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<hash-table ", port); scm_puts_unlocked ("#<hash-table ", port);
scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port); scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port);
scm_putc ('/', port); scm_putc_unlocked ('/', port);
scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)), scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)),
10, port); 10, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }

10
libguile/hooks.c
View file

@ -134,22 +134,22 @@ static int
hook_print (SCM hook, SCM port, scm_print_state *pstate) hook_print (SCM hook, SCM port, scm_print_state *pstate)
{ {
SCM ls, name; SCM ls, name;
scm_puts ("#<hook ", port); scm_puts_unlocked ("#<hook ", port);
scm_intprint (SCM_HOOK_ARITY (hook), 10, port); scm_intprint (SCM_HOOK_ARITY (hook), 10, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_uintprint (SCM_UNPACK (hook), 16, port); scm_uintprint (SCM_UNPACK (hook), 16, port);
ls = SCM_HOOK_PROCEDURES (hook); ls = SCM_HOOK_PROCEDURES (hook);
while (scm_is_pair (ls)) while (scm_is_pair (ls))
{ {
scm_putc (' ', port); scm_putc_unlocked (' ', port);
name = scm_procedure_name (SCM_CAR (ls)); name = scm_procedure_name (SCM_CAR (ls));
if (scm_is_true (name)) if (scm_is_true (name))
scm_iprin1 (name, port, pstate); scm_iprin1 (name, port, pstate);
else else
scm_putc ('?', port); scm_putc_unlocked ('?', port);
ls = SCM_CDR (ls); ls = SCM_CDR (ls);
} }
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

4
libguile/keywords.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -47,7 +47,7 @@ scm_t_bits scm_tc16_keyword;
static int static int
keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#:", port); scm_puts_unlocked ("#:", port);
scm_display (KEYWORDSYM (exp), port); scm_display (KEYWORDSYM (exp), port);
return 1; return 1;
} }

24
libguile/load.c
View file

@ -663,11 +663,11 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename,
else else
{ {
compiled_is_newer = 0; compiled_is_newer = 0;
scm_puts (";;; note: source file ", scm_current_error_port ()); scm_puts_unlocked (";;; note: source file ", scm_current_error_port ());
scm_display (full_filename, scm_current_error_port ()); scm_display (full_filename, scm_current_error_port ());
scm_puts ("\n;;; newer than compiled ", scm_current_error_port ()); scm_puts_unlocked ("\n;;; newer than compiled ", scm_current_error_port ());
scm_display (compiled_filename, scm_current_error_port ()); scm_display (compiled_filename, scm_current_error_port ());
scm_puts ("\n", scm_current_error_port ()); scm_puts_unlocked ("\n", scm_current_error_port ());
} }
return compiled_is_newer; return compiled_is_newer;
@ -685,7 +685,7 @@ do_try_auto_compile (void *data)
SCM source = SCM_PACK_POINTER (data); SCM source = SCM_PACK_POINTER (data);
SCM comp_mod, compile_file; SCM comp_mod, compile_file;
scm_puts (";;; compiling ", scm_current_error_port ()); scm_puts_unlocked (";;; compiling ", scm_current_error_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_error_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_error_port ());
@ -714,16 +714,16 @@ do_try_auto_compile (void *data)
/* Assume `*current-warning-prefix*' has an appropriate value. */ /* Assume `*current-warning-prefix*' has an appropriate value. */
res = scm_call_n (scm_variable_ref (compile_file), args, 5); res = scm_call_n (scm_variable_ref (compile_file), args, 5);
scm_puts (";;; compiled ", scm_current_error_port ()); scm_puts_unlocked (";;; compiled ", scm_current_error_port ());
scm_display (res, scm_current_error_port ()); scm_display (res, scm_current_error_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_error_port ());
return res; return res;
} }
else else
{ {
scm_puts (";;; it seems ", scm_current_error_port ()); scm_puts_unlocked (";;; it seems ", scm_current_error_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_error_port ());
scm_puts ("\n;;; is part of the compiler; skipping auto-compilation\n", scm_puts_unlocked ("\n;;; is part of the compiler; skipping auto-compilation\n",
scm_current_error_port ()); scm_current_error_port ());
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -738,16 +738,16 @@ auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
oport = scm_open_output_string (); oport = scm_open_output_string ();
scm_print_exception (oport, SCM_BOOL_F, tag, throw_args); scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
scm_puts (";;; WARNING: compilation of ", scm_current_error_port ()); scm_puts_unlocked (";;; WARNING: compilation of ", scm_current_error_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_error_port ());
scm_puts (" failed:\n", scm_current_error_port ()); scm_puts_unlocked (" failed:\n", scm_current_error_port ());
lines = scm_string_split (scm_get_output_string (oport), lines = scm_string_split (scm_get_output_string (oport),
SCM_MAKE_CHAR ('\n')); SCM_MAKE_CHAR ('\n'));
for (; scm_is_pair (lines); lines = scm_cdr (lines)) for (; scm_is_pair (lines); lines = scm_cdr (lines))
if (scm_c_string_length (scm_car (lines))) if (scm_c_string_length (scm_car (lines)))
{ {
scm_puts (";;; ", scm_current_error_port ()); scm_puts_unlocked (";;; ", scm_current_error_port ());
scm_display (scm_car (lines), scm_current_error_port ()); scm_display (scm_car (lines), scm_current_error_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_error_port ());
} }
@ -765,7 +765,7 @@ SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabl
if (!message_shown) if (!message_shown)
{ {
scm_puts (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n" scm_puts_unlocked (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n"
";;; or pass the --no-auto-compile argument to disable.\n", ";;; or pass the --no-auto-compile argument to disable.\n",
scm_current_error_port ()); scm_current_error_port ());
message_shown = 1; message_shown = 1;
@ -933,7 +933,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
if (stat_ret == 0 && compiled_is_fresh (full_filename, fallback, if (stat_ret == 0 && compiled_is_fresh (full_filename, fallback,
&stat_source, &stat_compiled)) &stat_source, &stat_compiled))
{ {
scm_puts (";;; found fresh local cache at ", scm_current_error_port ()); scm_puts_unlocked (";;; found fresh local cache at ", scm_current_error_port ());
scm_display (fallback, scm_current_error_port ()); scm_display (fallback, scm_current_error_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_error_port ());
return scm_load_compiled_with_vm (fallback); return scm_load_compiled_with_vm (fallback);

6
libguile/macros.c
View file

@ -49,11 +49,11 @@ static int
macro_print (SCM macro, SCM port, scm_print_state *pstate) macro_print (SCM macro, SCM port, scm_print_state *pstate)
{ {
if (scm_is_false (SCM_MACRO_TYPE (macro))) if (scm_is_false (SCM_MACRO_TYPE (macro)))
scm_puts ("#<primitive-syntax-transformer ", port); scm_puts_unlocked ("#<primitive-syntax-transformer ", port);
else else
scm_puts ("#<syntax-transformer ", port); scm_puts_unlocked ("#<syntax-transformer ", port);
scm_iprin1 (scm_macro_name (macro), port, pstate); scm_iprin1 (scm_macro_name (macro), port, pstate);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

6
libguile/mallocs.c
View file

@ -1,5 +1,5 @@
/* classes: src_files /* classes: src_files
* Copyright (C) 1995,1997,1998,2000,2001, 2006 Free Software Foundation, Inc. * Copyright (C) 1995,1997,1998,2000,2001, 2006, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -46,9 +46,9 @@ scm_t_bits scm_tc16_malloc;
static int static int
malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) malloc_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts("#<malloc ", port); scm_puts_unlocked("#<malloc ", port);
scm_uintprint (SCM_SMOB_DATA (exp), 16, port); scm_uintprint (SCM_SMOB_DATA (exp), 16, port);
scm_putc('>', port); scm_putc_unlocked('>', port);
return 1; return 1;
} }

4
libguile/memoize.c
View file

@ -148,9 +148,9 @@ static const char *const memoized_tags[] =
static int static int
scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate) scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<memoized ", port); scm_puts_unlocked ("#<memoized ", port);
scm_write (scm_unmemoize_expression (memoized), port); scm_write (scm_unmemoize_expression (memoized), port);
scm_puts (">", port); scm_puts_unlocked (">", port);
return 1; return 1;
} }

4
libguile/objcodes.c
View file

@ -366,9 +366,9 @@ SCM_DEFINE (scm_write_objcode, "write-objcode", 2, 0, 0,
void void
scm_i_objcode_print (SCM objcode, SCM port, scm_print_state *pstate) scm_i_objcode_print (SCM objcode, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<objcode ", port); scm_puts_unlocked ("#<objcode ", port);
scm_uintprint ((scm_t_bits)SCM_OBJCODE_BASE (objcode), 16, port); scm_uintprint ((scm_t_bits)SCM_OBJCODE_BASE (objcode), 16, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }

26
libguile/ports.c
View file

@ -2148,6 +2148,22 @@ scm_flush (SCM port)
/* Output. */ /* Output. */
void
scm_putc (char c, SCM port)
{
scm_c_lock_port (port);
scm_putc_unlocked (c, port);
scm_c_unlock_port (port);
}
void
scm_puts (const char *s, SCM port)
{
scm_c_lock_port (port);
scm_puts_unlocked (s, port);
scm_c_unlock_port (port);
}
/* scm_c_write /* scm_c_write
* *
* Used by an application to write arbitrary number of bytes to an SCM * Used by an application to write arbitrary number of bytes to an SCM
@ -2527,7 +2543,7 @@ SCM_DEFINE (scm_set_port_filename_x, "set-port-filename!", 2, 0, 0,
void void
scm_print_port_mode (SCM exp, SCM port) scm_print_port_mode (SCM exp, SCM port)
{ {
scm_puts (SCM_CLOSEDP (exp) scm_puts_unlocked (SCM_CLOSEDP (exp)
? "closed: " ? "closed: "
: (SCM_RDNG & SCM_CELL_WORD_0 (exp) : (SCM_RDNG & SCM_CELL_WORD_0 (exp)
? (SCM_WRTNG & SCM_CELL_WORD_0 (exp) ? (SCM_WRTNG & SCM_CELL_WORD_0 (exp)
@ -2545,12 +2561,12 @@ scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp)); char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
if (!type) if (!type)
type = "port"; type = "port";
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
scm_print_port_mode (exp, port); scm_print_port_mode (exp, port);
scm_puts (type, port); scm_puts_unlocked (type, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port); scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

10
libguile/ports.h
View file

@ -339,8 +339,10 @@ SCM_API void scm_flush (SCM port);
SCM_API void scm_flush_unlocked (SCM port); SCM_API void scm_flush_unlocked (SCM port);
/* Output. */ /* Output. */
SCM_INLINE void scm_putc (char c, SCM port); SCM_API void scm_putc (char c, SCM port);
SCM_INLINE void scm_puts (const char *str_data, SCM port); SCM_INLINE void scm_putc_unlocked (char c, SCM port);
SCM_API void scm_puts (const char *str_data, SCM port);
SCM_INLINE void scm_puts_unlocked (const char *str_data, SCM port);
SCM_API void scm_c_write (SCM port, const void *buffer, size_t size); SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port); SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port);
SCM_INTERNAL void scm_lfwrite_substr (SCM str, size_t start, size_t end, SCM_INTERNAL void scm_lfwrite_substr (SCM str, size_t start, size_t end,
@ -457,14 +459,14 @@ scm_peek_byte_or_eof_unlocked (SCM port)
} }
SCM_INLINE_IMPLEMENTATION void SCM_INLINE_IMPLEMENTATION void
scm_putc (char c, SCM port) scm_putc_unlocked (char c, SCM port)
{ {
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (&c, 1, port); scm_lfwrite (&c, 1, port);
} }
SCM_INLINE_IMPLEMENTATION void SCM_INLINE_IMPLEMENTATION void
scm_puts (const char *s, SCM port) scm_puts_unlocked (const char *s, SCM port)
{ {
SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
scm_lfwrite (s, strlen (s), port); scm_lfwrite (s, strlen (s), port);

60
libguile/print.c
View file

@ -156,7 +156,7 @@ do \
{ \ { \
if (pstate->top - pstate->list_offset >= pstate->level) \ if (pstate->top - pstate->list_offset >= pstate->level) \
{ \ { \
scm_putc ('#', port); \ scm_putc_unlocked ('#', port); \
return; \ return; \
} \ } \
} \ } \
@ -300,9 +300,9 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref)
for (i = pstate->top - 1; 1; --i) for (i = pstate->top - 1; 1; --i)
if (scm_is_eq (PSTATE_STACK_REF(pstate, i), ref)) if (scm_is_eq (PSTATE_STACK_REF(pstate, i), ref))
break; break;
scm_putc ('#', port); scm_putc_unlocked ('#', port);
scm_intprint (i - self, 10, port); scm_intprint (i - self, 10, port);
scm_putc ('#', port); scm_putc_unlocked ('#', port);
} }
/* Print the name of a symbol. */ /* Print the name of a symbol. */
@ -452,7 +452,7 @@ static void iprin1 (SCM exp, SCM port, scm_print_state *pstate);
scm_intprint (i, 8, port); \ scm_intprint (i, 8, port); \
else \ else \
{ \ { \
scm_puts ("x", port); \ scm_puts_unlocked ("x", port); \
scm_intprint (i, 16, port); \ scm_intprint (i, 16, port); \
} \ } \
} \ } \
@ -507,7 +507,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
else if (SCM_IFLAGP (exp) else if (SCM_IFLAGP (exp)
&& ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof (char *)))) && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof (char *))))
{ {
scm_puts (iflagnames [SCM_IFLAGNUM (exp)], port); scm_puts_unlocked (iflagnames [SCM_IFLAGNUM (exp)], port);
} }
else else
{ {
@ -601,11 +601,11 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
} }
else else
{ {
scm_puts ("#<uninterned-symbol ", port); scm_puts_unlocked ("#<uninterned-symbol ", port);
scm_i_print_symbol_name (exp, port); scm_i_print_symbol_name (exp, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_uintprint (SCM_UNPACK (exp), 16, port); scm_uintprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
break; break;
case scm_tc7_variable: case scm_tc7_variable:
@ -652,7 +652,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break; break;
case scm_tc7_wvect: case scm_tc7_wvect:
ENTER_NESTED_DATA (pstate, exp, circref); ENTER_NESTED_DATA (pstate, exp, circref);
scm_puts ("#w(", port); scm_puts_unlocked ("#w(", port);
goto common_vector_printer; goto common_vector_printer;
case scm_tc7_bytevector: case scm_tc7_bytevector:
@ -660,7 +660,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
break; break;
case scm_tc7_vector: case scm_tc7_vector:
ENTER_NESTED_DATA (pstate, exp, circref); ENTER_NESTED_DATA (pstate, exp, circref);
scm_puts ("#(", port); scm_puts_unlocked ("#(", port);
common_vector_printer: common_vector_printer:
{ {
register long i; register long i;
@ -675,7 +675,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
for (i = 0; i < last; ++i) for (i = 0; i < last; ++i)
{ {
scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate); scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
} }
if (i == last) if (i == last)
{ {
@ -683,8 +683,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate); scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate);
} }
if (cutp) if (cutp)
scm_puts (" ...", port); scm_puts_unlocked (" ...", port);
scm_putc (')', port); scm_putc_unlocked (')', port);
} }
EXIT_NESTED_DATA (pstate); EXIT_NESTED_DATA (pstate);
break; break;
@ -1077,7 +1077,7 @@ write_character_escaped (scm_t_wchar ch, int string_escapes_p, SCM port)
name = scm_i_charname (SCM_MAKE_CHAR (ch)); name = scm_i_charname (SCM_MAKE_CHAR (ch));
if (name != NULL) if (name != NULL)
scm_puts (name, port); scm_puts_unlocked (name, port);
else else
PRINT_CHAR_ESCAPE (ch, port); PRINT_CHAR_ESCAPE (ch, port);
} }
@ -1158,19 +1158,19 @@ scm_uintprint (scm_t_uintmax n, int radix, SCM port)
void void
scm_ipruk (char *hdr, SCM ptr, SCM port) scm_ipruk (char *hdr, SCM ptr, SCM port)
{ {
scm_puts ("#<unknown-", port); scm_puts_unlocked ("#<unknown-", port);
scm_puts (hdr, port); scm_puts_unlocked (hdr, port);
if (1) /* (scm_in_heap_p (ptr)) */ /* FIXME */ if (1) /* (scm_in_heap_p (ptr)) */ /* FIXME */
{ {
scm_puts (" (0x", port); scm_puts_unlocked (" (0x", port);
scm_uintprint (SCM_CELL_WORD_0 (ptr), 16, port); scm_uintprint (SCM_CELL_WORD_0 (ptr), 16, port);
scm_puts (" . 0x", port); scm_puts_unlocked (" . 0x", port);
scm_uintprint (SCM_CELL_WORD_1 (ptr), 16, port); scm_uintprint (SCM_CELL_WORD_1 (ptr), 16, port);
scm_puts (") @", port); scm_puts_unlocked (") @", port);
} }
scm_puts (" 0x", port); scm_puts_unlocked (" 0x", port);
scm_uintprint (SCM_UNPACK (ptr), 16, port); scm_uintprint (SCM_UNPACK (ptr), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
@ -1181,7 +1181,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
{ {
register SCM hare, tortoise; register SCM hare, tortoise;
long floor = pstate->top - 2; long floor = pstate->top - 2;
scm_puts (hdr, port); scm_puts_unlocked (hdr, port);
/* CHECK_INTS; */ /* CHECK_INTS; */
if (pstate->fancyp) if (pstate->fancyp)
goto fancy_printing; goto fancy_printing;
@ -1211,18 +1211,18 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
if (scm_is_eq (PSTATE_STACK_REF(pstate, i), exp)) if (scm_is_eq (PSTATE_STACK_REF(pstate, i), exp))
goto circref; goto circref;
PUSH_REF (pstate, exp); PUSH_REF (pstate, exp);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
/* CHECK_INTS; */ /* CHECK_INTS; */
scm_iprin1 (SCM_CAR (exp), port, pstate); scm_iprin1 (SCM_CAR (exp), port, pstate);
} }
if (!SCM_NULL_OR_NIL_P (exp)) if (!SCM_NULL_OR_NIL_P (exp))
{ {
scm_puts (" . ", port); scm_puts_unlocked (" . ", port);
scm_iprin1 (exp, port, pstate); scm_iprin1 (exp, port, pstate);
} }
end: end:
scm_putc (tlr, port); scm_putc_unlocked (tlr, port);
pstate->top = floor + 2; pstate->top = floor + 2;
return; return;
@ -1243,7 +1243,7 @@ fancy_printing:
{ {
if (n == 0) if (n == 0)
{ {
scm_puts (" ...", port); scm_puts_unlocked (" ...", port);
goto skip_tail; goto skip_tail;
} }
else else
@ -1251,14 +1251,14 @@ fancy_printing:
} }
PUSH_REF(pstate, exp); PUSH_REF(pstate, exp);
++pstate->list_offset; ++pstate->list_offset;
scm_putc (' ', port); scm_putc_unlocked (' ', port);
/* CHECK_INTS; */ /* CHECK_INTS; */
scm_iprin1 (SCM_CAR (exp), port, pstate); scm_iprin1 (SCM_CAR (exp), port, pstate);
} }
} }
if (!SCM_NULL_OR_NIL_P (exp)) if (!SCM_NULL_OR_NIL_P (exp))
{ {
scm_puts (" . ", port); scm_puts_unlocked (" . ", port);
scm_iprin1 (exp, port, pstate); scm_iprin1 (exp, port, pstate);
} }
skip_tail: skip_tail:
@ -1269,7 +1269,7 @@ fancy_circref:
pstate->list_offset -= pstate->top - floor - 2; pstate->list_offset -= pstate->top - floor - 2;
circref: circref:
scm_puts (" . ", port); scm_puts_unlocked (" . ", port);
print_circref (port, pstate, exp); print_circref (port, pstate, exp);
goto end; goto end;
} }
@ -1422,7 +1422,7 @@ SCM_DEFINE (scm_newline, "newline", 0, 1, 0,
SCM_VALIDATE_OPORT_VALUE (1, port); SCM_VALIDATE_OPORT_VALUE (1, port);
scm_putc ('\n', SCM_COERCE_OUTPORT (port)); scm_putc_unlocked ('\n', SCM_COERCE_OUTPORT (port));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

12
libguile/programs.c
View file

@ -82,22 +82,22 @@ scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
if (SCM_PROGRAM_IS_CONTINUATION (program)) if (SCM_PROGRAM_IS_CONTINUATION (program))
{ {
/* twingliness */ /* twingliness */
scm_puts ("#<continuation ", port); scm_puts_unlocked ("#<continuation ", port);
scm_uintprint (SCM_UNPACK (program), 16, port); scm_uintprint (SCM_UNPACK (program), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
else if (SCM_PROGRAM_IS_PARTIAL_CONTINUATION (program)) else if (SCM_PROGRAM_IS_PARTIAL_CONTINUATION (program))
{ {
/* twingliness */ /* twingliness */
scm_puts ("#<partial-continuation ", port); scm_puts_unlocked ("#<partial-continuation ", port);
scm_uintprint (SCM_UNPACK (program), 16, port); scm_uintprint (SCM_UNPACK (program), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
else if (scm_is_false (write_program) || print_error) else if (scm_is_false (write_program) || print_error)
{ {
scm_puts ("#<program ", port); scm_puts_unlocked ("#<program ", port);
scm_uintprint (SCM_UNPACK (program), 16, port); scm_uintprint (SCM_UNPACK (program), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
else else
{ {

4
libguile/promises.c
View file

@ -88,11 +88,11 @@ static int
promise_print (SCM exp, SCM port, scm_print_state *pstate) promise_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
int writingp = SCM_WRITINGP (pstate); int writingp = SCM_WRITINGP (pstate);
scm_puts ("#<promise ", port); scm_puts_unlocked ("#<promise ", port);
SCM_SET_WRITINGP (pstate, 1); SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (SCM_PROMISE_DATA (exp), port, pstate); scm_iprin1 (SCM_PROMISE_DATA (exp), port, pstate);
SCM_SET_WRITINGP (pstate, writingp); SCM_SET_WRITINGP (pstate, writingp);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return !0; return !0;
} }

2
libguile/r6rs-ports.c
View file

@ -688,7 +688,7 @@ SCM_DEFINE (scm_put_u8, "put-u8", 2, 0, 0,
SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port); SCM_VALIDATE_BINARY_OUTPUT_PORT (1, port);
c_octet = scm_to_uint8 (octet); c_octet = scm_to_uint8 (octet);
scm_putc ((char) c_octet, port); scm_putc_unlocked ((char) c_octet, port);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }

8
libguile/smob.c
View file

@ -108,14 +108,14 @@ int
scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
long n = SCM_SMOBNUM (exp); long n = SCM_SMOBNUM (exp);
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port); scm_puts_unlocked (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
if (scm_smobs[n].size) if (scm_smobs[n].size)
scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port); scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
else else
scm_uintprint (SCM_UNPACK (exp), 16, port); scm_uintprint (SCM_UNPACK (exp), 16, port);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

4
libguile/srcprop.c
View file

@ -95,11 +95,11 @@ static int
srcprops_print (SCM obj, SCM port, scm_print_state *pstate) srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
{ {
int writingp = SCM_WRITINGP (pstate); int writingp = SCM_WRITINGP (pstate);
scm_puts ("#<srcprops ", port); scm_puts_unlocked ("#<srcprops ", port);
SCM_SET_WRITINGP (pstate, 1); SCM_SET_WRITINGP (pstate, 1);
scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate); scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
SCM_SET_WRITINGP (pstate, writingp); SCM_SET_WRITINGP (pstate, writingp);
scm_putc ('>', port); scm_putc_unlocked ('>', port);
return 1; return 1;
} }

18
libguile/srfi-14.c
View file

@ -597,27 +597,27 @@ charset_print (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
p = SCM_CHARSET_DATA (charset); p = SCM_CHARSET_DATA (charset);
scm_puts ("#<charset {", port); scm_puts_unlocked ("#<charset {", port);
for (i = 0; i < p->len; i++) for (i = 0; i < p->len; i++)
{ {
if (first) if (first)
first = 0; first = 0;
else else
scm_puts (" ", port); scm_puts_unlocked (" ", port);
scm_write (SCM_MAKE_CHAR (p->ranges[i].lo), port); scm_write (SCM_MAKE_CHAR (p->ranges[i].lo), port);
if (p->ranges[i].lo != p->ranges[i].hi) if (p->ranges[i].lo != p->ranges[i].hi)
{ {
scm_puts ("..", port); scm_puts_unlocked ("..", port);
scm_write (SCM_MAKE_CHAR (p->ranges[i].hi), port); scm_write (SCM_MAKE_CHAR (p->ranges[i].hi), port);
} }
if (i >= max_ranges_to_print) if (i >= max_ranges_to_print)
{ {
/* Too many to print here. Quit early. */ /* Too many to print here. Quit early. */
scm_puts (" ...", port); scm_puts_unlocked (" ...", port);
break; break;
} }
} }
scm_puts ("}>", port); scm_puts_unlocked ("}>", port);
return 1; return 1;
} }
@ -630,16 +630,16 @@ charset_cursor_print (SCM cursor, SCM port,
cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor); cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
scm_puts ("#<charset-cursor ", port); scm_puts_unlocked ("#<charset-cursor ", port);
if (cur->range == (size_t) (-1)) if (cur->range == (size_t) (-1))
scm_puts ("(empty)", port); scm_puts_unlocked ("(empty)", port);
else else
{ {
scm_write (scm_from_size_t (cur->range), port); scm_write (scm_from_size_t (cur->range), port);
scm_puts (":", port); scm_puts_unlocked (":", port);
scm_write (scm_from_int32 (cur->n), port); scm_write (scm_from_int32 (cur->n), port);
} }
scm_puts (">", port); scm_puts_unlocked (">", port);
return 1; return 1;
} }

6
libguile/stackchk.c
View file

@ -86,11 +86,11 @@ scm_stack_report ()
scm_uintprint ((scm_stack_size (thread->continuation_base) scm_uintprint ((scm_stack_size (thread->continuation_base)
* sizeof (SCM_STACKITEM)), * sizeof (SCM_STACKITEM)),
16, port); 16, port);
scm_puts (" of stack: 0x", port); scm_puts_unlocked (" of stack: 0x", port);
scm_uintprint ((scm_t_bits) thread->continuation_base, 16, port); scm_uintprint ((scm_t_bits) thread->continuation_base, 16, port);
scm_puts (" - 0x", port); scm_puts_unlocked (" - 0x", port);
scm_uintprint ((scm_t_bits) &stack, 16, port); scm_uintprint ((scm_t_bits) &stack, 16, port);
scm_puts ("\n", port); scm_puts_unlocked ("\n", port);
} }

20
libguile/struct.c
View file

@ -981,22 +981,22 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
{ {
SCM vtable = SCM_STRUCT_VTABLE (exp); SCM vtable = SCM_STRUCT_VTABLE (exp);
SCM name = scm_struct_vtable_name (vtable); SCM name = scm_struct_vtable_name (vtable);
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
if (scm_is_true (name)) if (scm_is_true (name))
{ {
scm_display (name, port); scm_display (name, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
} }
else else
{ {
if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE)) if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
scm_puts ("vtable:", port); scm_puts_unlocked ("vtable:", port);
else else
scm_puts ("struct:", port); scm_puts_unlocked ("struct:", port);
scm_uintprint (SCM_UNPACK (vtable), 16, port); scm_uintprint (SCM_UNPACK (vtable), 16, port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
scm_write (SCM_VTABLE_LAYOUT (vtable), port); scm_write (SCM_VTABLE_LAYOUT (vtable), port);
scm_putc (' ', port); scm_putc_unlocked (' ', port);
} }
scm_uintprint (SCM_UNPACK (exp), 16, port); scm_uintprint (SCM_UNPACK (exp), 16, port);
/* hackety hack */ /* hackety hack */
@ -1004,19 +1004,19 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
{ {
if (scm_is_true (SCM_STRUCT_PROCEDURE (exp))) if (scm_is_true (SCM_STRUCT_PROCEDURE (exp)))
{ {
scm_puts (" proc: ", port); scm_puts_unlocked (" proc: ", port);
if (scm_is_true (scm_procedure_p (SCM_STRUCT_PROCEDURE (exp)))) if (scm_is_true (scm_procedure_p (SCM_STRUCT_PROCEDURE (exp))))
scm_write (SCM_STRUCT_PROCEDURE (exp), port); scm_write (SCM_STRUCT_PROCEDURE (exp), port);
else else
scm_puts ("(not a procedure?)", port); scm_puts_unlocked ("(not a procedure?)", port);
} }
if (SCM_STRUCT_SETTER_P (exp)) if (SCM_STRUCT_SETTER_P (exp))
{ {
scm_puts (" setter: ", port); scm_puts_unlocked (" setter: ", port);
scm_write (SCM_STRUCT_SETTER (exp), port); scm_write (SCM_STRUCT_SETTER (exp), port);
} }
} }
scm_putc ('>', port); scm_putc_unlocked ('>', port);
} }
} }

14
libguile/threads.c
View file

@ -367,11 +367,11 @@ thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
else else
id = u.um; id = u.um;
scm_puts ("#<thread ", port); scm_puts_unlocked ("#<thread ", port);
scm_uintprint (id, 10, port); scm_uintprint (id, 10, port);
scm_puts (" (", port); scm_puts_unlocked (" (", port);
scm_uintprint ((scm_t_bits)t, 16, port); scm_uintprint ((scm_t_bits)t, 16, port);
scm_puts (")>", port); scm_puts_unlocked (")>", port);
return 1; return 1;
} }
@ -1270,9 +1270,9 @@ static int
fat_mutex_print (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED) fat_mutex_print (SCM mx, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
fat_mutex *m = SCM_MUTEX_DATA (mx); fat_mutex *m = SCM_MUTEX_DATA (mx);
scm_puts ("#<mutex ", port); scm_puts_unlocked ("#<mutex ", port);
scm_uintprint ((scm_t_bits)m, 16, port); scm_uintprint ((scm_t_bits)m, 16, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
return 1; return 1;
} }
@ -1727,9 +1727,9 @@ static int
fat_cond_print (SCM cv, SCM port, scm_print_state *pstate SCM_UNUSED) fat_cond_print (SCM cv, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
fat_cond *c = SCM_CONDVAR_DATA (cv); fat_cond *c = SCM_CONDVAR_DATA (cv);
scm_puts ("#<condition-variable ", port); scm_puts_unlocked ("#<condition-variable ", port);
scm_uintprint ((scm_t_bits)c, 16, port); scm_uintprint ((scm_t_bits)c, 16, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
return 1; return 1;
} }

2
libguile/throw.c
View file

@ -370,7 +370,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
if (should_print_backtrace (tag, stack)) if (should_print_backtrace (tag, stack))
{ {
scm_puts ("Backtrace:\n", p); scm_puts_unlocked ("Backtrace:\n", p);
scm_display_backtrace_with_highlights (stack, p, scm_display_backtrace_with_highlights (stack, p,
SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F,
SCM_EOL); SCM_EOL);

4
libguile/values.c
View file

@ -60,9 +60,9 @@ print_values (SCM obj, SCM pwps)
SCM port = SCM_PORT_WITH_PS_PORT (pwps); SCM port = SCM_PORT_WITH_PS_PORT (pwps);
scm_print_state *ps = SCM_PRINT_STATE (SCM_PORT_WITH_PS_PS (pwps)); scm_print_state *ps = SCM_PRINT_STATE (SCM_PORT_WITH_PS_PS (pwps));
scm_puts ("#<values ", port); scm_puts_unlocked ("#<values ", port);
scm_iprin1 (values, port, ps); scm_iprin1 (values, port, ps);
scm_puts (">", port); scm_puts_unlocked (">", port);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }

6
libguile/variable.c
View file

@ -36,11 +36,11 @@
void void
scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate) scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<variable ", port); scm_puts_unlocked ("#<variable ", port);
scm_uintprint (SCM_UNPACK (exp), 16, port); scm_uintprint (SCM_UNPACK (exp), 16, port);
scm_puts (" value: ", port); scm_puts_unlocked (" value: ", port);
scm_iprin1 (SCM_VARIABLE_REF (exp), port, pstate); scm_iprin1 (SCM_VARIABLE_REF (exp), port, pstate);
scm_putc('>', port); scm_putc_unlocked('>', port);
} }

14
libguile/vm.c
View file

@ -83,9 +83,9 @@ static SCM sym_debug;
void void
scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate) scm_i_vm_cont_print (SCM x, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<vm-continuation ", port); scm_puts_unlocked ("#<vm-continuation ", port);
scm_uintprint (SCM_UNPACK (x), 16, port); scm_uintprint (SCM_UNPACK (x), 16, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }
/* In theory, a number of vm instances can be active in the call trace, and we /* In theory, a number of vm instances can be active in the call trace, and we
@ -351,22 +351,22 @@ scm_i_vm_print (SCM x, SCM port, scm_print_state *pstate)
vm = SCM_VM_DATA (x); vm = SCM_VM_DATA (x);
scm_puts ("#<vm ", port); scm_puts_unlocked ("#<vm ", port);
switch (vm->engine) switch (vm->engine)
{ {
case SCM_VM_REGULAR_ENGINE: case SCM_VM_REGULAR_ENGINE:
scm_puts ("regular-engine ", port); scm_puts_unlocked ("regular-engine ", port);
break; break;
case SCM_VM_DEBUG_ENGINE: case SCM_VM_DEBUG_ENGINE:
scm_puts ("debug-engine ", port); scm_puts_unlocked ("debug-engine ", port);
break; break;
default: default:
scm_puts ("unknown-engine ", port); scm_puts_unlocked ("unknown-engine ", port);
} }
scm_uintprint (SCM_UNPACK (x), 16, port); scm_uintprint (SCM_UNPACK (x), 16, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }
static SCM static SCM

8
libguile/weak-set.c
View file

@ -619,12 +619,12 @@ make_weak_set (unsigned long k)
void void
scm_i_weak_set_print (SCM exp, SCM port, scm_print_state *pstate) scm_i_weak_set_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
scm_puts ("weak-set ", port); scm_puts_unlocked ("weak-set ", port);
scm_uintprint (SCM_WEAK_SET (exp)->n_items, 10, port); scm_uintprint (SCM_WEAK_SET (exp)->n_items, 10, port);
scm_putc ('/', port); scm_putc_unlocked ('/', port);
scm_uintprint (SCM_WEAK_SET (exp)->size, 10, port); scm_uintprint (SCM_WEAK_SET (exp)->size, 10, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }
static void static void

8
libguile/weak-table.c
View file

@ -719,12 +719,12 @@ make_weak_table (unsigned long k, scm_t_weak_table_kind kind)
void void
scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate) scm_i_weak_table_print (SCM exp, SCM port, scm_print_state *pstate)
{ {
scm_puts ("#<", port); scm_puts_unlocked ("#<", port);
scm_puts ("weak-table ", port); scm_puts_unlocked ("weak-table ", port);
scm_uintprint (SCM_WEAK_TABLE (exp)->n_items, 10, port); scm_uintprint (SCM_WEAK_TABLE (exp)->n_items, 10, port);
scm_putc ('/', port); scm_putc_unlocked ('/', port);
scm_uintprint (SCM_WEAK_TABLE (exp)->size, 10, port); scm_uintprint (SCM_WEAK_TABLE (exp)->size, 10, port);
scm_puts (">", port); scm_puts_unlocked (">", port);
} }
static void static void