diff options
author | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 22:33:40 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-09-10 22:33:40 +0200 |
commit | 4a4849dbe0ae1b731b408167f90222e05d1ca2bd (patch) | |
tree | caa909b99ffb221e43408a3d19ad3e8209e3a96b /libguile/srcprop.c | |
parent | 3ec17f28b8f96fa43218db83656c0d85b4f69d7c (diff) | |
parent | 032913739218c756f673bfb9c8f66ef9f8f02330 (diff) | |
download | guile-4a4849dbe0ae1b731b408167f90222e05d1ca2bd.tar.gz |
Merge commit '032913739218c756f673bfb9c8f66ef9f8f02330' into boehm-demers-weiser-gc
Conflicts:
libguile/gc.c
libguile/srcprop.c
libguile/srcprop.h
Diffstat (limited to 'libguile/srcprop.c')
-rw-r--r-- | libguile/srcprop.c | 104 |
1 files changed, 79 insertions, 25 deletions
diff --git a/libguile/srcprop.c b/libguile/srcprop.c index 8b9348e85..e3691d4fb 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -38,7 +38,7 @@ /* {Source Properties} * * Properties of source list expressions. - * Five of these have special meaning and optimized storage: + * Five of these have special meaning: * * filename string The name of the source file. * copy list A copy of the list expression. @@ -56,8 +56,46 @@ SCM_GLOBAL_SYMBOL (scm_sym_line, "line"); SCM_GLOBAL_SYMBOL (scm_sym_column, "column"); SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint"); + + +/* + * Source properties are stored as double cells with the + * following layout: + + * car = tag + * cbr = pos + * ccr = copy + * cdr = plist + */ + +#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p))) +#define SRCPROPBRK(p) (SCM_SMOB_FLAGS (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK) +#define SRCPROPPOS(p) (SCM_CELL_WORD(p,1)) +#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) +#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) +#define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2)) +#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p)) +#define SETSRCPROPBRK(p) \ + (SCM_SET_SMOB_FLAGS ((p), \ + SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK)) +#define CLEARSRCPROPBRK(p) \ + (SCM_SET_SMOB_FLAGS ((p), \ + SCM_SMOB_FLAGS (p) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) +#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) +#define SETSRCPROPPOS(p, l, c) (SCM_SET_CELL_WORD(p,1, SRCPROPMAKPOS (l, c))) +#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) +#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) + + + scm_t_bits scm_tc16_srcprops; +static SCM +srcprops_mark (SCM obj) +{ + scm_gc_mark (SRCPROPCOPY (obj)); + return SRCPROPPLIST (obj); +} static int srcprops_print (SCM obj, SCM port, scm_print_state *pstate) @@ -80,19 +118,45 @@ scm_c_source_property_breakpoint_p (SCM form) } +/* + * We remember the last file name settings, so we can share that plist + * entry. This works because scm_set_source_property_x does not use + * assoc-set! for modifying the plist. + * + * This variable contains a protected cons, whose cdr is the cached + * plist + */ +static SCM scm_last_plist_filename; + SCM scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist) { - register scm_t_srcprops *ptr; - - ptr = scm_gc_malloc (sizeof (*ptr), "srcprop"); - - ptr->pos = SRCPROPMAKPOS (line, col); - ptr->fname = filename; - ptr->copy = copy; - ptr->plist = plist; + if (!SCM_UNBNDP (filename)) + { + SCM old_plist = plist; - SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr); + /* + have to extract the acons, and operate on that, for + thread safety. + */ + SCM last_acons = SCM_CDR (scm_last_plist_filename); + if (old_plist == SCM_EOL + && SCM_CDAR (last_acons) == filename) + { + plist = last_acons; + } + else + { + plist = scm_acons (scm_sym_filename, filename, plist); + if (old_plist == SCM_EOL) + SCM_SETCDR (scm_last_plist_filename, plist); + } + } + + SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops, + SRCPROPMAKPOS (line, col), + copy, + plist); } @@ -102,8 +166,6 @@ scm_srcprops_to_plist (SCM obj) SCM plist = SRCPROPPLIST (obj); if (!SCM_UNBNDP (SRCPROPCOPY (obj))) plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist); - if (!SCM_UNBNDP (SRCPROPFNAME (obj))) - plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist); plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist); plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); @@ -168,7 +230,6 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, if (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); else if (scm_is_eq (scm_sym_line, key)) p = scm_from_int (SRCPROPLINE (p)); else if (scm_is_eq (scm_sym_column, key)) p = scm_from_int (SRCPROPCOL (p)); - else if (scm_is_eq (scm_sym_filename, key)) p = SRCPROPFNAME (p); else if (scm_is_eq (scm_sym_copy, key)) p = SRCPROPCOPY (p); else { @@ -239,13 +300,6 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_make_srcprops (0, scm_to_int (datum), SCM_UNDEFINED, SCM_UNDEFINED, p)); } - else if (scm_is_eq (scm_sym_filename, key)) - { - if (SRCPROPSP (p)) - SRCPROPFNAME (p) = datum; - else - SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p)); - } else if (scm_is_eq (scm_sym_copy, key)) { if (SRCPROPSP (p)) @@ -269,19 +323,19 @@ void scm_init_srcprop () { scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0); + scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark); scm_set_smob_print (scm_tc16_srcprops, srcprops_print); scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047)); scm_c_define ("source-whash", scm_source_whash); + scm_last_plist_filename + = scm_permanent_object (scm_cons (SCM_EOL, + scm_acons (SCM_EOL, SCM_EOL, SCM_EOL))); + #include "libguile/srcprop.x" } -void -scm_finish_srcprop () -{ - /* Nothing to do. */ -} /* Local Variables: |