diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/foreign.c | 2 | ||||
-rw-r--r-- | libguile/frames.c | 11 | ||||
-rw-r--r-- | libguile/frames.h | 7 | ||||
-rw-r--r-- | libguile/hashtab.c | 7 | ||||
-rw-r--r-- | libguile/random.c | 101 | ||||
-rw-r--r-- | libguile/random.h | 3 | ||||
-rw-r--r-- | libguile/symbols.c | 50 | ||||
-rw-r--r-- | libguile/threads.c | 1 | ||||
-rw-r--r-- | libguile/threads.h | 4 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 25 | ||||
-rw-r--r-- | libguile/vm.c | 5 |
11 files changed, 190 insertions, 26 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 445ce0289..851cdedd5 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -316,8 +316,6 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0, c_finalizer = SCM_POINTER_VALUE (finalizer); - SCM_SET_CELL_WORD_0 (pointer, SCM_CELL_WORD_0 (pointer) | (1 << 16UL)); - GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (pointer), pointer_finalizer_trampoline, c_finalizer, diff --git a/libguile/frames.c b/libguile/frames.c index b805137a4..b57b1295d 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011, 2012 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 @@ -24,9 +24,16 @@ #include <string.h> #include "_scm.h" #include "frames.h" +#include <verify.h> + +/* Make sure assumptions on the layout of `struct scm_vm_frame' hold. */ +verify (sizeof (SCM) == sizeof (SCM *)); +verify (sizeof (struct scm_vm_frame) == 5 * sizeof (SCM)); +verify (offsetof (struct scm_vm_frame, dynamic_link) == 0); -#define RELOC(frame, val) (val + SCM_VM_FRAME_OFFSET (frame)) +#define RELOC(frame, val) \ + (((SCM *) (val)) + SCM_VM_FRAME_OFFSET (frame)) SCM scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp, diff --git a/libguile/frames.h b/libguile/frames.h index cae2bd0c0..71d5b124d 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -70,9 +70,10 @@ struct scm_vm_frame SCM stack[1]; /* Variable-length */ }; -#define SCM_FRAME_STRUCT(fp) ((struct scm_vm_frame*)(((SCM*)(fp)) - 4)) +#define SCM_FRAME_STRUCT(fp) \ + ((struct scm_vm_frame *) SCM_FRAME_DATA_ADDRESS (fp)) -#define SCM_FRAME_DATA_ADDRESS(fp) (fp - 4) +#define SCM_FRAME_DATA_ADDRESS(fp) (((SCM *) (fp)) - 4) #define SCM_FRAME_STACK_ADDRESS(fp) (SCM_FRAME_STRUCT (fp)->stack) #define SCM_FRAME_UPPER_ADDRESS(fp) ((SCM*)&SCM_FRAME_STRUCT (fp)->return_address) #define SCM_FRAME_LOWER_ADDRESS(fp) ((SCM*)SCM_FRAME_STRUCT (fp)) @@ -91,7 +92,7 @@ struct scm_vm_frame #define SCM_FRAME_DYNAMIC_LINK(fp) \ (SCM_FRAME_STRUCT (fp)->dynamic_link) #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \ - SCM_FRAME_STRUCT (fp)->dynamic_link = (dl) + SCM_FRAME_DYNAMIC_LINK (fp) = (dl) #define SCM_FRAME_VARIABLE(fp,i) \ (SCM_FRAME_STRUCT (fp)->stack[i]) #define SCM_FRAME_PROGRAM(fp) \ diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 4091afeb9..e6406429e 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. - * +/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006, + * 2008, 2009, 2010, 2011, 2012 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 * as published by the Free Software Foundation; either version 3 of @@ -168,6 +169,8 @@ void scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts_unlocked ("#<hash-table ", port); + scm_uintprint (SCM_UNPACK (exp), 16, port); + scm_putc (' ', port); scm_uintprint (SCM_HASHTABLE_N_ITEMS (exp), 10, port); scm_putc_unlocked ('/', port); scm_uintprint (SCM_SIMPLE_VECTOR_LENGTH (SCM_HASHTABLE_VECTOR (exp)), diff --git a/libguile/random.c b/libguile/random.c index 8bc0d8764..2db19f729 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -653,6 +653,107 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0, } #undef FUNC_NAME +/* Return a new random-state seeded from the time, date, process ID, an + address from a freshly allocated heap cell, an address from the local + stack frame, and a high-resolution timer if available. This is only + to be used as a last resort, when no better source of entropy is + available. */ +static SCM +random_state_of_last_resort (void) +{ + SCM state; + SCM time_of_day = scm_gettimeofday (); + SCM sources = scm_list_n + (scm_from_unsigned_integer (SCM_UNPACK (time_of_day)), /* heap addr */ + scm_getpid (), /* process ID */ + scm_get_internal_real_time (), /* high-resolution process timer */ + scm_from_unsigned_integer ((scm_t_bits) &time_of_day), /* stack addr */ + scm_car (time_of_day), /* seconds since midnight 1970-01-01 UTC */ + scm_cdr (time_of_day), /* microsecond component of the above clock */ + SCM_UNDEFINED); + + /* Concatenate the sources bitwise to form the seed */ + SCM seed = SCM_INUM0; + while (scm_is_pair (sources)) + { + seed = scm_logxor (seed, scm_ash (scm_car (sources), + scm_integer_length (seed))); + sources = scm_cdr (sources); + } + + /* FIXME The following code belongs in `scm_seed_to_random_state', + and here we should simply do: + + return scm_seed_to_random_state (seed); + + Unfortunately, `scm_seed_to_random_state' only preserves around 32 + bits of entropy from the provided seed. I don't know if it's okay + to fix that in 2.0, so for now we have this workaround. */ + { + int i, len; + unsigned char *buf; + len = scm_to_int (scm_ceiling_quotient (scm_integer_length (seed), + SCM_I_MAKINUM (8))); + buf = (unsigned char *) malloc (len); + for (i = len-1; i >= 0; --i) + { + buf[i] = scm_to_int (scm_logand (seed, SCM_I_MAKINUM (255))); + seed = scm_ash (seed, SCM_I_MAKINUM (-8)); + } + state = make_rstate (scm_c_make_rstate ((char *) buf, len)); + free (buf); + } + return state; +} + +/* Attempt to fill buffer with random bytes from /dev/urandom. + Return 1 if successful, else return 0. */ +static int +read_dev_urandom (unsigned char *buf, size_t len) +{ + size_t res = 0; + FILE *f = fopen ("/dev/urandom", "r"); + if (f) + { + res = fread(buf, 1, len, f); + fclose (f); + } + return (res == len); +} + +/* Fill a buffer with random bytes seeded from a platform-specific + source of entropy. /dev/urandom is used if available. Note that + this function provides no guarantees about the amount of entropy + present in the returned bytes. */ +void +scm_i_random_bytes_from_platform (unsigned char *buf, size_t len) +{ + if (read_dev_urandom (buf, len)) + return; + else /* FIXME: support other platform sources */ + { + /* When all else fails, use this (rather weak) fallback */ + SCM random_state = random_state_of_last_resort (); + int i; + for (i = len-1; i >= 0; --i) + buf[i] = scm_to_int (scm_random (SCM_I_MAKINUM (256), random_state)); + } +} + +SCM_DEFINE (scm_random_state_from_platform, "random-state-from-platform", 0, 0, 0, + (void), + "Construct a new random state seeded from a platform-specific\n\ +source of entropy, appropriate for use in non-security-critical applications.") +#define FUNC_NAME s_scm_random_state_from_platform +{ + unsigned char buf[32]; + if (read_dev_urandom (buf, sizeof(buf))) + return make_rstate (scm_c_make_rstate ((char *) buf, sizeof(buf))); + else + return random_state_of_last_resort (); +} +#undef FUNC_NAME + void scm_init_random () { diff --git a/libguile/random.h b/libguile/random.h index 2f1f0f69a..109969e01 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -86,6 +86,7 @@ SCM_API SCM scm_copy_random_state (SCM state); SCM_API SCM scm_seed_to_random_state (SCM seed); SCM_API SCM scm_datum_to_random_state (SCM datum); SCM_API SCM scm_random_state_to_datum (SCM state); +SCM_API SCM scm_random_state_from_platform (void); SCM_API SCM scm_random_uniform (SCM state); SCM_API SCM scm_random_solid_sphere_x (SCM v, SCM state); SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state); @@ -94,6 +95,8 @@ SCM_API SCM scm_random_normal_vector_x (SCM v, SCM state); SCM_API SCM scm_random_exp (SCM state); SCM_INTERNAL void scm_init_random (void); +SCM_INTERNAL void scm_i_random_bytes_from_platform (unsigned char *buf, size_t len); + #endif /* SCM_RANDOM_H */ /* diff --git a/libguile/symbols.c b/libguile/symbols.c index 9cb300ab0..9dd204478 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -33,6 +33,7 @@ #include "libguile/variable.h" #include "libguile/alist.h" #include "libguile/fluids.h" +#include "libguile/threads.h" #include "libguile/strings.h" #include "libguile/vectors.h" #include "libguile/weak-set.h" @@ -378,7 +379,9 @@ SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0, /* The default prefix for `gensym'd symbols. */ static SCM default_gensym_prefix; -#define MAX_PREFIX_LENGTH 30 +#define GENSYM_LENGTH 22 /* bytes */ +#define GENSYM_RADIX_BITS 6 +#define GENSYM_RADIX (1 << (GENSYM_RADIX_BITS)) SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, (SCM prefix), @@ -389,22 +392,47 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, "resetting the counter.") #define FUNC_NAME s_scm_gensym { - static int gensym_counter = 0; - + static const char base64[GENSYM_RADIX] = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$@"; + static const char base4[4] = "_.-~"; + + unsigned char *digit_buf = SCM_I_CURRENT_THREAD->gensym_counter; + char char_buf[GENSYM_LENGTH]; SCM suffix, name; - int n, n_digits; - char buf[SCM_INTBUFLEN]; + int i; if (SCM_UNBNDP (prefix)) prefix = default_gensym_prefix; - /* mutex in case another thread looks and incs at the exact same moment */ - scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); - n = gensym_counter++; - scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); + if (SCM_UNLIKELY (digit_buf == NULL)) + { + /* This is the first time gensym has been called in this thread. + Allocate and randomize our new thread-local gensym counter */ + digit_buf = (unsigned char *) + scm_gc_malloc_pointerless (GENSYM_LENGTH, "gensym-counter"); + scm_i_random_bytes_from_platform (digit_buf, GENSYM_LENGTH); + for (i = (GENSYM_LENGTH - 1); i >= 0; --i) + digit_buf[i] &= (GENSYM_RADIX - 1); + SCM_I_CURRENT_THREAD->gensym_counter = digit_buf; + } + + /* Increment our thread-local gensym_counter. */ + for (i = (GENSYM_LENGTH - 1); i >= 0; --i) + { + if (SCM_LIKELY (++(digit_buf[i]) < GENSYM_RADIX)) + break; + else + digit_buf[i] = 0; + } + + /* Encode digit_buf as base64, except for the first character where we + use the sparse glyphs "_.-~" (base 4) to provide some visual + separation between the prefix and the dense base64 block. */ + for (i = (GENSYM_LENGTH - 1); i > 0; --i) + char_buf[i] = base64[digit_buf[i]]; + char_buf[0] = base4[digit_buf[0] & 3]; - n_digits = scm_iint2str (n, 10, buf); - suffix = scm_from_latin1_stringn (buf, n_digits); + suffix = scm_from_latin1_stringn (char_buf, GENSYM_LENGTH); name = scm_string_append (scm_list_2 (prefix, suffix)); return scm_string_to_symbol (name); } diff --git a/libguile/threads.c b/libguile/threads.c index 463414f4a..df287b1ac 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -544,6 +544,7 @@ guilify_self_1 (struct GC_stack_base *base) t.join_queue = SCM_EOL; t.dynamic_state = SCM_BOOL_F; t.dynwinds = SCM_EOL; + t.gensym_counter = NULL; t.active_asyncs = SCM_EOL; t.block_asyncs = 1; t.pending_asyncs = 1; diff --git a/libguile/threads.h b/libguile/threads.h index 54d64141b..2d2348bde 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -81,6 +81,10 @@ typedef struct scm_i_thread { SCM dynamic_state; SCM dynwinds; + /* Thread-local gensym counter. + */ + unsigned char *gensym_counter; + /* For system asyncs. */ SCM active_asyncs; /* The thunks to be run at the next diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 8981042f8..0804bad5d 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1,5 +1,6 @@ -/* Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc. - * +/* Copyright (C) 2001, 2008, 2009, 2010, 2011, + * 2012 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 * as published by the Free Software Foundation; either version 3 of @@ -19,6 +20,17 @@ /* This file is included in vm_engine.c */ +/* Compiler barrier, to prevent instruction reordering, apparently due + to a bug in GCC 4.3.2 on sparc-linux-gnu and on hppa2.0-linux-gnu. + See <http://bugs.gnu.org/10520>, for details. */ + +#ifdef __GNUC__ +# define COMPILER_BARRIER __asm__ __volatile__ ("") +#else +# define COMPILER_BARRIER do { } while (0) +#endif + + /* * Basic operations @@ -55,6 +67,7 @@ VM_DEFINE_INSTRUCTION (1, halt, "halt", 0, 0, 0) stack */ ip = SCM_FRAME_RETURN_ADDRESS (fp); fp = SCM_FRAME_DYNAMIC_LINK (fp); + COMPILER_BARRIER; NULLSTACK (old_sp - sp); } @@ -1267,6 +1280,7 @@ VM_DEFINE_INSTRUCTION (67, return, "return", 0, 1, 1) sp = SCM_FRAME_LOWER_ADDRESS (fp); ip = SCM_FRAME_RETURN_ADDRESS (fp); fp = SCM_FRAME_DYNAMIC_LINK (fp); + COMPILER_BARRIER; #ifdef VM_ENABLE_STACK_NULLING NULLSTACK (old_sp - sp); @@ -1302,7 +1316,8 @@ VM_DEFINE_INSTRUCTION (68, return_values, "return/values", 1, -1, -1) sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; ip = SCM_FRAME_MV_RETURN_ADDRESS (fp); fp = SCM_FRAME_DYNAMIC_LINK (fp); - + COMPILER_BARRIER; + /* Push return values, and the number of values */ for (i = 0; i < nvalues; i++) *++sp = vals[i+1]; @@ -1322,7 +1337,8 @@ VM_DEFINE_INSTRUCTION (68, return_values, "return/values", 1, -1, -1) sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; ip = SCM_FRAME_RETURN_ADDRESS (fp); fp = SCM_FRAME_DYNAMIC_LINK (fp); - + COMPILER_BARRIER; + /* Push first value */ *++sp = vals[1]; @@ -1713,6 +1729,7 @@ VM_DEFINE_INSTRUCTION (93, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1, NEXT; } +#undef COMPILER_BARRIER /* (defun renumber-ops () diff --git a/libguile/vm.c b/libguile/vm.c index 859658816..e386202ad 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011, 2012 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 @@ -280,7 +280,8 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM intwinds, cp = SCM_VM_CONT_DATA (cont); base = SCM_FRAME_UPPER_ADDRESS (vp->fp) + 1; -#define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base)) +#define RELOC(scm_p) \ + (((SCM *) (scm_p)) + cp->reloc + (base - cp->stack_base)) if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size) scm_misc_error ("vm-engine", |