From bfb85df7084e26a276142cdc62315a85c7a0ba20 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 11 Mar 2011 20:53:13 +0100 Subject: fix port-filename without readline to match the docs * libguile/init.c (stream_body, scm_standard_stream_to_port): Don't name stdin, stdout, and stderr -- at least not as strings. That confuses any code which tries to treat port-filename as a real filename, like the syntax expander, or the `load' procedure/macro. Also this behavior matches the docs now. --- libguile/init.c | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) (limited to 'libguile/init.c') diff --git a/libguile/init.c b/libguile/init.c index 9b8c4d086..d6a710504 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -157,7 +157,6 @@ typedef struct { int fdes; char *mode; - char *name; } stream_body_data; /* proc to be called in scope of exception handler stream_handler. */ @@ -165,8 +164,7 @@ static SCM stream_body (void *data) { stream_body_data *body_data = (stream_body_data *) data; - SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, - scm_from_locale_string (body_data->name)); + SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, SCM_BOOL_F); SCM_REVEALED (port) = 1; return port; @@ -182,21 +180,19 @@ stream_handler (void *data SCM_UNUSED, } /* Convert a file descriptor to a port, using scm_fdes_to_port. - - NAME is a C string, not a Guile string - set the revealed count for FILE's file descriptor to 1, so that fdes won't be closed when the port object is GC'd. - catch exceptions: allow Guile to be able to start up even if it has been handed bogus stdin/stdout/stderr. replace the bad ports with void ports. */ static SCM -scm_standard_stream_to_port (int fdes, char *mode, char *name) +scm_standard_stream_to_port (int fdes, char *mode) { SCM port; stream_body_data body_data; body_data.fdes = fdes; body_data.mode = mode; - body_data.name = name; port = scm_internal_catch (SCM_BOOL_T, stream_body, &body_data, stream_handler, NULL); if (scm_is_false (port)) @@ -223,17 +219,11 @@ scm_init_standard_ports () block buffering for higher performance. */ scm_set_current_input_port - (scm_standard_stream_to_port (0, - isatty (0) ? "r0" : "r", - "standard input")); + (scm_standard_stream_to_port (0, isatty (0) ? "r0" : "r")); scm_set_current_output_port - (scm_standard_stream_to_port (1, - isatty (1) ? "w0" : "w", - "standard output")); + (scm_standard_stream_to_port (1, isatty (1) ? "w0" : "w")); scm_set_current_error_port - (scm_standard_stream_to_port (2, - isatty (2) ? "w0" : "w", - "standard error")); + (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w")); } -- cgit v1.2.3 From 12c1d8616d8dfedcad65f34e3968f9544b629ae1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 25 Mar 2011 13:01:51 +0100 Subject: threading / with_guile refactor to use more GC_stack_base * libguile/init.h: * libguile/init.c (scm_i_init_guile): Change arg to this internal function from SCM_STACKITEM* to void*. Actually it's a struct GC_stack_base*. * libguile/bdw-gc.h: Don't do pthread redirects, because we don't want to affect applications' pthread_* bindings. * libguile/pthread-threads.h (scm_i_pthread_create) (scm_i_pthread_detach, scm_i_pthread_exit, scm_i_pthread_cancel) (scm_i_pthread_sigmask): Do pthread redirects here, in this internal header. * libguile/threads.h: Remove declaration of internal scm_i_with_guile_and_parent. Remove declaration of undefined scm_threads_init_first_thread. Make declaration of internal scm_threads_prehistory actually internal, and take a void* (actually a struct GC_stack_base*). * libguile/threads.c (GC_get_stack_base): Implement a shim if this function is unavailable, and fold in the implementations of get_thread_stack_base. (GC_call_with_stack_base): Actually implement. (guilify_self_1): Take a GC_stack_base* as an arg. (scm_i_init_thread_for_guile): Likewise, and set up libgc for registration of other threads. (scm_init_guile): Use GC_get_stack_base instead of our own guesswork. (with_guile_and_parent, scm_i_with_guile_and_parent): Rework to trampoline through a GC_call_with_stack_base. (scm_threads_prehistory): Pass the "base" arg on to guilify_self_1. --- libguile/bdw-gc.h | 7 +- libguile/init.c | 8 +- libguile/init.h | 4 +- libguile/pthread-threads.h | 14 +-- libguile/threads.c | 272 ++++++++++++++++++++++++--------------------- libguile/threads.h | 8 +- 6 files changed, 162 insertions(+), 151 deletions(-) (limited to 'libguile/init.c') diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h index 3adf99e66..61c11eb94 100644 --- a/libguile/bdw-gc.h +++ b/libguile/bdw-gc.h @@ -1,7 +1,7 @@ #ifndef SCM_BDW_GC_H #define SCM_BDW_GC_H -/* Copyright (C) 2006, 2008, 2009 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008, 2009, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -32,6 +32,11 @@ # define GC_THREADS 1 # define GC_REDIRECT_TO_LOCAL 1 +/* Don't #define pthread routines to their GC_pthread counterparts. + Instead we will be careful inside Guile to use the GC_pthread + routines. */ +# define GC_NO_THREAD_REDIRECTS 1 + #endif #include diff --git a/libguile/init.c b/libguile/init.c index d6a710504..8b3b8cd33 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -376,17 +376,11 @@ cleanup_for_exit () } void -scm_i_init_guile (SCM_STACKITEM *base) +scm_i_init_guile (void *base) { if (scm_initialized_p) return; - if (base == NULL) - { - fprintf (stderr, "cannot determine stack base!\n"); - abort (); - } - if (sizeof (mpz_t) > (3 * sizeof (scm_t_bits))) { fprintf (stderr, diff --git a/libguile/init.h b/libguile/init.h index 7cfae76d5..bc6cddf93 100644 --- a/libguile/init.h +++ b/libguile/init.h @@ -3,7 +3,7 @@ #ifndef SCM_INIT_H #define SCM_INIT_H -/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -38,7 +38,7 @@ SCM_API void scm_boot_guile (int argc, char **argv, char **argv), void *closure); -SCM_INTERNAL void scm_i_init_guile (SCM_STACKITEM *base); +SCM_INTERNAL void scm_i_init_guile (void *base); SCM_API void scm_load_startup_files (void); diff --git a/libguile/pthread-threads.h b/libguile/pthread-threads.h index ca72f1674..c180af252 100644 --- a/libguile/pthread-threads.h +++ b/libguile/pthread-threads.h @@ -3,7 +3,7 @@ #ifndef SCM_PTHREADS_THREADS_H #define SCM_PTHREADS_THREADS_H -/* Copyright (C) 2002, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2005, 2006, 2011 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -29,24 +29,24 @@ #include #include -/* `libgc' intercepts pthread calls by defining wrapping macros. */ +/* `libgc' defines wrapper procedures for pthread calls. */ #include "libguile/bdw-gc.h" /* Threads */ #define scm_i_pthread_t pthread_t #define scm_i_pthread_self pthread_self -#define scm_i_pthread_create pthread_create -#define scm_i_pthread_detach pthread_detach -#define scm_i_pthread_exit pthread_exit -#define scm_i_pthread_cancel pthread_cancel +#define scm_i_pthread_create GC_pthread_create +#define scm_i_pthread_detach GC_pthread_detach +#define scm_i_pthread_exit GC_pthread_exit +#define scm_i_pthread_cancel GC_pthread_cancel #define scm_i_pthread_cleanup_push pthread_cleanup_push #define scm_i_pthread_cleanup_pop pthread_cleanup_pop #define scm_i_sched_yield sched_yield /* Signals */ -#define scm_i_pthread_sigmask pthread_sigmask +#define scm_i_pthread_sigmask GC_pthread_sigmask /* Mutexes */ diff --git a/libguile/threads.c b/libguile/threads.c index 6f75dbe19..2f5569fb5 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -89,7 +89,12 @@ typedef void * (* GC_fn_type) (void *); /* Likewise struct GC_stack_base is missing before 7.1. */ #ifndef HAVE_GC_STACK_BASE -struct GC_stack_base; +struct GC_stack_base { + void * mem_base; /* Base of memory stack. */ +#ifdef __ia64__ + void * reg_base; /* Base of separate register stack. */ +#endif +}; static int GC_register_my_thread (struct GC_stack_base *) @@ -102,13 +107,93 @@ GC_unregister_my_thread () { } +#if !SCM_USE_PTHREAD_THREADS +/* No threads; we can just use GC_stackbottom. */ static void * -GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg) +get_thread_stack_base () +{ + return GC_stackbottom; +} + +#elif defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP \ + && defined PTHREAD_ATTR_GETSTACK_WORKS +/* This method for GNU/Linux and perhaps some other systems. + It's not for MacOS X or Solaris 10, since pthread_getattr_np is not + available on them. */ +static void * +get_thread_stack_base () +{ + pthread_attr_t attr; + void *start, *end; + size_t size; + + pthread_getattr_np (pthread_self (), &attr); + pthread_attr_getstack (&attr, &start, &size); + end = (char *)start + size; + +#if SCM_STACK_GROWS_UP + return start; +#else + return end; +#endif +} + +#elif defined HAVE_PTHREAD_GET_STACKADDR_NP +/* This method for MacOS X. + It'd be nice if there was some documentation on pthread_get_stackaddr_np, + but as of 2006 there's nothing obvious at apple.com. */ +static void * +get_thread_stack_base () +{ + return pthread_get_stackaddr_np (pthread_self ()); +} + +#else +#error Threads enabled with old BDW-GC, but missing get_thread_stack_base impl. Please upgrade to libgc >= 7.1. +#endif + +static int +GC_get_stack_base (struct GC_stack_base *) { - return fn (NULL, arg); + stack_base->mem_base = get_thread_stack_base (); +#ifdef __ia64__ + /* Calculate and store off the base of this thread's register + backing store (RBS). Unfortunately our implementation(s) of + scm_ia64_register_backing_store_base are only reliable for the + main thread. For other threads, therefore, find out the current + top of the RBS, and use that as a maximum. */ + stack_base->reg_base = scm_ia64_register_backing_store_base (); + { + ucontext_t ctx; + void *bsp; + getcontext (&ctx); + bsp = scm_ia64_ar_bsp (&ctx); + if (stack_base->reg_base > bsp) + stack_base->reg_base = bsp; + } +#endif + return GC_SUCCESS; } + +static void * +GC_call_with_stack_base(void * (*fn) (struct GC_stack_base*, void*), void *arg) +{ + struct GC_stack_base stack_base; + + stack_base.mem_base = (void*)&stack_base; +#ifdef __ia64__ + /* FIXME: Untested. */ + { + ucontext_t ctx; + getcontext (&ctx); + stack_base.reg_base = scm_ia64_ar_bsp (&ctx); + } #endif + return fn (&stack_base, arg); +} +#endif /* HAVE_GC_STACK_BASE */ + /* Now define with_gc_active and with_gc_inactive. */ @@ -401,7 +486,7 @@ static SCM scm_i_default_dynamic_state; /* Perform first stage of thread initialisation, in non-guile mode. */ static void -guilify_self_1 (SCM_STACKITEM *base) +guilify_self_1 (struct GC_stack_base *base) { scm_i_thread *t = scm_gc_malloc (sizeof (scm_i_thread), "thread"); @@ -418,25 +503,12 @@ guilify_self_1 (SCM_STACKITEM *base) t->block_asyncs = 1; t->pending_asyncs = 1; t->critical_section_level = 0; - t->base = base; + t->base = base->mem_base; #ifdef __ia64__ - /* Calculate and store off the base of this thread's register - backing store (RBS). Unfortunately our implementation(s) of - scm_ia64_register_backing_store_base are only reliable for the - main thread. For other threads, therefore, find out the current - top of the RBS, and use that as a maximum. */ - t->register_backing_store_base = scm_ia64_register_backing_store_base (); - { - ucontext_t ctx; - void *bsp; - getcontext (&ctx); - bsp = scm_ia64_ar_bsp (&ctx); - if (t->register_backing_store_base > bsp) - t->register_backing_store_base = bsp; - } + t->register_backing_store_base = base->reg-base; #endif t->continuation_root = SCM_EOL; - t->continuation_base = base; + t->continuation_base = t->base; scm_i_pthread_cond_init (&t->sleep_cond, NULL); t->sleep_mutex = NULL; t->sleep_object = SCM_BOOL_F; @@ -668,7 +740,7 @@ init_thread_key (void) be sure. New threads are put into guile mode implicitly. */ static int -scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) +scm_i_init_thread_for_guile (struct GC_stack_base *base, SCM parent) { scm_i_pthread_once (&init_thread_key_once, init_thread_key); @@ -690,6 +762,10 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) initialization. */ scm_i_init_guile (base); + + /* Allow other threads to come in later. */ + GC_allow_register_threads (); + scm_i_pthread_mutex_unlock (&scm_i_init_mutex); } else @@ -698,6 +774,10 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) the first time. Only initialize this thread. */ scm_i_pthread_mutex_unlock (&scm_i_init_mutex); + + /* Register this thread with libgc. */ + GC_register_my_thread (base); + guilify_self_1 (base); guilify_self_2 (parent); } @@ -705,135 +785,58 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) } } -#if SCM_USE_PTHREAD_THREADS - -#if defined HAVE_PTHREAD_ATTR_GETSTACK && defined HAVE_PTHREAD_GETATTR_NP -/* This method for GNU/Linux and perhaps some other systems. - It's not for MacOS X or Solaris 10, since pthread_getattr_np is not - available on them. */ -#define HAVE_GET_THREAD_STACK_BASE - -static SCM_STACKITEM * -get_thread_stack_base () +void +scm_init_guile () { - pthread_attr_t attr; - void *start, *end; - size_t size; - - pthread_getattr_np (pthread_self (), &attr); - pthread_attr_getstack (&attr, &start, &size); - end = (char *)start + size; - - /* XXX - pthread_getattr_np from LinuxThreads does not seem to work - for the main thread, but we can use scm_get_stack_base in that - case. - */ - -#ifndef PTHREAD_ATTR_GETSTACK_WORKS - if ((void *)&attr < start || (void *)&attr >= end) - return (SCM_STACKITEM *) GC_stackbottom; + struct GC_stack_base stack_base; + + if (GC_get_stack_base (&stack_base) == GC_SUCCESS) + scm_i_init_thread_for_guile (&stack_base, + scm_i_default_dynamic_state); else -#endif { -#if SCM_STACK_GROWS_UP - return start; -#else - return end; -#endif + fprintf (stderr, "Failed to get stack base for current thread.\n"); + exit (1); } } -#elif defined HAVE_PTHREAD_GET_STACKADDR_NP -/* This method for MacOS X. - It'd be nice if there was some documentation on pthread_get_stackaddr_np, - but as of 2006 there's nothing obvious at apple.com. */ -#define HAVE_GET_THREAD_STACK_BASE -static SCM_STACKITEM * -get_thread_stack_base () -{ - return pthread_get_stackaddr_np (pthread_self ()); -} - -#elif defined (__MINGW32__) -/* This method for mingw. In mingw the basic scm_get_stack_base can be used - in any thread. We don't like hard-coding the name of a system, but there - doesn't seem to be a cleaner way of knowing scm_get_stack_base can - work. */ -#define HAVE_GET_THREAD_STACK_BASE -static SCM_STACKITEM * -get_thread_stack_base () -{ - return (SCM_STACKITEM *) GC_stackbottom; -} - -#endif /* pthread methods of get_thread_stack_base */ - -#else /* !SCM_USE_PTHREAD_THREADS */ - -#define HAVE_GET_THREAD_STACK_BASE - -static SCM_STACKITEM * -get_thread_stack_base () -{ - return (SCM_STACKITEM *) GC_stackbottom; -} - -#endif /* !SCM_USE_PTHREAD_THREADS */ - -#ifdef HAVE_GET_THREAD_STACK_BASE - -void -scm_init_guile () -{ - scm_i_init_thread_for_guile (get_thread_stack_base (), - scm_i_default_dynamic_state); -} - -#endif - -void * -scm_with_guile (void *(*func)(void *), void *data) -{ - return scm_i_with_guile_and_parent (func, data, - scm_i_default_dynamic_state); -} - SCM_UNUSED static void scm_leave_guile_cleanup (void *x) { on_thread_exit (SCM_I_CURRENT_THREAD); } -struct with_guile_trampoline_args +struct with_guile_args { GC_fn_type func; void *data; + SCM parent; }; static void * with_guile_trampoline (void *data) { - struct with_guile_trampoline_args *args = data; + struct with_guile_args *args = data; return scm_c_with_continuation_barrier (args->func, args->data); } -void * -scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) +static void * +with_guile_and_parent (struct GC_stack_base *base, void *data) { void *res; int new_thread; scm_i_thread *t; - SCM_STACKITEM base_item; + struct with_guile_args *args = data; - new_thread = scm_i_init_thread_for_guile (&base_item, parent); + new_thread = scm_i_init_thread_for_guile (base, args->parent); t = SCM_I_CURRENT_THREAD; if (new_thread) { /* We are in Guile mode. */ assert (t->guile_mode); - res = scm_c_with_continuation_barrier (func, data); + res = scm_c_with_continuation_barrier (args->func, args->data); /* Leave Guile mode. */ t->guile_mode = 0; @@ -841,14 +844,10 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) else if (t->guile_mode) { /* Already in Guile mode. */ - res = scm_c_with_continuation_barrier (func, data); + res = scm_c_with_continuation_barrier (args->func, args->data); } else { - struct with_guile_trampoline_args args; - args.func = func; - args.data = data; - /* We are not in Guile mode, either because we are not within a scm_with_guile, or because we are within a scm_without_guile. @@ -857,20 +856,39 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) when this thread was first guilified. Thus, `base' must be updated. */ #if SCM_STACK_GROWS_UP - if (SCM_STACK_PTR (&base_item) < t->base) - t->base = SCM_STACK_PTR (&base_item); + if (SCM_STACK_PTR (base->mem_base) < t->base) + t->base = SCM_STACK_PTR (base->mem_base); #else - if (SCM_STACK_PTR (&base_item) > t->base) - t->base = SCM_STACK_PTR (&base_item); + if (SCM_STACK_PTR (base->mem_base) > t->base) + t->base = SCM_STACK_PTR (base->mem_base); #endif t->guile_mode = 1; - res = with_gc_active (with_guile_trampoline, &args); + res = with_gc_active (with_guile_trampoline, args); t->guile_mode = 0; } return res; } +static void * +scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) +{ + struct with_guile_args args; + + args.func = func; + args.data = data; + args.parent = parent; + + return GC_call_with_stack_base (with_guile_and_parent, &args); +} + +void * +scm_with_guile (void *(*func)(void *), void *data) +{ + return scm_i_with_guile_and_parent (func, data, + scm_i_default_dynamic_state); +} + void * scm_without_guile (void *(*func)(void *), void *data) { @@ -2003,7 +2021,7 @@ pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1]; #endif void -scm_threads_prehistory (SCM_STACKITEM *base) +scm_threads_prehistory (void *base) { #if SCM_USE_PTHREAD_THREADS pthread_mutexattr_init (scm_i_pthread_mutexattr_recursive); @@ -2016,7 +2034,7 @@ scm_threads_prehistory (SCM_STACKITEM *base) scm_i_pthread_mutex_init (&scm_i_misc_mutex, NULL); scm_i_pthread_cond_init (&wake_up_cond, NULL); - guilify_self_1 (base); + guilify_self_1 ((struct GC_stack_base *) base); } scm_t_bits scm_tc16_thread; diff --git a/libguile/threads.h b/libguile/threads.h index 475af328c..9e44684e1 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -136,13 +136,7 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM_API void *scm_without_guile (void *(*func)(void *), void *data); SCM_API void *scm_with_guile (void *(*func)(void *), void *data); -SCM_INTERNAL void *scm_i_with_guile_and_parent (void *(*func)(void *), - void *data, SCM parent); - - -void scm_threads_prehistory (SCM_STACKITEM *); -void scm_threads_init_first_thread (void); - +SCM_INTERNAL void scm_threads_prehistory (void *); SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); -- cgit v1.2.3