From 6f6abb3bb57e54444fd68ebcd451032fb5ce19c0 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 3 Sep 2020 22:55:08 +0200 Subject: [PATCH] Clean up srcprops implementation * libguile/deprecated.c (scm_sym_copy, scm_make_srcprops): Deprecate. * libguile/deprecated.h (scm_tc16_srcprops) (SCM_SOURCE_PROPERTY_FLAG_BREAK): Deprecate. * libguile/private-options.h (SCM_COPY_SOURCE_P): Remove. * libguile/read.c (struct t_read_opts, scm_read_options): Remove useless copy read option. (maybe_annotate_source): Change line and column to be tagged, and subtract off lookahead here. Change all callers. (READ_OPTION_COPY_SOURCE_P): Remove, renumbering other options. (init_read_options): Remove copy option. * libguile/srcprop.c: Change to put filename inline in source properties. Update private implementation. * libguile/srcprop.h (SCM_PROCTRACEP): Remove. Unusable given that scm_sym_trace was undefined. --- libguile/deprecated.c | 17 +++++ libguile/deprecated.h | 7 ++ libguile/private-options.h | 21 +++--- libguile/read.c | 100 +++++++++++++------------- libguile/srcprop.c | 142 +++++++++++++------------------------ libguile/srcprop.h | 13 ++-- 6 files changed, 137 insertions(+), 163 deletions(-) diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 1cdc9dfac..0b9ce3558 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -27,13 +27,17 @@ #define SCM_BUILDING_DEPRECATED_CODE +#include "alist.h" #include "boolean.h" #include "bitvectors.h" #include "deprecation.h" #include "gc.h" #include "gsubr.h" +#include "procprop.h" +#include "srcprop.h" #include "srfi-4.h" #include "strings.h" +#include "symbols.h" #include "deprecated.h" @@ -569,6 +573,19 @@ scm_istr2bve (SCM str) return res; } +SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy"); + +SCM +scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist) +{ + scm_c_issue_deprecation_warning + ("scm_make_srcprops is deprecated; use set-source-properties! instead"); + + alist = SCM_UNBNDP (copy) ? alist : scm_acons (scm_sym_copy, copy, alist); + return scm_i_make_srcprops (scm_from_long (line), scm_from_int (col), + filename, alist); +} + diff --git a/libguile/deprecated.h b/libguile/deprecated.h index 81ec7b073..c78e2b1a4 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -131,6 +131,13 @@ SCM_DEPRECATED SCM scm_bit_position (SCM item, SCM v, SCM k); SCM_DEPRECATED SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj); SCM_DEPRECATED SCM scm_istr2bve (SCM str); +#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1 + +SCM_DEPRECATED scm_t_bits scm_tc16_srcprops; +SCM_DEPRECATED SCM scm_sym_copy; +SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename, + SCM copy, SCM alist); + void scm_i_init_deprecated (void); #endif diff --git a/libguile/private-options.h b/libguile/private-options.h index 3580c5367..31f4c0ee4 100644 --- a/libguile/private-options.h +++ b/libguile/private-options.h @@ -1,4 +1,4 @@ -/* Copyright 2007,2009-2011,2014,2018 +/* Copyright 2007,2009-2011,2014,2018,2020 Free Software Foundation, Inc. This file is part of Guile. @@ -56,16 +56,15 @@ SCM_INTERNAL scm_t_option scm_print_opts[]; */ SCM_INTERNAL scm_t_option scm_read_opts[]; -#define SCM_COPY_SOURCE_P scm_read_opts[0].val -#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val -#define SCM_CASE_INSENSITIVE_P scm_read_opts[2].val -#define SCM_KEYWORD_STYLE scm_read_opts[3].val -#define SCM_R6RS_ESCAPES_P scm_read_opts[4].val -#define SCM_SQUARE_BRACKETS_P scm_read_opts[5].val -#define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[6].val -#define SCM_CURLY_INFIX_P scm_read_opts[7].val -#define SCM_R7RS_SYMBOLS_P scm_read_opts[8].val +#define SCM_RECORD_POSITIONS_P scm_read_opts[0].val +#define SCM_CASE_INSENSITIVE_P scm_read_opts[1].val +#define SCM_KEYWORD_STYLE scm_read_opts[2].val +#define SCM_R6RS_ESCAPES_P scm_read_opts[3].val +#define SCM_SQUARE_BRACKETS_P scm_read_opts[4].val +#define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[5].val +#define SCM_CURLY_INFIX_P scm_read_opts[6].val +#define SCM_R7RS_SYMBOLS_P scm_read_opts[7].val -#define SCM_N_READ_OPTIONS 9 +#define SCM_N_READ_OPTIONS 8 #endif /* PRIVATE_OPTIONS */ diff --git a/libguile/read.c b/libguile/read.c index 122a64301..69e93e8ac 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -81,8 +81,6 @@ SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$"); scm_t_option scm_read_opts[] = { - { SCM_OPTION_BOOLEAN, "copy", 0, - "Copy source code expressions." }, { SCM_OPTION_BOOLEAN, "positions", 1, "Record positions of source code expressions." }, { SCM_OPTION_BOOLEAN, "case-insensitive", 0, @@ -116,7 +114,6 @@ enum t_keyword_style struct t_read_opts { enum t_keyword_style keyword_style; - unsigned int copy_source_p : 1; unsigned int record_positions_p : 1; unsigned int case_insensitive_p : 1; unsigned int r6rs_escapes_p : 1; @@ -178,12 +175,7 @@ SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, "@code{read-disable}, @code{read-set!} and @code{read-options}.") #define FUNC_NAME s_scm_read_options { - SCM ans = scm_options (setting, - scm_read_opts, - FUNC_NAME); - if (SCM_COPY_SOURCE_P) - SCM_RECORD_POSITIONS_P = 1; - return ans; + return scm_options (setting, scm_read_opts, FUNC_NAME); } #undef FUNC_NAME @@ -413,20 +405,26 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr) static SCM scm_read_expression (SCM port, scm_t_read_opts *opts); static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts, - long line, int column); + SCM line, SCM column); static SCM maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) { - /* This condition can be caused by a user calling - set-port-column!. */ - if (line < 0 || column < 0) + if ((SCM_I_INUMP (line) && SCM_I_INUM (line) < 0) + || (SCM_I_INUMP (column) && SCM_I_INUM (column) < 1)) + /* This condition can be caused by a user calling + set-port-column!. */ return x; if (opts->record_positions_p) - scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port)); + { + /* We always capture the column after one char of lookahead; + subtract off that lookahead value. */ + column = scm_oneminus (column); + scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port)); + } return x; } @@ -442,8 +440,8 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) : ')')); /* Need to capture line and column numbers here. */ - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); c = flush_ws (port, opts, FUNC_NAME); if (terminating_char == c) @@ -620,8 +618,8 @@ scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts) scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE]; /* Need to capture line and column numbers here. */ - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); while (chr != (c = scm_getc (port))) { @@ -747,8 +745,8 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) size_t bytes_read; /* Need to capture line and column numbers here. */ - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); scm_ungetc (chr, port); buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer, @@ -874,8 +872,8 @@ static SCM scm_read_quote (int chr, SCM port, scm_t_read_opts *opts) { SCM p; - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); switch (chr) { @@ -921,8 +919,8 @@ static SCM scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts) { SCM p; - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); switch (chr) { @@ -1177,7 +1175,7 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts *opts) static SCM scm_read_vector (int chr, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) { /* Note: We call `scm_read_sexp ()' rather than READER here in order to guarantee that it's going to do what we want. After all, this is an @@ -1222,7 +1220,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp) C is the first character read after the '#'. */ static SCM -scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column) +scm_read_array (int c, SCM port, scm_t_read_opts *opts, SCM line, SCM column) { ssize_t rank; scm_t_wchar tag_buf[8]; @@ -1353,14 +1351,14 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column) static SCM scm_read_srfi4_vector (int chr, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) { return scm_read_array (chr, port, opts, line, column); } static SCM scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) { chr = scm_getc (port); if (chr != 'u') @@ -1387,7 +1385,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, static SCM scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) { /* Read the `#*10101'-style read syntax for bit vectors in Guile. This is terribly inefficient but who cares? */ @@ -1655,8 +1653,8 @@ scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts) proc = scm_get_hash_procedure (chr); if (scm_is_true (scm_procedure_p (proc))) { - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 2; + SCM line = scm_port_line (port); + SCM column = scm_oneminus (scm_port_column (port)); SCM got; got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port); @@ -1675,7 +1673,7 @@ scm_read_sharp_extension (int chr, SCM port, scm_t_read_opts *opts) among the above token readers. */ static SCM scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts, - long line, int column) + SCM line, SCM column) #define FUNC_NAME "scm_lreadr" { SCM result; @@ -1808,8 +1806,8 @@ read_inner_expression (SCM port, scm_t_read_opts *opts) be part of an unescaped symbol. We might as well do something useful with it, so we adopt Kawa's convention: [...] => ($bracket-list$ ...) */ - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); return maybe_annotate_source (scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)), port, opts, line, column); @@ -1831,8 +1829,8 @@ read_inner_expression (SCM port, scm_t_read_opts *opts) return (scm_read_quote (chr, port, opts)); case '#': { - long line = scm_to_long (scm_port_line (port)); - int column = scm_to_int (scm_port_column (port)) - 1; + SCM line = scm_port_line (port); + SCM column = scm_port_column (port); SCM result = scm_read_sharp (chr, port, opts, line, column); if (scm_is_eq (result, SCM_UNSPECIFIED)) /* We read a comment or some such. */ @@ -1880,8 +1878,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts) return read_inner_expression (port, opts); else { - long line = 0; - int column = 0; + SCM line = SCM_INUM0; + SCM column = SCM_INUM1; SCM expr; if (opts->record_positions_p) @@ -1896,8 +1894,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts) if (c == EOF) return SCM_EOF_VAL; scm_ungetc (c, port); - line = scm_to_long (scm_port_line (port)); - column = scm_to_int (scm_port_column (port)); + line = scm_port_line (port); + column = scm_port_column (port); } expr = read_inner_expression (port, opts); @@ -2250,18 +2248,17 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0, SCM_SYMBOL (sym_port_read_options, "port-read-options"); /* Offsets of bit fields for each per-port override */ -#define READ_OPTION_COPY_SOURCE_P 0 -#define READ_OPTION_RECORD_POSITIONS_P 2 -#define READ_OPTION_CASE_INSENSITIVE_P 4 -#define READ_OPTION_KEYWORD_STYLE 6 -#define READ_OPTION_R6RS_ESCAPES_P 8 -#define READ_OPTION_SQUARE_BRACKETS_P 10 -#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12 -#define READ_OPTION_CURLY_INFIX_P 14 -#define READ_OPTION_R7RS_SYMBOLS_P 16 +#define READ_OPTION_RECORD_POSITIONS_P 0 +#define READ_OPTION_CASE_INSENSITIVE_P 2 +#define READ_OPTION_KEYWORD_STYLE 4 +#define READ_OPTION_R6RS_ESCAPES_P 6 +#define READ_OPTION_SQUARE_BRACKETS_P 8 +#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 10 +#define READ_OPTION_CURLY_INFIX_P 12 +#define READ_OPTION_R7RS_SYMBOLS_P 14 /* The total width in bits of the per-port overrides */ -#define READ_OPTIONS_NUM_BITS 18 +#define READ_OPTIONS_NUM_BITS 16 #define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1) #define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL @@ -2377,7 +2374,6 @@ init_read_options (SCM port, scm_t_read_opts *opts) } \ while (0) - RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P, copy_source_p); RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P, record_positions_p); RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P, case_insensitive_p); RESOLVE_BOOLEAN_OPTION (R6RS_ESCAPES_P, r6rs_escapes_p); 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,31 +72,28 @@ 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); -scm_t_bits scm_tc16_srcprops; - static int supports_source_props (SCM obj) @@ -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" } diff --git a/libguile/srcprop.h b/libguile/srcprop.h index b32203c0b..ea1631bbf 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -1,7 +1,7 @@ #ifndef SCM_SRCPROP_H #define SCM_SRCPROP_H -/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018 +/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018,2020 Free Software Foundation, Inc. This file is part of Guile. @@ -28,27 +28,24 @@ /* {Source properties} */ -#define SCM_PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace))) -#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1 - -SCM_API scm_t_bits scm_tc16_srcprops; SCM_API SCM scm_sym_filename; -SCM_API SCM scm_sym_copy; SCM_API SCM scm_sym_line; SCM_API SCM scm_sym_column; SCM_API SCM scm_supports_source_properties_p (SCM obj); -SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM plist); SCM_API SCM scm_source_property (SCM obj, SCM key); SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum); SCM_API SCM scm_source_properties (SCM obj); SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props); + +SCM_INTERNAL SCM scm_i_make_srcprops (SCM line, SCM col, SCM fname, SCM alist); SCM_INTERNAL int scm_i_has_source_properties (SCM obj); -SCM_INTERNAL void scm_i_set_source_properties_x (SCM obj, long line, int col, +SCM_INTERNAL void scm_i_set_source_properties_x (SCM obj, SCM line, SCM col, SCM fname); + SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y); SCM_INTERNAL void scm_init_srcprop (void);