From: Ludovic Courtès Date: Fri, 28 Aug 2009 17:01:19 +0000 (+0200) Subject: Merge branch 'master' into boehm-demers-weiser-gc X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/7af531508c5931261ff8957708642cac67bf86a5 Merge branch 'master' into boehm-demers-weiser-gc Conflicts: libguile/Makefile.am libguile/bytevectors.c libguile/gc-card.c libguile/gc-mark.c libguile/programs.c libguile/srcprop.c libguile/srfi-14.c libguile/symbols.c libguile/threads.c libguile/unif.c libguile/vm.c --- 7af531508c5931261ff8957708642cac67bf86a5 diff --cc libguile/Makefile.am index f000f8332,d4d1a549f..046ce21cc --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@@ -105,26 -105,109 +105,103 @@@ guile_LDFLAGS = $(GUILE_CFLAGS libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) - libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ - bytevectors.c chars.c continuations.c \ - convert.c debug.c deprecation.c \ - deprecated.c discouraged.c dynwind.c eq.c error.c \ - eval.c evalext.c extensions.c feature.c fluids.c fports.c \ - futures.c gc.c gc-malloc.c \ - gdbint.c gettext.c goops.c gsubr.c \ - guardians.c hash.c hashtab.c hooks.c init.c inline.c \ - ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c \ - modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c \ - print.c procprop.c procs.c properties.c \ - r6rs-ports.c random.c rdelim.c read.c \ - root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c \ - stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c \ - strorder.c strports.c struct.c symbols.c threads.c null-threads.c \ - throw.c values.c variable.c vectors.c version.c vports.c weaks.c \ - ramap.c unif.c - - # vm-related sources - libguile_la_SOURCES += frames.c instructions.c objcodes.c programs.c vm.c + libguile_la_SOURCES = \ + alist.c \ + arbiters.c \ + array-handle.c \ + array-map.c \ + arrays.c \ + async.c \ + backtrace.c \ + boolean.c \ + bitvectors.c \ + bytevectors.c \ + chars.c \ + continuations.c \ + debug.c \ + deprecated.c \ + deprecation.c \ + discouraged.c \ + dynwind.c \ + eq.c \ + error.c \ + eval.c \ + evalext.c \ + extensions.c \ + feature.c \ + fluids.c \ + fports.c \ + frames.c \ + futures.c \ - gc-card.c \ - gc-freelist.c \ + gc-malloc.c \ - gc-mark.c \ - gc-segment-table.c \ - gc-segment.c \ + gc.c \ - gc_os_dep.c \ + gdbint.c \ + gettext.c \ + generalized-arrays.c \ + generalized-vectors.c \ + goops.c \ + gsubr.c \ + guardians.c \ + hash.c \ + hashtab.c \ + hooks.c \ + init.c \ + inline.c \ + instructions.c \ + ioext.c \ + keywords.c \ + lang.c \ + list.c \ + load.c \ + macros.c \ + mallocs.c \ + modules.c \ + null-threads.c \ + numbers.c \ + objcodes.c \ + objects.c \ + objprop.c \ + options.c \ + pairs.c \ + ports.c \ + print.c \ + procprop.c \ + procs.c \ + programs.c \ + properties.c \ + r6rs-ports.c \ + random.c \ + rdelim.c \ + read.c \ + root.c \ + rw.c \ + scmsigs.c \ + script.c \ + simpos.c \ + smob.c \ + sort.c \ + srcprop.c \ + srfi-13.c \ + srfi-14.c \ + srfi-4.c \ + stackchk.c \ + stacks.c \ + stime.c \ + strings.c \ + strorder.c \ + strports.c \ + struct.c \ + symbols.c \ + threads.c \ + throw.c \ + uniform.c \ + values.c \ + variable.c \ + vectors.c \ + version.c \ + vm.c \ + vports.c \ + weaks.c libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS = \ @@@ -135,46 -218,202 +212,194 @@@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_l -module -L$(builddir) -lguile \ -version-info @LIBGUILE_I18N_INTERFACE@ - DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x \ - bytevectors.x chars.x \ - continuations.x debug.x deprecation.x deprecated.x discouraged.x \ - dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x \ - extensions.x feature.x fluids.x fports.x futures.x gc.x \ - gettext.x goops.x gsubr.x guardians.x \ - hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \ - list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \ - objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \ - properties.x r6rs-ports.x random.x rdelim.x \ - read.x root.x rw.x scmsigs.x \ - script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x \ - stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x \ - strports.x struct.x symbols.x threads.x throw.x values.x \ - variable.x vectors.x version.x vports.x weaks.x ramap.x unif.x + DOT_X_FILES = \ + alist.x \ + arbiters.x \ + array-handle.x \ + array-map.x \ + arrays.x \ + async.x \ + backtrace.x \ + boolean.x \ + bitvectors.x \ + bytevectors.x \ + chars.x \ + continuations.x \ + debug.x \ + deprecated.x \ + deprecation.x \ + discouraged.x \ + dynl.x \ + dynwind.x \ + eq.x \ + error.x \ + eval.x \ + evalext.x \ + extensions.x \ + feature.x \ + fluids.x \ + fports.x \ + futures.x \ - gc-card.x \ + gc-malloc.x \ - gc-mark.x \ - gc-segment-table.x \ - gc-segment.x \ + gc.x \ + gettext.x \ + generalized-arrays.x \ + generalized-vectors.x \ + goops.x \ + gsubr.x \ + guardians.x \ + hash.x \ + hashtab.x \ + hooks.x \ + i18n.x \ + init.x \ + ioext.x \ + keywords.x \ + lang.x \ + list.x \ + load.x \ + macros.x \ + mallocs.x \ + modules.x \ + numbers.x \ + objects.x \ + objprop.x \ + options.x \ + pairs.x \ + ports.x \ + print.x \ + procprop.x \ + procs.x \ + properties.x \ + r6rs-ports.x \ + random.x \ + rdelim.x \ + read.x \ + root.x \ + rw.x \ + scmsigs.x \ + script.x \ + simpos.x \ + smob.x \ + sort.x \ + srcprop.x \ + srfi-13.x \ + srfi-14.x \ + srfi-4.x \ + stackchk.x \ + stacks.x \ + stime.x \ + strings.x \ + strorder.x \ + strports.x \ + struct.x \ + symbols.x \ + threads.x \ + throw.x \ + uniform.x \ + values.x \ + variable.x \ + vectors.x \ + version.x \ + vports.x \ + weaks.x # vm-related snarfs DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@ - DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ - boolean.doc bytevectors.doc chars.doc \ - continuations.doc debug.doc deprecation.doc \ - deprecated.doc discouraged.doc dynl.doc dynwind.doc \ - eq.doc error.doc eval.doc evalext.doc \ - extensions.doc feature.doc fluids.doc fports.doc futures.doc \ - gc.doc goops.doc gsubr.doc \ - gc-malloc.doc gettext.doc guardians.doc hash.doc hashtab.doc \ - hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \ - list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \ - objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc \ - procprop.doc procs.doc properties.doc r6rs-ports.doc \ - random.doc rdelim.doc \ - read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc \ - smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc \ - strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc \ - strports.doc struct.doc symbols.doc threads.doc throw.doc \ - values.doc variable.doc vectors.doc version.doc vports.doc \ - weaks.doc ramap.doc unif.doc + DOT_DOC_FILES = \ + alist.doc \ + arbiters.doc \ + array-handle.doc \ + array-map.doc \ + arrays.doc \ + async.doc \ + backtrace.doc \ + boolean.doc \ + bitvectors.doc \ + bytevectors.doc \ + chars.doc \ + continuations.doc \ + debug.doc \ + deprecated.doc \ + deprecation.doc \ + discouraged.doc \ + dynl.doc \ + dynwind.doc \ + eq.doc \ + error.doc \ + eval.doc \ + evalext.doc \ + extensions.doc \ + feature.doc \ + fluids.doc \ + fports.doc \ + futures.doc \ - gc-card.doc \ + gc-malloc.doc \ - gc-mark.doc \ - gc-segment-table.doc \ - gc-segment.doc \ + gc.doc \ + gettext.doc \ + generalized-arrays.doc \ + generalized-vectors.doc \ + goops.doc \ + gsubr.doc \ + guardians.doc \ + hash.doc \ + hashtab.doc \ + hooks.doc \ + i18n.doc \ + init.doc \ + ioext.doc \ + keywords.doc \ + lang.doc \ + list.doc \ + load.doc \ + macros.doc \ + mallocs.doc \ + modules.doc \ + numbers.doc \ + objects.doc \ + objprop.doc \ + options.doc \ + pairs.doc \ + ports.doc \ + print.doc \ + procprop.doc \ + procs.doc \ + properties.doc \ + r6rs-ports.doc \ + random.doc \ + rdelim.doc \ + read.doc \ + root.doc \ + rw.doc \ + scmsigs.doc \ + script.doc \ + simpos.doc \ + smob.doc \ + sort.doc \ + srcprop.doc \ + srfi-13.doc \ + srfi-14.doc \ + srfi-4.doc \ + stackchk.doc \ + stacks.doc \ + stime.doc \ + strings.doc \ + strorder.doc \ + strports.doc \ + struct.doc \ + symbols.doc \ + threads.doc \ + throw.doc \ + uniform.doc \ + values.doc \ + variable.doc \ + vectors.doc \ + version.doc \ + vports.doc \ + weaks.doc EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@ diff --cc libguile/bytevectors.c index 5b79a1435,9c2b11910..b2e5ec9b0 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@@ -192,24 -229,33 +229,33 @@@ make_bytevector_from_buffer (size_t len } static inline SCM - make_bytevector (size_t len) + make_bytevector (size_t len, scm_t_array_element_type element_type) { - SCM bv; + size_t c_len; - if (SCM_UNLIKELY (len == 0)) - bv = scm_null_bytevector; + if (SCM_UNLIKELY (len == 0 && element_type == 0)) + return scm_null_bytevector; + else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST + || scm_i_array_element_type_sizes[element_type] < 8 + || len >= (SCM_I_SIZE_MAX + / (scm_i_array_element_type_sizes[element_type]/8)))) + /* This would be an internal Guile programming error */ + abort (); + + c_len = len * (scm_i_array_element_type_sizes[element_type]/8); + if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len)) + { + SCM ret; + SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL); + SCM_BYTEVECTOR_SET_INLINE (ret); + SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type); + return ret; + } else { - signed char *contents = NULL; - - if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)) - contents = (signed char *) - scm_gc_malloc_pointerless (len, SCM_GC_BYTEVECTOR); - - bv = make_bytevector_from_buffer (len, contents); - void *buf = scm_gc_malloc (c_len, SCM_GC_BYTEVECTOR); ++ void *buf = scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR); + return make_bytevector_from_buffer (len, buf, element_type); } - - return bv; } /* Return a new bytevector of size LEN octets. */ @@@ -1877,18 -1946,8 +1927,19 @@@ utf_encoding_name (char *name, size_t u scm_syserror_msg (FUNC_NAME, "failed to convert string: ~A", \ scm_list_1 (str), err); \ else \ - /* C_UTF is null-terminated. */ \ - utf = scm_c_take_bytevector ((signed char *) c_utf, c_utf_len); \ + { \ + /* C_UTF is null-terminated. It is malloc(3)-allocated, so we cannot \ + use `scm_c_take_bytevector ()'. */ \ + scm_dynwind_begin (0); \ + scm_dynwind_free (c_utf); \ + \ - utf = make_bytevector (c_utf_len); \ ++ utf = make_bytevector (c_utf_len, \ ++ SCM_ARRAY_ELEMENT_TYPE_VU8); \ + memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, \ + c_utf_len); \ + \ + scm_dynwind_end (); \ + } \ \ return (utf); @@@ -1922,18 -1981,9 +1973,19 @@@ SCM_DEFINE (scm_string_to_utf8, "string if (SCM_UNLIKELY (c_utf == NULL)) scm_syserror (FUNC_NAME); else - /* C_UTF is null-terminated. */ - utf = scm_c_take_bytevector ((signed char *) c_utf, - UTF_STRLEN (8, c_utf)); + { + /* C_UTF is null-terminated. It is malloc(3)-allocated, so we cannot + use `scm_c_take_bytevector ()'. */ + scm_dynwind_begin (0); + scm_dynwind_free (c_utf); + - utf = make_bytevector (UTF_STRLEN (8, c_utf)); ++ utf = make_bytevector (UTF_STRLEN (8, c_utf), ++ SCM_ARRAY_ELEMENT_TYPE_VU8); + memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, + UTF_STRLEN (8, c_utf)); + + scm_dynwind_end (); + } return (utf); } diff --cc libguile/ports.c index 2d0e26b39,b3547f5cd..e3d2b0da6 --- a/libguile/ports.c +++ b/libguile/ports.c @@@ -30,9 -30,10 +30,12 @@@ #include #include /* for chsize on mingw */ #include + #include + #include + #include +#include + #include "libguile/_scm.h" #include "libguile/async.h" #include "libguile/eval.h" diff --cc libguile/srfi-14.c index 0d614f6d9,7ab65ac97..7c0013193 --- a/libguile/srfi-14.c +++ b/libguile/srfi-14.c @@@ -67,7 -498,67 +498,28 @@@ charset_print (SCM charset, SCM port, s return 1; } - -/* Smob free hook for character sets. */ -static size_t -charset_free (SCM charset) -{ - scm_t_char_set *cs; - size_t len = 0; - - cs = SCM_CHARSET_DATA (charset); - if (cs != NULL) - len = cs->len; - if (len > 0) - scm_gc_free (cs->ranges, sizeof (scm_t_char_range) * len, - "character-set"); - - cs->ranges = NULL; - cs->len = 0; - - scm_gc_free (cs, sizeof (scm_t_char_set), "character-set"); - - scm_remember_upto_here_1 (charset); - - return 0; -} - - + /* Smob print hook for character sets cursors. */ + static int + charset_cursor_print (SCM cursor, SCM port, + scm_print_state *pstate SCM_UNUSED) + { + scm_t_char_set_cursor *cur; + + cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor); + + scm_puts ("#range == (size_t) (-1)) + scm_puts ("(empty)", port); + else + { + scm_write (scm_from_size_t (cur->range), port); + scm_puts (":", port); + scm_write (scm_from_int32 (cur->n), port); + } + scm_puts (">", port); + return 1; + } -/* Smob free hook for character sets. */ -static size_t -charset_cursor_free (SCM charset) -{ - scm_t_char_set_cursor *cur; - - cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (charset); - scm_gc_free (cur, sizeof (scm_t_char_set_cursor), "charset-cursor"); - scm_remember_upto_here_1 (charset); - - return 0; -} - /* Create a new, empty character set. */ static SCM @@@ -1536,29 -1946,39 +1907,37 @@@ SCM_DEFINE (scm_debug_char_set, "debug- void scm_init_srfi_14 (void) { - scm_tc16_charset = scm_make_smob_type ("character-set", - BYTES_PER_CHARSET); + scm_tc16_charset = scm_make_smob_type ("character-set", 0); - scm_set_smob_free (scm_tc16_charset, charset_free); scm_set_smob_print (scm_tc16_charset, charset_print); - scm_char_set_upper_case = define_charset ("char-set:upper-case"); - scm_char_set_lower_case = define_charset ("char-set:lower-case"); - scm_char_set_title_case = define_charset ("char-set:title-case"); - scm_char_set_letter = define_charset ("char-set:letter"); - scm_char_set_digit = define_charset ("char-set:digit"); - scm_char_set_letter_and_digit = define_charset ("char-set:letter+digit"); - scm_char_set_graphic = define_charset ("char-set:graphic"); - scm_char_set_printing = define_charset ("char-set:printing"); - scm_char_set_whitespace = define_charset ("char-set:whitespace"); - scm_char_set_iso_control = define_charset ("char-set:iso-control"); - scm_char_set_punctuation = define_charset ("char-set:punctuation"); - scm_char_set_symbol = define_charset ("char-set:symbol"); - scm_char_set_hex_digit = define_charset ("char-set:hex-digit"); - scm_char_set_blank = define_charset ("char-set:blank"); - scm_char_set_ascii = define_charset ("char-set:ascii"); - scm_char_set_empty = define_charset ("char-set:empty"); - scm_char_set_full = define_charset ("char-set:full"); - - scm_srfi_14_compute_char_sets (); + scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0); - scm_set_smob_free (scm_tc16_charset_cursor, charset_cursor_free); + scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print); + + scm_char_set_upper_case = + define_charset ("char-set:upper-case", &cs_upper_case); + scm_char_set_lower_case = + define_charset ("char-set:lower-case", &cs_lower_case); + scm_char_set_title_case = + define_charset ("char-set:title-case", &cs_title_case); + scm_char_set_letter = define_charset ("char-set:letter", &cs_letter); + scm_char_set_digit = define_charset ("char-set:digit", &cs_digit); + scm_char_set_letter_and_digit = + define_charset ("char-set:letter+digit", &cs_letter_plus_digit); + scm_char_set_graphic = define_charset ("char-set:graphic", &cs_graphic); + scm_char_set_printing = define_charset ("char-set:printing", &cs_printing); + scm_char_set_whitespace = + define_charset ("char-set:whitespace", &cs_whitespace); + scm_char_set_iso_control = + define_charset ("char-set:iso-control", &cs_iso_control); + scm_char_set_punctuation = + define_charset ("char-set:punctuation", &cs_punctuation); + scm_char_set_symbol = define_charset ("char-set:symbol", &cs_symbol); + scm_char_set_hex_digit = + define_charset ("char-set:hex-digit", &cs_hex_digit); + scm_char_set_blank = define_charset ("char-set:blank", &cs_blank); + scm_char_set_ascii = define_charset ("char-set:ascii", &cs_ascii); + scm_char_set_empty = define_charset ("char-set:empty", &cs_empty); + scm_char_set_full = define_charset ("char-set:full", &cs_full); #include "libguile/srfi-14.x" } diff --cc libguile/strings.c index 8aa1e6622,4a8390d16..dfa069095 --- a/libguile/strings.c +++ b/libguile/strings.c @@@ -32,8 -34,10 +34,9 @@@ #include "libguile/chars.h" #include "libguile/root.h" #include "libguile/strings.h" + #include "libguile/generalized-vectors.h" #include "libguile/deprecation.h" #include "libguile/validate.h" -#include "libguile/dynwind.h" diff --cc libguile/symbols.c index 6faac61ff,a9320163a..c77749f11 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@@ -89,60 -89,49 +89,79 @@@ scm_i_hash_symbol (SCM obj, unsigned lo } static SCM - lookup_interned_symbol (const char *name, size_t len, - unsigned long raw_hash) + lookup_interned_symbol (SCM name, unsigned long raw_hash) { /* Try to find the symbol in the symbols table */ - SCM l; - size_t len = scm_i_string_length (name); + SCM result = SCM_BOOL_F; + SCM bucket, elt, previous_elt; ++ size_t len; unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols); - for (l = SCM_HASHTABLE_BUCKET (symbols, hash); - !scm_is_null (l); - l = SCM_CDR (l)) ++ len = scm_i_string_length (name); + bucket = SCM_HASHTABLE_BUCKET (symbols, hash); ++ + for (elt = bucket, previous_elt = SCM_BOOL_F; + !scm_is_null (elt); + previous_elt = elt, elt = SCM_CDR (elt)) { - SCM sym = SCM_CAAR (l); + SCM pair, sym; + + pair = SCM_CAR (elt); + if (!scm_is_pair (pair)) + abort (); + + if (SCM_WEAK_PAIR_CAR_DELETED_P (pair)) + { + /* PAIR is a weak pair whose key got nullified: remove it from + BUCKET. */ + /* FIXME: Since this is done lazily, i.e., only when a new symbol + is to be inserted in a bucket containing deleted symbols, the + number of items in the hash table may remain erroneous for some + time, thus precluding proper rehashing. */ + if (previous_elt != SCM_BOOL_F) + SCM_SETCDR (previous_elt, SCM_CDR (elt)); + else + bucket = SCM_CDR (elt); + + SCM_HASHTABLE_DECREMENT (symbols); + continue; + } + + sym = SCM_CAR (pair); + if (scm_i_symbol_hash (sym) == raw_hash && scm_i_symbol_length (sym) == len) { - const char *chrs = scm_i_symbol_chars (sym); - size_t i = len; - - while (i != 0) - { - --i; - if (name[i] != chrs[i]) - goto next_symbol; - } + size_t i = len; + + /* Slightly faster path for comparing narrow to narrow. */ + if (scm_i_is_narrow_string (name) && scm_i_is_narrow_symbol (sym)) + { + const char *chrs = scm_i_symbol_chars (sym); + const char *str = scm_i_string_chars (name); + + while (i != 0) + { + --i; + if (str[i] != chrs[i]) + goto next_symbol; + } + } + else + { + /* Somewhat slower path for comparing narrow to wide or + wide to wide. */ + while (i != 0) + { + --i; + if (scm_i_string_ref (name, i) != scm_i_symbol_ref (sym, i)) + goto next_symbol; + } + } - return sym; + /* We found it. */ + result = sym; + break; } next_symbol: ;