xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 5475:248176c74e6b

Merge with trunk.

author	Mats Lidell <matsl@xemacs.org>
date	Sat, 23 Apr 2011 23:47:13 +0200
parents	ac37a5f7e5be ccf7e84fe265
children	d3e0482c7899

comparison

equal deleted inserted replaced

-:4dee0387b9de
+:248176c74e6b
 /* Our callers should have filtered out non-positive COUNT. */
 assert (counting >= 0);
 /* And we're not prepared to handle COUNT from any other caller at the
 	 moment. */
-assert (EQ (caller, QremoveX));
+assert (EQ (caller, QremoveX)|| EQ (caller, QdeleteX));
 }
 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
 					key, &test_not_unboundp);
 *tail_out = Qnil;
 if (CONSP (sequence))
 {
-Lisp_Object elt, tail = Qnil;
-struct gcpro gcpro1;
 if (EQ (caller, Qcount) && !NILP (from_end)
 && (!EQ (key, Qnil) ||
 check_test == check_other_nokey || check_test == check_if_nokey))
 {
 /* #'count, #'count-if, and #'count-if-not are documented to have
 return list_count_from_end (item, sequence, check_test,
 test_not_unboundp, test, key,
 start, end);
 }
-GCPRO1 (tail);
 /* If COUNT is non-nil and FROM-END is t, we can give the tail
 containing the last match, since that's what #'remove* is
 interested in (a zero or negative COUNT won't ever reach
 count_with_tail(), our callers will return immediately on seeing
 it). */
 {
 counting = EMACS_INT_MAX;
 }
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+	GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (!(ii < ending))
 {
 break;
 }
 }
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
-UNGCPRO;
 if ((ii < starting || (ii < ending && !NILP (end))) &&
 encountered != counting)
 {
 check_sequence_range (args[1], start, end, Flength (args[1]));
 Boolint test_not_unboundp,
 Lisp_Object test, Lisp_Object key,
 Boolint reverse_test_order,
 Lisp_Object start, Lisp_Object end)
 {
-struct gcpro gcpro1, gcpro2;
+struct gcpro gcpro1;
-Lisp_Object elt = Qnil, tail = list, tail_before = Qnil;
+Lisp_Object tail_before = Qnil;
-Elemcount len, ii = 0, starting = XINT (start);
+Elemcount ii = 0, starting = XINT (start);
 Elemcount ending = NILP (end) ? EMACS_INT_MAX : XINT (end);
-GCPRO2 (elt, tail);
+GCPRO1 (tail_before);
 if (check_test == check_eq_nokey)
 {
 /* TEST is #'eq, no need to call any C functions, and the test order
 won't be visible. */
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+EXTERNAL_LIST_LOOP_3 (elt, list, tail)
 	{
 if (starting <= ii && ii < ending &&
 EQ (item, elt) == test_not_unboundp)
 {
 *cons_out = tail_before;
 tail_before = tail;
 	}
 }
 else
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
 {
 if (starting <= ii && ii < ending &&
 (reverse_test_order ?
 check_test (test, key, elt, item) :
 check_test (test, key, item, elt)) == test_not_unboundp)
 {
 *cons_out = tail_before;
-RETURN_UNGCPRO (make_integer (ii));
+	      XUNGCPRO (elt);
+	      UNGCPRO;
+	      return make_integer (ii);
 }
 else
 {
 if (ii >= ending)
 {
 }
 }
 ii++;
 tail_before = tail;
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 RETURN_UNGCPRO (Qnil);
 }
 	    }
 	}
 }
 else
 {
-Lisp_Object tailed = alist;
+GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
-struct gcpro gcpro1;
+	{
+	  if (CONSP (elt) &&
-GCPRO1 (tailed);
+	      check_test (test, key, item, XCAR (elt)) == test_not_unboundp)
-{
-EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
-{
-tailed = tail;
-if (check_test (test, key, item, elt_car) == test_not_unboundp)
 {
-RETURN_UNGCPRO (elt);
+		XUNGCPRO (elt);
+		return elt;
 }
-}
+	}
-}
+END_GC_EXTERNAL_LIST_LOOP (elt);
-UNGCPRO;
 }
 return Qnil;
 }
 	    }
 	}
 }
 else
 {
-struct gcpro gcpro1;
+GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
-Lisp_Object tailed = alist;
+	{
+	  if (CONSP (elt) &&
-GCPRO1 (tailed);
+	      check_test (test, key, item, XCDR (elt)) == test_not_unboundp)
-{
+	    {
-EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+	      XUNGCPRO (elt);
-{
+	      return elt;
-tailed = tail;
+	    }
+	}
-if (check_test (test, key, item, elt_cdr) == test_not_unboundp)
+END_GC_EXTERNAL_LIST_LOOP (elt);
-{
-RETURN_UNGCPRO (elt);
-}
-}
-}
-UNGCPRO;
 }
 return Qnil;
 }
 *object_out = default_;
 if (CONSP (sequence))
 {
-Lisp_Object elt, tail = Qnil;
-struct gcpro gcpro1;
 if (!(starting < ending))
 	{
 	  check_sequence_range (sequence, start, end, Flength (sequence));
 	  /* starting could be equal to ending, in which case nil is what
 	     we want to return. */
 	  return Qnil;
 	}
-GCPRO1 (tail);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+	GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
 {
 if (starting <= ii && ii < ending
 && check_test (test, key, item, elt) == test_not_unboundp)
 {
 result = make_integer (ii);
 *object_out = elt;
 if (NILP (from_end))
 {
-UNGCPRO;
+		    XUNGCPRO (elt);
 return result;
 }
 }
 else if (ii == ending)
 {
 break;
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
-UNGCPRO;
 if (ii < starting || (ii < ending && !NILP (end)))
 	{
 	  check_sequence_range (sequence, start, end, Flength (sequence));
 	}
 arguments: (ITEM SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT TEST-NOT)
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object item = args[0], sequence = args[1], tail = sequence;
+Lisp_Object item = args[0], sequence = args[1];
 Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX;
 Elemcount len, ii = 0, encountered = 0, presenting = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1;
 PARSE_KEYWORDS (FdeleteX, nargs, args, 9,
 		  (test, if_not, if_, test_not, key, start, end, from_end,
 		   count), (start = Qzero, count = Qunbound));
 	  if (counting < 1)
 	    {
 	      return sequence;
 	    }
-	}
+if (!NILP (from_end))
+{
+/* Sigh, this is inelegant. Force count_with_tail () to ignore
+the count keyword, so we get the actual number of matching
+elements, and can start removing from the beginning for the
+from-end case.  */
+for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FdeleteX))->min_args;
+ii < nargs; ii += 2)
+{
+if (EQ (args[ii], Q_count))
+{
+args[ii + 1] = Qnil;
+break;
+}
+}
+ii = 0;
+}
+}
 }
 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
 					key, &test_not_unboundp);
 if (CONSP (sequence))
 {
-Lisp_Object prev_tail_list_elt = Qnil, list_elt = Qnil;
+Lisp_Object prev_tail_list_elt = Qnil, ignore = Qnil;
 Elemcount list_len = 0, deleted = 0;
+struct gcpro gcpro1;
 if (!NILP (count) && !NILP (from_end))
 	{
 	  /* Both COUNT and FROM-END were specified; we need to traverse the
 	     list twice. */
-	  Lisp_Object present = count_with_tail (&list_elt, nargs, args,
+	  Lisp_Object present = count_with_tail (&ignore, nargs, args,
 						 QdeleteX);
 	  if (ZEROP (present))
 	    {
 	      return sequence;
 	     of matching items we need to ignore before we start to
 	     delete. */
 	  presenting = presenting <= counting ? 0 : presenting - counting;
 	}
-GCPRO1 (tail);
+GCPRO1 (prev_tail_list_elt);
 ii = -1;
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (list_elt, sequence, tail, list_len)
+	GC_EXTERNAL_LIST_LOOP_4 (list_elt, sequence, tail, list_len)
 {
 ii++;
 if (starting <= ii && ii < ending &&
 (check_test (test, key, item, list_elt) == test_not_unboundp)
 {
 break;
 }
 }
 }
+	END_GC_EXTERNAL_LIST_LOOP (list_elt);
 }
 UNGCPRO;
 if ((ii < starting || (ii < ending && !NILP (end))) &&
 (int nargs, Lisp_Object *args))
 {
 Lisp_Object item = args[0], sequence = args[1], matched_count = Qnil,
 tail = Qnil;
 Elemcount starting = 0, ending = EMACS_INT_MAX, counting = EMACS_INT_MAX;
-Elemcount len, ii = 0, encountered = 0, presenting = 0;
+Elemcount ii = 0, encountered = 0, presenting = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1;
 PARSE_KEYWORDS (FremoveX, nargs, args, 9,
 		  (test, if_not, if_, test_not, key, start, end, from_end,
 		   count), (start = Qzero));
 if (counting <= 0)
 	{
 	  return sequence;
 	}
+if (!NILP (from_end))
+{
+	  /* Sigh, this is inelegant. Force count_with_tail () to ignore the
+	     count keyword, so we get the actual number of matching
+	     elements, and can start removing from the beginning for the
+	     from-end case.  */
+for (ii = XSUBR (GET_DEFUN_LISP_OBJECT (FremoveX))->min_args;
+ii < nargs; ii += 2)
+{
+if (EQ (args[ii], Q_count))
+{
+args[ii + 1] = Qnil;
+break;
+}
+}
+ii = 0;
+}
 }
 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
 					key, &test_not_unboundp);
 matched_count = count_with_tail (&tail, nargs, args, QremoveX);
 if (!ZEROP (matched_count))
 {
-Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil;
+Lisp_Object result = Qnil, result_tail = Qnil;
-GCPRO1 (tailing);
+struct gcpro gcpro1, gcpro2;
 if (!NILP (count) && !NILP (from_end))
 	{
 	  presenting = XINT (matched_count);
 	     is the number of matching items we need to ignore before we
 	     start to delete. */
 	  presenting = presenting <= counting ? 0 : presenting - counting;
 	}
+GCPRO2 (result, tail);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len)
+	GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
 {
 if (EQ (tail, tailing))
 {
+		XUNGCPRO (elt);
+		UNGCPRO;
 if (NILP (result))
 {
-RETURN_UNGCPRO (XCDR (tail));
+return XCDR (tail);
 }
 XSETCDR (result_tail, XCDR (tail));
-RETURN_UNGCPRO (result);
+		return result;
 }
 else if (starting <= ii && ii < ending &&
 (check_test (test, key, item, elt) == test_not_unboundp)
 && (presenting ? encountered++ >= presenting
 : encountered++ < counting))
 break;
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 if (ii < starting || (ii < ending && !NILP (end)))
 	{
 	  check_sequence_range (args[0], start, end, Flength (args[0]));
 				 Boolint test_not_unboundp,
 				 Lisp_Object test, Lisp_Object key,
 				 Lisp_Object start,
 				 Lisp_Object end, Boolint copy)
 {
-Lisp_Object checking = Qnil, elt, tail, result = list;
+Lisp_Object checking = Qnil, result = list;
 Lisp_Object keyed, positioned, position_cons = Qnil, result_tail;
 Elemcount len = XINT (Flength (list)), pos, starting = XINT (start);
 Elemcount ending = (NILP (end) ? len : XINT (end)), greatest_pos_seen = -1;
 Elemcount ii = 0;
-struct gcpro gcpro1, gcpro2;
+struct gcpro gcpro1;
 /* We can't delete (or remove) as we go, because that breaks START and
 END.  We could if END were nil, and that would change an ON(N + 2)
 algorithm to an ON^2 algorithm; list_position_cons_before() would need to
 be modified to return the cons *before* the one containing the item for
 deleting->size = len;
 memset (&(deleting->bits), 0,
 	  sizeof (long) * BIT_VECTOR_LONG_STORAGE (len));
-GCPRO2 (tail, keyed);
+GCPRO1 (keyed);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+GC_EXTERNAL_LIST_LOOP_3 (elt, list, tail)
 {
 if (!(starting <= ii && ii <= ending) || bit_vector_bit (deleting, ii))
 {
 ii++;
 continue;
 XCDR (checking) : XCDR (XCDR (position_cons));
 pos += 1;
 }
 ii++;
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 ii = 0;
 	  result = result_tail = Fcons (XCAR (list), Qnil);
 	  list = XCDR (list);
 	  ii = 1;
 	  {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, list, tail, len)
+EXTERNAL_LIST_LOOP_3 (elt, list, tail)
 	      {
 		if (ii == greatest_pos_seen)
 		  {
 		    XSETCDR (result_tail, XCDR (tail));
 		    break;
 	      }
 	  }
 	}
 else
 	{
-	  EXTERNAL_LIST_LOOP_DELETE_IF (elt0, list,
+	  EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
 					bit_vector_bit (deleting, ii++));
 	}
 }
 return result;
 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object sequence = args[0], tail = sequence, keyed = Qnil, elt = Qnil;
+Lisp_Object sequence = args[0], keyed = Qnil;
-Lisp_Object elt0 = Qnil, positioned = Qnil, ignore = Qnil;
+Lisp_Object positioned = Qnil, ignore = Qnil;
 Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0, jj = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
 struct gcpro gcpro1, gcpro2;
 if (NILP (from_end))
 	{
 	  Lisp_Object prev_tail = Qnil;
 Elemcount deleted = 0;
-	  GCPRO2 (tail, keyed);
+	  GCPRO2 (keyed, prev_tail);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+	    GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (starting <= ii && ii < ending)
 {
 keyed = KEY (key, elt);
 positioned
 break;
 }
 ii++;
 }
+	    END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len)
+	    GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (!(starting <= ii && ii <= ending))
 {
 prev_tail = tail;
 ii++;
 continue;
 }
-keyed = KEY (key, elt0);
+keyed = KEY (key, elt);
 positioned
 = list_position_cons_before (&ignore, keyed, XCDR (tail),
 check_test, test_not_unboundp,
 test, key, 0,
 make_int (max (starting
 }
 }
 ii++;
 }
+	    END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 	  UNGCPRO;
 	  if ((ii < starting || (ii < ending && !NILP (end))))
 	    {
 	      check_sequence_range (args[0], start, end,
 						      0);
 	}
 }
 else if (STRINGP (sequence))
 {
+Lisp_Object elt = Qnil;
 if (EQ (Qidentity, key))
 	{
 	  /* We know all the elements will be characters; set check_test to
 	     reflect that. This isn't useful if KEY is not #'identity, since
 	     it may return non-characters for the elements. */
 	  Bytecount byte_len = XSTRING_LENGTH (sequence), cursor_offset = 0;
 	  Ibyte *staging = alloca_ibytes (byte_len), *staging_cursor = staging;
 	  Ibyte *cursor = XSTRING_DATA (sequence), *startp = cursor;
 	  Elemcount deleted = 0;
-elt = Qnil;
 	  GCPRO1 (elt);
 	  while (cursor_offset < byte_len)
 	    {
 	      if (starting <= ii && ii < ending)
 else if (VECTORP (sequence))
 {
 Elemcount deleted = 0;
 Lisp_Object *content = XVECTOR_DATA (sequence);
 struct Lisp_Bit_Vector *deleting;
+Lisp_Object elt = Qnil;
 len = XVECTOR_LENGTH (sequence);
 check_sequence_range (sequence, start, end, make_integer (len));
 deleting = (Lisp_Bit_Vector *) ALLOCA (sizeof (struct Lisp_Bit_Vector)
 	 that's the possible number of distinct elements if EQ is regarded
 	 as identity, which it should be).  But to support arbitrary TEST
 	 and KEY arguments, which may be non-deterministic from our
 	 perspective, we need the same algorithm as for vectors. */
 struct Lisp_Bit_Vector *deleting;
+Lisp_Object elt = Qnil;
 len = bit_vector_length (bv);
 if (EQ (Qidentity, key))
 	{
 arguments: (SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) END FROM-END TEST-NOT)
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object sequence = args[0], tail = sequence, keyed, positioned = Qnil;
+Lisp_Object sequence = args[0], keyed, positioned = Qnil;
 Lisp_Object result = sequence, result_tail = result, cursor = Qnil;
-Lisp_Object cons_with_shared_tail = Qnil, elt, elt0;
+Lisp_Object cons_with_shared_tail = Qnil;
-Elemcount starting = 0, ending = EMACS_INT_MAX, len, ii = 0;
+Elemcount starting = 0, ending = EMACS_INT_MAX, ii = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
 PARSE_KEYWORDS (Fremove_duplicates, nargs, args, 6,
 		  (test, key, test_not, start, end, from_end),
 		  (start = Qzero));
 if (NILP (from_end))
 {
 Lisp_Object ignore = Qnil;
-GCPRO3 (tail, keyed, result);
+GCPRO2 (keyed, result);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+	GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (starting <= ii && ii <= ending)
 {
 keyed = KEY (key, elt);
 positioned
 break;
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt0, sequence, tail, len)
+	GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (!(starting <= ii && ii <= ending))
 {
 ii++;
 continue;
 /* For this algorithm, each time we encounter an object to be
 removed, copy the output list from the tail beyond the last
 removed cons to this one. Otherwise, the tail of the output list
 is shared with the input list, which is OK. */
-keyed = KEY (key, elt0);
+keyed = KEY (key, elt);
 positioned
 = list_position_cons_before (&ignore, keyed, XCDR (tail),
 check_test, test_not_unboundp,
 test, key, 0,
 make_int (max (starting - (ii + 1),
 cons_with_shared_tail = result_tail;
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 if ((ii < starting || (ii < ending && !NILP (end))))
 	{
 	  check_sequence_range (args[0], start, end, Flength (args[0]));
 }
 else if (LISTP (sequence))
 {
 if (NILP (from_end))
 {
-	  struct gcpro gcpro1, gcpro2;
+	  struct gcpro gcpro1;
-	  Lisp_Object tailed = Qnil;
+	  GCPRO1 (accum);
-	  GCPRO2 (tailed, accum);
 if (!UNBOUNDP (initial_value))
 {
 accum = initial_value;
 }
 else if (ending - starting)
 {
-EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+	      GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
 {
-		  /* KEY may amputate the list behind us; make sure what
-		     remains to be processed is still reachable.  */
-		  tailed = tail;
 if (ii == starting)
 {
 accum = KEY (key, elt);
 starting++;
 break;
 }
 ++ii;
 }
+	      END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 	  ii = 0;
 if (ending - starting)
 {
-EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
+	      GC_EXTERNAL_LIST_LOOP_2 (elt, sequence)
 {
-		  /* KEY or FUNCTION may amputate the list behind us; make
-		     sure what remains to be processed is still
-		     reachable.  */
-		  tailed = tail;
 if (ii >= starting)
 {
 if (ii < ending)
 {
 accum = CALL2 (function, accum, KEY (key, elt));
 break;
 }
 }
 ++ii;
 }
+	      END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 	  UNGCPRO;
 	  if (ii < starting || (ii < ending && !NILP (end)))
 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) FROM-END COUNT)
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
+Lisp_Object new_ = args[0], item = args[1], sequence = args[2];
 Lisp_Object object_, position0;
 Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0;
 Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1;
 PARSE_KEYWORDS (Fnsubstitute, nargs, args, 9,
 		  (test, if_, if_not, test_not, key, start, end, count,
 		   from_end), (start = Qzero));
 check_test = get_check_test_function (item, &test, test_not, if_, if_not,
 					key, &test_not_unboundp);
 if (CONSP (sequence))
 {
-Lisp_Object elt;
 if (!NILP (count) && !NILP (from_end))
 	{
-	  Lisp_Object present = count_with_tail (&elt, nargs - 1, args + 1,
+	  Lisp_Object present = count_with_tail (&object_, nargs - 1, args + 1,
 						 Qnsubstitute);
 	  if (ZEROP (present))
 	    {
 	      return sequence;
 	  presenting = XINT (present);
 	  presenting = presenting <= counting ? 0 : presenting - counting;
 	}
-GCPRO1 (tail);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len)
+	GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
 {
 if (!(ii < ending))
 {
 break;
 }
 break;
 }
 ii++;
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
-UNGCPRO;
 if ((ii < starting || (ii < ending && !NILP (end)))
 	  && encountered < counting)
 	{
 	  check_sequence_range (args[0], start, end, Flength (args[0]));
 arguments: (NEW OLD SEQUENCE &key (TEST #'eql) (KEY #'identity) (START 0) (END (length SEQUENCE)) COUNT)
 */
 (int nargs, Lisp_Object *args))
 {
 Lisp_Object new_ = args[0], item = args[1], sequence = args[2], tail = Qnil;
-Lisp_Object elt, tailing = Qnil, result = Qnil, result_tail = Qnil;
+Lisp_Object result = Qnil, result_tail = Qnil;
 Lisp_Object object, position0, matched_count;
 Elemcount starting = 0, ending = EMACS_INT_MAX, encountered = 0;
-Elemcount len, ii = 0, counting = EMACS_INT_MAX, presenting = 0;
+Elemcount ii = 0, counting = EMACS_INT_MAX, presenting = 0;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
 struct gcpro gcpro1;
 PARSE_KEYWORDS (Fsubstitute, nargs, args, 9,
 {
 presenting = XINT (matched_count);
 presenting = presenting <= counting ? 0 : presenting - counting;
 }
-GCPRO1 (tailing);
+GCPRO1 (result);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tailing, len)
+GC_EXTERNAL_LIST_LOOP_3 (elt, sequence, tailing)
 {
 if (EQ (tail, tailing))
 {
+	    XUNGCPRO (elt);
+	    UNGCPRO;
 if (NILP (result))
 {
-RETURN_UNGCPRO (XCDR (tail));
+return XCDR (tail);
 }
 XSETCDR (result_tail, XCDR (tail));
-RETURN_UNGCPRO (result);
+	    return result;
 }
 else if (starting <= ii && ii < ending &&
 (check_test (test, key, item, elt) == test_not_unboundp)
 && (presenting ? encountered++ >= presenting
 : encountered++ < counting))
 break;
 }
 ii++;
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 if (ii < starting || (ii < ending && !NILP (end)))
 {
 static Lisp_Object
 sublis (Lisp_Object alist, Lisp_Object tree,
 	check_test_func_t check_test, Boolint test_not_unboundp,
 	Lisp_Object test, Lisp_Object key, int depth)
 {
-Lisp_Object keyed = KEY (key, tree), tailed = alist, aa, dd;
+Lisp_Object keyed = KEY (key, tree), aa, dd;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1;
 if (depth + lisp_eval_depth > max_lisp_eval_depth)
 {
 stack_overflow ("Stack overflow in sublis", tree);
 }
-GCPRO3 (tailed, alist, tree);
 {
-EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
 {
-tailed = tail;
+if (CONSP (elt) &&
+	    check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
-if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
 {
-/* Don't use elt_cdr, it is helpful to allow TEST or KEY to
+	    XUNGCPRO (elt);
-modify the alist while it executes. */
+	    return XCDR (elt);
-RETURN_UNGCPRO (XCDR (elt));
 }
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 if (!CONSP (tree))
 {
-RETURN_UNGCPRO (tree);
+return tree;
 }
 aa = sublis (alist, XCAR (tree), check_test, test_not_unboundp, test, key,
 	       depth + 1);
 dd = sublis (alist, XCDR (tree), check_test, test_not_unboundp, test, key,
 	       depth + 1);
 if (EQ (aa, XCAR (tree)) && EQ (dd, XCDR (tree)))
 {
-RETURN_UNGCPRO (tree);
+return tree;
 }
-RETURN_UNGCPRO (Fcons (aa, dd));
+return Fcons (aa, dd);
 }
 DEFUN ("sublis", Fsublis, 2, MANY, 0, /*
 Perform substitutions indicated by ALIST in TREE (non-destructively).
 Return a copy of TREE with all matching elements replaced.
 nsublis (Lisp_Object alist, Lisp_Object tree,
 	 check_test_func_t check_test,
 	 Boolint test_not_unboundp,
 	 Lisp_Object test, Lisp_Object key, int depth)
 {
-Lisp_Object tree_saved = tree, tailed = alist, tortoise = tree, keyed = Qnil;
+Lisp_Object tree_saved = tree, tortoise = tree, keyed = Qnil;
-struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+struct gcpro gcpro1, gcpro2;
 int count = 0;
 if (depth + lisp_eval_depth > max_lisp_eval_depth)
 {
 stack_overflow ("Stack overflow in nsublis", tree);
 }
-GCPRO4 (tailed, alist, tree_saved, keyed);
+GCPRO2 (tree_saved, keyed);
 while (CONSP (tree))
 {
 Boolint replaced = 0;
 keyed = KEY (key, XCAR (tree));
 {
-	EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+	GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
 	  {
-	    tailed = tail;
+	    if (CONSP (elt) &&
+		check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
-	    if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
 	      {
 		CHECK_LISP_WRITEABLE (tree);
 		/* See comment in sublis() on using elt_cdr. */
 		XSETCAR (tree, XCDR (elt));
 		replaced = 1;
 		break;
 	      }
 	  }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 if (!replaced)
 	{
 	  if (CONSP (XCAR (tree)))
 keyed = KEY (key, XCDR (tree));
 replaced = 0;
 {
-	EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+	GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
 	  {
-	    tailed = tail;
+	    if (CONSP (elt) &&
+		check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
-	    if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
 	      {
 		CHECK_LISP_WRITEABLE (tree);
-		/* See comment in sublis() on using elt_cdr. */
 		XSETCDR (tree, XCDR (elt));
 		tree = Qnil;
 		break;
 	      }
 	  }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 if (!NILP (tree))
 	{
 	  tree = XCDR (tree);
 keyed = KEY (key, tree);
 {
 /* nsublis() won't attempt to replace a cons handed to it, do that
 ourselves. */
-EXTERNAL_ALIST_LOOP_5 (elt, elt_car, elt_cdr, alist, tail)
+GC_EXTERNAL_LIST_LOOP_2 (elt, alist)
 {
-tailed = tail;
+if (CONSP (elt) &&
+	    check_test (test, key, XCAR (elt), keyed) == test_not_unboundp)
-if (check_test (test, key, elt_car, keyed) == test_not_unboundp)
 {
-/* See comment in sublis() on using elt_cdr. */
+	    XUNGCPRO (elt);
-RETURN_UNGCPRO (XCDR (elt));
+return XCDR (elt);
 }
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 return nsublis (alist, tree, check_test, test_not_unboundp, test, key, 0);
 /* These two functions do set operations, those that can be visualised with
 Venn diagrams. */
 static Lisp_Object
 venn (Lisp_Object caller, int nargs, Lisp_Object *args, Boolint intersectionp)
 {
-Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
+Lisp_Object liszt1 = args[0], liszt2 = args[1];
 Lisp_Object result = EQ (caller, Qsubsetp) ? Qt : Qnil, result_tail = Qnil;
 Lisp_Object keyed = Qnil, ignore = Qnil;
-Elemcount len;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
 PARSE_KEYWORDS_8 (caller, nargs, args, 4, (test, key, test_not, stable),
 NULL, 2, 0);
 CHECK_LIST (liszt1);
 }
 get_check_match_function (&test, test_not, Qnil, Qnil, key,
 &test_not_unboundp, &check_test);
-GCPRO3 (tail, keyed, result);
+GCPRO2 (keyed, result);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
 {
 keyed = KEY (key, elt);
 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
 check_test, test_not_unboundp,
 test, key, 0, Qzero, Qnil))
 XSETCDR (result_tail, Fcons (elt, Qnil));
 result_tail = XCDR (result_tail);
 }
 }
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 return result;
 Lisp_Object liszt1 = args[0], liszt2 = args[1], tortoise_elt, ignore = Qnil;
 Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, prev_tail = Qnil;
 Elemcount count;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 PARSE_KEYWORDS_8 (caller, nargs, args, 3, (test, key, test_not),
 NULL, 2, 0);
 CHECK_LIST (liszt1);
 }
 get_check_match_function (&test, test_not, Qnil, Qnil, key,
 &test_not_unboundp, &check_test);
-GCPRO3 (tail, keyed, liszt1);
+tortoise_elt = tail = liszt1, count = 0;
-tortoise_elt = tail = liszt1, count = 0;
+GCPRO4 (tail, keyed, liszt1, tortoise_elt);
 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
 (signal_malformed_list_error (liszt1), 0))
 {
 keyed = KEY (key, elt);
 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
 */
 (int nargs, Lisp_Object *args))
 {
 Lisp_Object liszt1 = args[0], liszt2 = args[1], ignore = Qnil;
-Lisp_Object elt = Qnil, tail = Qnil, keyed = Qnil, result, result_tail;
+Lisp_Object keyed = Qnil, result, result_tail;
-Elemcount len;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_test = NULL, check_match = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
 PARSE_KEYWORDS (Funion, nargs, args, 4, (test, key, test_not, stable), NULL);
 CHECK_LIST (liszt1);
 CHECK_LIST (liszt2);
 }
 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
 &test_not_unboundp, &check_test);
-GCPRO3 (tail, keyed, result);
+GCPRO2 (keyed, result);
 if (NILP (stable))
 {
 result = liszt2;
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+	GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
 {
 keyed = KEY (key, elt);
 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
 check_test, test_not_unboundp,
 test, key, 0, Qzero, Qnil)))
 is called an awful lot more, so it's a space win but not
 a time win. */
 result = Fcons (elt, result);
 }
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 }
 else
 {
 result = result_tail = Qnil;
 the values in backwards order.  According to the CLTL2
 documentation, `union' is not required to preserve the ordering of
 elements in any fashion; providing the functionality for a stable
 union is an XEmacs extension. */
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len)
+	GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
 {
 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
 check_match, test_not_unboundp,
 test, key, 1, Qzero, Qnil)))
 {
 XSETCDR (result_tail, Fcons (elt, Qnil));
 result_tail = XCDR (result_tail);
 }
 }
 }
+	END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 result = NILP (result) ? liszt1 : nconc2 (Fcopy_list (liszt1), result);
 }
 arguments: (LIST1 LIST2 &key (TEST #'eql) (KEY #'identity) TEST-NOT STABLE)
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object liszt1 = args[0], liszt2 = args[1], elt = Qnil, tail = Qnil;
+Lisp_Object liszt1 = args[0], liszt2 = args[1];
 Lisp_Object result = Qnil, result_tail = Qnil, keyed = Qnil, ignore = Qnil;
-Elemcount len;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_match = NULL, check_test = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2;
 PARSE_KEYWORDS (Fset_exclusive_or, nargs, args, 4,
 (test, key, test_not, stable), NULL);
 CHECK_LIST (liszt1);
 }
 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
 &test_not_unboundp, &check_test);
-GCPRO3 (tail, keyed, result);
+GCPRO2 (keyed, result);
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt1, tail, len)
+GC_EXTERNAL_LIST_LOOP_2 (elt, liszt1)
 {
 keyed = KEY (key, elt);
 if (NILP (list_position_cons_before (&ignore, keyed, liszt2,
 check_test, test_not_unboundp,
 test, key, 0, Qzero, Qnil)))
 XSETCDR (result_tail, Fcons (elt, Qnil));
 result_tail = XCDR (result_tail);
 }
 }
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 {
-EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, liszt2, tail, len)
+GC_EXTERNAL_LIST_LOOP_2 (elt, liszt2)
 {
 if (NILP (list_position_cons_before (&ignore, elt, liszt1,
 check_match, test_not_unboundp,
 test, key, 1, Qzero, Qnil)))
 {
 XSETCDR (result_tail, Fcons (elt, Qnil));
 result_tail = XCDR (result_tail);
 }
 }
 }
+END_GC_EXTERNAL_LIST_LOOP (elt);
 }
 UNGCPRO;
 return result;
 }
 Lisp_Object result = Qnil, tortoise_elt = Qnil, keyed = Qnil, swap;
 Lisp_Object prev_tail = Qnil, ignore = Qnil;
 Elemcount count;
 Boolint test_not_unboundp = 1;
 check_test_func_t check_match = NULL, check_test = NULL;
-struct gcpro gcpro1, gcpro2, gcpro3;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 PARSE_KEYWORDS (Fnset_exclusive_or, nargs, args, 4,
 (test, key, test_not, stable), NULL);
 CHECK_LIST (liszt1);
 }
 check_match = get_check_match_function (&test, test_not, Qnil, Qnil, key,
 &test_not_unboundp, &check_test);
-GCPRO3 (tail, keyed, result);
 tortoise_elt = tail = liszt1, count = 0;
+GCPRO4 (tail, keyed, result, tortoise_elt);
 while (CONSP (tail) ? (elt = XCAR (tail), 1) : NILP (tail) ? 0 :
 (signal_malformed_list_error (liszt1), 0))
 {
 keyed = KEY (key, elt);

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5475:248176c74e6b