diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/alloc.c | 4 | ||||
| -rw-r--r-- | src/intervals.c | 66 | ||||
| -rw-r--r-- | src/intervals.h | 3 | ||||
| -rw-r--r-- | src/lread.c | 110 | ||||
| -rw-r--r-- | src/print.c | 6 |
5 files changed, 53 insertions, 136 deletions
diff --git a/src/alloc.c b/src/alloc.c index ac3de83b2b6..2d785d5b9a4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1553,7 +1553,7 @@ make_interval (void) /* Mark Lisp objects in interval I. */ static void -mark_interval (register INTERVAL i, Lisp_Object dummy) +mark_interval (INTERVAL i, void *dummy) { /* Intervals should never be shared. So, if extra internal checking is enabled, GC aborts if it seems to have visited an interval twice. */ @@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy) #define MARK_INTERVAL_TREE(i) \ do { \ if (i && !i->gcmarkbit) \ - traverse_intervals_noorder (i, mark_interval, Qnil); \ + traverse_intervals_noorder (i, mark_interval, NULL); \ } while (0) /*********************************************************************** diff --git a/src/intervals.c b/src/intervals.c index d17d80ac865..0089ecb8dde 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) Pass FUNCTION two args: an interval, and ARG. */ void -traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) +traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *), + void *arg) { /* Minimize stack usage. */ while (tree) @@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position, } } -#if 0 - -static int icount; -static int idepth; -static int zero_length; - -/* These functions are temporary, for debugging purposes only. */ - -INTERVAL search_interval, found_interval; - -void -check_for_interval (INTERVAL i) -{ - if (i == search_interval) - { - found_interval = i; - icount++; - } -} - -INTERVAL -search_for_interval (INTERVAL i, INTERVAL tree) -{ - icount = 0; - search_interval = i; - found_interval = NULL; - traverse_intervals_noorder (tree, &check_for_interval, Qnil); - return found_interval; -} - -static void -inc_interval_count (INTERVAL i) -{ - icount++; - if (LENGTH (i) == 0) - zero_length++; - if (depth > idepth) - idepth = depth; -} - -int -count_intervals (INTERVAL i) -{ - icount = 0; - idepth = 0; - zero_length = 0; - traverse_intervals_noorder (i, &inc_interval_count, Qnil); - - return icount; -} - -static INTERVAL -root_interval (INTERVAL interval) -{ - register INTERVAL i = interval; - - while (! ROOT_INTERVAL_P (i)) - i = INTERVAL_PARENT (i); - - return i; -} -#endif - /* Assuming that a left child exists, perform the following operation: A B diff --git a/src/intervals.h b/src/intervals.h index a0da6f37801..9140e0c17ab 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t, void (*) (INTERVAL, Lisp_Object), Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, - void (*) (INTERVAL, Lisp_Object), - Lisp_Object); + void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); extern INTERVAL find_interval (INTERVAL, ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index 8e7cd3c5510..4d1a27d1c1d 100644 --- a/src/lread.c +++ b/src/lread.c @@ -595,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea } +/* An in-progress substitution of OBJECT for PLACEHOLDER. */ +struct subst +{ + Lisp_Object object; + Lisp_Object placeholder; + + /* Hash table of subobjects of OBJECT that might be circular. If + Qt, all such objects might be circular. */ + Lisp_Object completed; + + /* List of subobjects of OBJECT that have already been visited. */ + Lisp_Object seen; +}; + static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object read0 (Lisp_Object); @@ -603,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool); static Lisp_Object read_list (bool, Lisp_Object); static Lisp_Object read_vector (Lisp_Object, bool); -static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, - Lisp_Object); -static void substitute_in_interval (INTERVAL, Lisp_Object); +static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); +static void substitute_in_interval (INTERVAL, void *); /* Get a character from the tty. */ @@ -3107,7 +3120,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Fsubstitute_object_in_subtree (tem, placeholder); + Flread__substitute_object_in_subtree + (tem, placeholder, read_objects_completed); /* ...and #n# will use the real value from now on. */ i = hash_lookup (h, number, &hash); @@ -3513,26 +3527,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } } - -/* List of nodes we've seen during substitute_object_in_subtree. */ -static Lisp_Object seen_list; - -DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, - Ssubstitute_object_in_subtree, 2, 2, 0, - doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */) - (Lisp_Object object, Lisp_Object placeholder) +DEFUN ("lread--substitute-object-in-subtree", + Flread__substitute_object_in_subtree, + Slread__substitute_object_in_subtree, 3, 3, 0, + doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT. +COMPLETED is a hash table of objects that might be circular, or is t +if any object might be circular. */) + (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed) { - Lisp_Object check_object; - - /* We haven't seen any objects when we start. */ - seen_list = Qnil; - - /* Make all the substitutions. */ - check_object - = substitute_object_recurse (object, placeholder, object); - - /* Clear seen_list because we're done with it. */ - seen_list = Qnil; + struct subst subst = { object, placeholder, completed, Qnil }; + Lisp_Object check_object = substitute_object_recurse (&subst, object); /* The returned object here is expected to always eq the original. */ @@ -3541,26 +3545,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, return Qnil; } -/* Feval doesn't get called from here, so no gc protection is needed. */ -#define SUBSTITUTE(get_val, set_val) \ - do { \ - Lisp_Object old_value = get_val; \ - Lisp_Object true_value \ - = substitute_object_recurse (object, placeholder, \ - old_value); \ - \ - if (!EQ (old_value, true_value)) \ - { \ - set_val; \ - } \ - } while (0) - static Lisp_Object -substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) +substitute_object_recurse (struct subst *subst, Lisp_Object subtree) { /* If we find the placeholder, return the target object. */ - if (EQ (placeholder, subtree)) - return object; + if (EQ (subst->placeholder, subtree)) + return subst->object; /* For common object types that can't contain other objects, don't bother looking them up; we're done. */ @@ -3570,15 +3560,16 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj return subtree; /* If we've been to this node before, don't explore it again. */ - if (!EQ (Qnil, Fmemq (subtree, seen_list))) + if (!EQ (Qnil, Fmemq (subtree, subst->seen))) return subtree; /* If this node can be the entry point to a cycle, remember that we've seen it. It can only be such an entry point if it was made by #n=, which means that we can find it as a value in - read_objects_completed. */ - if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0) - seen_list = Fcons (subtree, seen_list); + COMPLETED. */ + if (EQ (subst->completed, Qt) + || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0) + subst->seen = Fcons (subtree, subst->seen); /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ @@ -3605,19 +3596,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj if (SUB_CHAR_TABLE_P (subtree)) i = 2; for ( ; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); + ASET (subtree, i, + substitute_object_recurse (subst, AREF (subtree, i))); return subtree; } case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } + XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree))); + XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree))); + return subtree; case Lisp_String: { @@ -3625,11 +3612,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj substitute_in_interval contains part of the logic. */ INTERVAL root_interval = string_intervals (subtree); - AUTO_CONS (arg, object, placeholder); - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); - + substitute_in_interval, subst); return subtree; } @@ -3641,12 +3625,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Helper function for substitute_object_recurse. */ static void -substitute_in_interval (INTERVAL interval, Lisp_Object arg) +substitute_in_interval (INTERVAL interval, void *arg) { - Lisp_Object object = Fcar (arg); - Lisp_Object placeholder = Fcdr (arg); - - SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value)); + set_interval_plist (interval, + substitute_object_recurse (arg, interval->plist)); } @@ -4744,7 +4726,7 @@ syms_of_lread (void) { defsubr (&Sread); defsubr (&Sread_from_string); - defsubr (&Ssubstitute_object_in_subtree); + defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); @@ -5057,8 +5039,6 @@ that are loaded before your customizations are read! */); read_objects_map = Qnil; staticpro (&read_objects_completed); read_objects_completed = Qnil; - staticpro (&seen_list); - seen_list = Qnil; Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); diff --git a/src/print.c b/src/print.c index 50c75d7712c..b6ea3ff62a5 100644 --- a/src/print.c +++ b/src/print.c @@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname) static void print (Lisp_Object, Lisp_Object, bool); static void print_preprocess (Lisp_Object); -static void print_preprocess_string (INTERVAL, Lisp_Object); +static void print_preprocess_string (INTERVAL, void *); static void print_object (Lisp_Object, Lisp_Object, bool); DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, @@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj) case Lisp_String: /* A string may have text properties, which can be circular. */ traverse_intervals_noorder (string_intervals (obj), - print_preprocess_string, Qnil); + print_preprocess_string, NULL); break; case Lisp_Cons: @@ -1263,7 +1263,7 @@ Fills `print-number-table'. */) } static void -print_preprocess_string (INTERVAL interval, Lisp_Object arg) +print_preprocess_string (INTERVAL interval, void *arg) { print_preprocess (interval->plist); } |