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 = \
-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@
}
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. */
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);
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);
}
#include <errno.h>
#include <fcntl.h> /* for chsize on mingw */
#include <assert.h>
+ #include <uniconv.h>
+ #include <unistr.h>
+ #include <striconveh.h>
+#include <assert.h>
+
#include "libguile/_scm.h"
#include "libguile/async.h"
#include "libguile/eval.h"
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 ("#<charset-cursor ", port);
+ if (cur->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
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"
}
#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"
\f
}
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:
;
HCoop / bpt / guile.git / commitdiff