diff options
Diffstat (limited to 'libguile/srcprop.c')
-rw-r--r-- | libguile/srcprop.c | 142 |
1 files changed, 50 insertions, 92 deletions
diff --git a/libguile/srcprop.c b/libguile/srcprop.c index b644a32a5..4c2a77b54 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -1,4 +1,4 @@ -/* Copyright 1995-2002,2006,2008-2012,2018 +/* Copyright 1995-2002,2006,2008-2012,2018,2020 Free Software Foundation, Inc. This file is part of Guile. @@ -51,19 +51,17 @@ /* {Source Properties} * * Properties of source list expressions. - * Four of these have special meaning: + * Three of these have special meaning: * - * filename string The name of the source file. - * copy list A copy of the list expression. - * line integer The source code line number. - * column integer The source code column number. + * filename The name of the source file. + * line The source code line number. + * column The source code column number. * * Most properties above can be set by the reader. * */ SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename"); -SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy"); SCM_GLOBAL_SYMBOL (scm_sym_line, "line"); SCM_GLOBAL_SYMBOL (scm_sym_column, "column"); @@ -74,30 +72,27 @@ static SCM scm_source_whash; * Source properties are stored as double cells with the * following layout: - * car = tag - * cbr = pos - * ccr = copy + * car = tag | col (untagged) + * cbr = line + * ccr = filename * cdr = alist */ -#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p))) -#define SRCPROPPOS(p) (SCM_SMOB_DATA(p)) -#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) -#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) -#define SRCPROPCOPY(p) (SCM_SMOB_OBJECT_2(p)) -#define SRCPROPALIST(p) (SCM_SMOB_OBJECT_3(p)) -#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) -#define SETSRCPROPPOS(p, l, c) (SCM_SET_SMOB_DATA_1 (p, SRCPROPMAKPOS (l, c))) -#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) -#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) -#define SETSRCPROPCOPY(p, c) (SCM_SET_SMOB_OBJECT_2 (p, c)) -#define SETSRCPROPALIST(p, l) (SCM_SET_SMOB_OBJECT_3 (p, l)) +static scm_t_bits tc16_srcprops; +#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (tc16_srcprops, (p))) +#define SRCPROPCOL(p) (scm_from_int (SCM_SMOB_FLAGS (p))) +#define SRCPROPLINE(p) (SCM_SMOB_OBJECT_1 (p)) +#define SRCPROPFNAME(p) (SCM_SMOB_OBJECT_2 (p)) +#define SRCPROPALIST(p) (SCM_SMOB_OBJECT_3 (p)) +#define SETSRCPROPCOL(p, c) (SCM_SET_SMOB_FLAGS (p, scm_to_int (c))) +#define SETSRCPROPLINE(p, l) (SCM_SET_SMOB_OBJECT_1 (p, l)) +#define SETSRCPROPFNAME(p, x) (SCM_SET_SMOB_OBJECT_2 (p, x)) +#define SETSRCPROPALIST(p, x) (SCM_SET_SMOB_OBJECT_3 (p, x)) -static SCM scm_srcprops_to_alist (SCM obj); +static SCM scm_srcprops_to_alist (SCM obj); -scm_t_bits scm_tc16_srcprops; static int @@ -120,56 +115,23 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate) } -/* - * We remember the last file name settings, so we can share that alist - * entry. This works because scm_set_source_property_x does not use - * assoc-set! for modifying the alist. - * - * This variable contains a protected cons, whose cdr is the cached - * alist - */ -static SCM scm_last_alist_filename; - SCM -scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist) +scm_i_make_srcprops (SCM line, SCM col, SCM filename, SCM alist) { - if (!SCM_UNBNDP (filename)) - { - SCM old_alist = alist; - - /* - have to extract the acons, and operate on that, for - thread safety. - */ - SCM last_acons = SCM_CDR (scm_last_alist_filename); - if (scm_is_null (old_alist) - && scm_is_eq (SCM_CDAR (last_acons), filename)) - { - alist = last_acons; - } - else - { - alist = scm_acons (scm_sym_filename, filename, alist); - if (scm_is_null (old_alist)) - scm_set_cdr_x (scm_last_alist_filename, alist); - } - } - - SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops, - SRCPROPMAKPOS (line, col), - SCM_UNPACK (copy), - SCM_UNPACK (alist)); + SCM_RETURN_NEWSMOB3 (tc16_srcprops | (scm_to_int (col) << 16), + SCM_UNPACK (line), + SCM_UNPACK (filename), + SCM_UNPACK (alist)); } - static SCM scm_srcprops_to_alist (SCM obj) { SCM alist = SRCPROPALIST (obj); - if (!SCM_UNBNDP (SRCPROPCOPY (obj))) - alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist); - alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist); - alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist); + if (scm_is_true (SRCPROPFNAME (obj))) + alist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), alist); + alist = scm_acons (scm_sym_column, SRCPROPCOL (obj), alist); + alist = scm_acons (scm_sym_line, SRCPROPLINE (obj), alist); return alist; } @@ -235,17 +197,13 @@ scm_i_has_source_properties (SCM obj) void -scm_i_set_source_properties_x (SCM obj, long line, int col, SCM fname) +scm_i_set_source_properties_x (SCM obj, SCM line, SCM col, SCM fname) #define FUNC_NAME "%set-source-properties" { SCM_VALIDATE_NIM (1, obj); scm_weak_table_putq_x (scm_source_whash, obj, - scm_make_srcprops (line, col, fname, - SCM_COPY_SOURCE_P - ? scm_copy_tree (obj) - : SCM_UNDEFINED, - SCM_EOL)); + scm_i_make_srcprops (line, col, fname, SCM_EOL)); } #undef FUNC_NAME @@ -265,11 +223,11 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, if (!SRCPROPSP (p)) goto alist; if (scm_is_eq (scm_sym_line, key)) - return scm_from_int (SRCPROPLINE (p)); + return SRCPROPLINE (p); else if (scm_is_eq (scm_sym_column, key)) - return scm_from_int (SRCPROPCOL (p)); - else if (scm_is_eq (scm_sym_copy, key)) - return SRCPROPCOPY (p); + return SRCPROPCOL (p); + else if (scm_is_eq (scm_sym_filename, key)) + return SRCPROPFNAME (p); else { p = SRCPROPALIST (p); @@ -280,6 +238,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, } #undef FUNC_NAME +static scm_i_pthread_mutex_t source_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; + SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, (SCM obj, SCM key, SCM datum), "Set the source property of object @var{obj}, which is specified by\n" @@ -289,34 +249,35 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, SCM p; SCM_VALIDATE_NIM (1, obj); - scm_i_pthread_mutex_lock (&scm_i_misc_mutex); + scm_i_pthread_mutex_lock (&source_mutex); p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); if (scm_is_eq (scm_sym_line, key)) { if (SRCPROPSP (p)) - SETSRCPROPLINE (p, scm_to_int (datum)); + SETSRCPROPLINE (p, datum); else scm_weak_table_putq_x (scm_source_whash, obj, - scm_make_srcprops (scm_to_int (datum), 0, - SCM_UNDEFINED, SCM_UNDEFINED, p)); + scm_i_make_srcprops (datum, SCM_INUM0, + SCM_BOOL_F, p)); } else if (scm_is_eq (scm_sym_column, key)) { if (SRCPROPSP (p)) - SETSRCPROPCOL (p, scm_to_int (datum)); + SETSRCPROPCOL (p, datum); else scm_weak_table_putq_x (scm_source_whash, obj, - scm_make_srcprops (0, scm_to_int (datum), - SCM_UNDEFINED, SCM_UNDEFINED, p)); + scm_i_make_srcprops (SCM_INUM0, datum, + SCM_BOOL_F, p)); } - else if (scm_is_eq (scm_sym_copy, key)) + else if (scm_is_eq (scm_sym_filename, key)) { if (SRCPROPSP (p)) - SETSRCPROPCOPY (p, datum); + SETSRCPROPFNAME (p, datum); else scm_weak_table_putq_x (scm_source_whash, obj, - scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p)); + scm_i_make_srcprops (SCM_INUM0, SCM_INUM0, + datum, p)); } else { @@ -326,7 +287,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0, scm_weak_table_putq_x (scm_source_whash, obj, scm_acons (key, datum, p)); } - scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); + scm_i_pthread_mutex_unlock (&source_mutex); return SCM_UNSPECIFIED; } @@ -354,15 +315,12 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0, void scm_init_srcprop () { - scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0); - scm_set_smob_print (scm_tc16_srcprops, srcprops_print); + tc16_srcprops = scm_make_smob_type ("srcprops", 0); + scm_set_smob_print (tc16_srcprops, srcprops_print); scm_source_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); scm_c_define ("source-whash", scm_source_whash); - scm_last_alist_filename = scm_cons (SCM_EOL, - scm_acons (SCM_EOL, SCM_EOL, SCM_EOL)); - #include "srcprop.x" } |