xemacs-beta: src/fns.c comparison

comparison src/fns.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13

author	cvs
date	Mon, 13 Aug 2007 09:49:09 +0200
parents	15872534500d
children	2d532a89d707

comparison

equal deleted inserted replaced

-:a38aed19690b
+:8eaf7971accc
 if (!COMPILED_FUNCTIONP (seq))
 return XINT (Flength (seq));
 else
 {
 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (seq);
 return (b->flags.interactivep ? COMPILED_INTERACTIVE :
 	      b->flags.domainp      ? COMPILED_DOMAIN :
 	      COMPILED_DOC_STRING)
 	+ 1;
 }
 retry:
 if (STRINGP (obj))
 return make_int (string_char_length (XSTRING (obj)));
 else if (VECTORP (obj))
-return make_int (vector_length (XVECTOR (obj)));
+return make_int (XVECTOR_LENGTH (obj));
 else if (BIT_VECTORP (obj))
 return make_int (bit_vector_length (XBIT_VECTOR (obj)));
 else if (CONSP (obj))
 {
 for (i = 0, tail = obj; !NILP (tail); i++)
 	{
 	  QUIT;
 	  tail = Fcdr (tail);
 	}
-return (make_int (i));
+return make_int (i);
 }
 else if (NILP (obj))
 {
-return (Qzero);
+return Qzero;
 }
 else
 {
 check_losing_bytecode ("length", obj);
 obj = wrong_type_argument (Qsequencep, obj);
 return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil;
 }
 #endif /* not I18N2, or MULE */
 /* Can't do i < len2 because then comparison between "foo" and "foo^@"
 won't work right in I18N2 case */
-return ((end < len2) ? Qt : Qnil);
+return end < len2 ? Qt : Qnil;
 }
 }
 DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /*
 Return STRING's tick counter, incremented for each change to the string.
 else
 	{
 check_losing_bytecode ("concat", seq);
 args[argnum] = wrong_type_argument (Qsequencep, seq);
 	}
 if (args_mse)
 {
 if (STRINGP (seq))
 args_mse[argnum].string = seq;
 else
 		{
 		  elt = make_char (charptr_emchar (string_source_ptr));
 		  INC_CHARPTR (string_source_ptr);
 		}
 	      else if (VECTORP (seq))
-elt = vector_data (XVECTOR (seq))[thisindex];
+elt = XVECTOR_DATA (seq)[thisindex];
 	      else if (BIT_VECTORP (seq))
 		elt = make_int (bit_vector_bit (XBIT_VECTOR (seq),
 						thisindex));
 else
 		elt = Felt (seq, make_int (thisindex));
 	      XCAR (tail) = elt;
 	      prev = tail;
 	      tail = XCDR (tail);
 	    }
 	  else if (VECTORP (val))
-	    vector_data (XVECTOR (val))[toindex++] = elt;
+	    XVECTOR_DATA (val)[toindex++] = elt;
 	  else if (BIT_VECTORP (val))
 	    {
 	      CHECK_BIT (elt);
 	      set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt));
 	    }
 }
 if (!NILP (prev))
 XCDR (prev) = last_tail;
 RETURN_UNGCPRO (val);
 }
 DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /*
 Return a copy of ALIST.
 This is an alist which represents the same mapping from objects to objects,
 	  rest = XCDR (rest);
 	}
 }
 else if (VECTORP (arg) && ! NILP (vecp))
 {
-int i = vector_length (XVECTOR (arg));
+int i = XVECTOR_LENGTH (arg);
 int j;
 arg = Fcopy_sequence (arg);
 for (j = 0; j < i; j++)
 	{
-	  Lisp_Object elt = vector_data (XVECTOR (arg)) [j];
+	  Lisp_Object elt = XVECTOR_DATA (arg) [j];
 	  QUIT;
 	  if (CONSP (elt) || VECTORP (elt))
-	    vector_data (XVECTOR (arg)) [j] = Fcopy_tree (elt, vecp);
+	    XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp);
 	}
 }
 return arg;
 }
 bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr);
 bto = charcount_to_bytecount (XSTRING_DATA (string), ccto);
 val = make_string (XSTRING_DATA (string) + bfr, bto - bfr);
 /* Copy any applicable extent information into the new string: */
 copy_string_extents (val, string, 0, bfr, bto - bfr);
-return (val);
+return val;
 }
 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
 Return a subsequence of SEQ, starting at index FROM and ending before TO.
 TO may be nil or omitted; then the subsequence runs to the end of SEQ.
 else
 {
 check_losing_bytecode ("subseq", seq);
 seq = wrong_type_argument (Qsequencep, seq);
 }
 len = XINT (Flength (seq));
 CHECK_INT (from);
 f = XINT (from);
 if (f < 0)
 f = len + f;
 CHECK_INT (to);
 t = XINT (to);
 if (t < 0)
 	t = len + t;
 }
 if (!(0 <= f && f <= t && t <= len))
 args_out_of_range_3 (seq, make_int (f), make_int (t));
 if (VECTORP (seq))
 {
 Lisp_Object result = make_vector (t - f, Qnil);
 int i;
-Lisp_Object *in_elts = vector_data (XVECTOR (seq));
+Lisp_Object *in_elts  = XVECTOR_DATA (seq);
-Lisp_Object *out_elts = vector_data (XVECTOR (result));
+Lisp_Object *out_elts = XVECTOR_DATA (result);
 for (i = f; i < t; i++)
 	out_elts[i - f] = in_elts[i];
 return result;
 }
 /* #### Utterly, completely, fucking disgusting.
 * #### The whole point of "elt" is that it operates on
 * #### sequences, and does error- (bounds-) checking.
 */
 if (CONSP (tem))
-	return (XCAR (tem));
+	return XCAR (tem);
 else
 #if 1
 	/* This is The Way It Has Always Been. */
 	return Qnil;
 #else
 #endif
 }
 else if (STRINGP (seq)
 || VECTORP (seq)
 || BIT_VECTORP (seq))
-return (Faref (seq, n));
+return Faref (seq, n);
 #ifdef LOSING_BYTECODE
 else if (COMPILED_FUNCTIONP (seq))
 {
 int idx = XINT (n);
 if (idx < 0)
 {
 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (seq);
 switch (idx)
 {
 case COMPILED_ARGLIST:
-return (b->arglist);
+return b->arglist;
 case COMPILED_BYTECODE:
-return (b->bytecodes);
+return b->bytecodes;
 case COMPILED_CONSTANTS:
-return (b->constants);
+return b->constants;
 case COMPILED_STACK_DEPTH:
-return (make_int (b->maxdepth));
+return make_int (b->maxdepth);
 case COMPILED_DOC_STRING:
-	    return (compiled_function_documentation (b));
+	    return compiled_function_documentation (b);
 case COMPILED_DOMAIN:
-	    return (compiled_function_domain (b));
+	    return compiled_function_domain (b);
 case COMPILED_INTERACTIVE:
 	    if (b->flags.interactivep)
-	      return (compiled_function_interactive (b));
+	      return compiled_function_interactive (b);
 	    /* if we return nil, can't tell interactive with no args
 	       from noninteractive. */
 	    goto lose;
 default:
 goto lose;
 if (!NILP (list))
 list = wrong_type_argument (Qconsp, list);
 return new;
 }
 static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
 Lisp_Object lisp_arg,
 int (*pred_fn) (Lisp_Object, Lisp_Object,
 Lisp_Object lisp_arg));
 Lisp_Object
 list_sort (Lisp_Object list,
 Lisp_Object lisp_arg,
 int (*pred_fn) (Lisp_Object, Lisp_Object,
 Lisp_Object lisp_arg))
 {
 Lisp_Object front, back;
 Lisp_Object len, tem;
 return list_merge (front, back, lisp_arg, pred_fn);
 }
 static int
 merge_pred_function (Lisp_Object obj1, Lisp_Object obj2,
 Lisp_Object pred)
 {
 Lisp_Object tmp;
 /* prevents the GC from happening in call2 */
 make_int (gc_currently_forbidden));
 gc_currently_forbidden = 1;
 tmp = call2 (pred, obj1, obj2);
 unbind_to (speccount, Qnil);
 if (NILP (tmp))
 return -1;
 else
 return 1;
 }
 {
 return list_sort (list, pred, merge_pred_function);
 }
 Lisp_Object
 merge (Lisp_Object org_l1, Lisp_Object org_l2,
 Lisp_Object pred)
 {
 return list_merge (org_l1, org_l2, pred, merge_pred_function);
 }
 static Lisp_Object
 list_merge (Lisp_Object org_l1, Lisp_Object org_l2,
 Lisp_Object lisp_arg,
 int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg))
 {
 Lisp_Object value;
 Lisp_Object tail;
 Lisp_Object tem;
 value = Qnil;
 /* It is sufficient to protect org_l1 and org_l2.
 When l1 and l2 are updated, we copy the new values
 back into the org_ vars.  */
 GCPRO4 (org_l1, org_l2, lisp_arg, value);
 while (1)
 {
 if (NILP (l1))
 So (a 1 b 2) would be equal to (b 2 a 1).
 NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc.
 LAXP means use `equal' for comparisons.
 */
 int
 plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present,
 	       int laxp, int depth)
 {
 int eqp = (depth == -1);	/* -1 as depth means us eq, not equal. */
 int la, lb, m, i, fill;
 void
 internal_plist_put (Lisp_Object *plist, Lisp_Object property,
 		    Lisp_Object value)
 {
 Lisp_Object tail = *plist;
 for (; !NILP (tail); tail = XCDR (XCDR (tail)))
 {
 struct Lisp_Cons *c = XCONS (tail);
 if (EQ (c->car, property))
 	{
 Lisp_Object *tortsave = *tortoise;
 /* Note that our "fixing" may be more brutal than necessary,
 but it's the user's own problem, not ours. if they went in and
 manually fucked up a plist. */
 for (i = 0; i < 2; i++)
 {
 /* This is a standard iteration of a defensive-loop-checking
 loop.  We just do it twice because we want to advance past
 	 both the property and its value.
 PLIST is a property list, which is a list of the form
 \(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
 corresponding to the given PROP, or DEFAULT if PROP is not
 one of the properties on the list.
 */
-(plist, prop, defalt))           /* Cant spel in C */
+(plist, prop, default_))
 {
 Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME);
 if (UNBOUNDP (val))
-return defalt;
+return default_;
 return val;
 }
 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /*
 Change value in PLIST of PROP to VAL.
 	goto start_over;
 }
 return Qnil;
 }
 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /*
 Given a plist, return non-nil if its format is correct.
 If it returns nil, `check-valid-plist' will signal an error when given
 the plist; that means it's a malformed or circular plist or has non-symbols
 as keywords.
 VALUE1 PROP2 VALUE2...), where comparions between properties is done
 using `equal' instead of `eq'.  This function returns the value
 corresponding to the given PROP, or DEFAULT if PROP is not one of the
 properties on the list.
 */
-(lax_plist, prop, defalt))           /* Cant spel in C */
+(lax_plist, prop, default_))
 {
 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME);
 if (UNBOUNDP (val))
-return defalt;
+return default_;
 return val;
 }
 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
 Change value in LAX-PLIST of PROP to VAL.
 /* Symbol plists are directly accessible, so we need to protect against
 invalid property list structure */
 static Lisp_Object
-symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object defalt)
+symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object default_)
 {
 Lisp_Object val = external_plist_get (&XSYMBOL (sym)->plist, propname,
 					0, ERROR_ME);
 if (UNBOUNDP (val))
-return defalt;
+return default_;
 return val;
 }
 static void
 symbol_putprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object value)
 return ptr;
 }
 Lisp_Object
 string_getprop (struct Lisp_String *s, Lisp_Object property,
-		Lisp_Object defalt)
+		Lisp_Object default_)
 {
 Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0,
 					ERROR_ME);
 if (UNBOUNDP (val))
-return defalt;
+return default_;
 return val;
 }
 void
 string_putprop (struct Lisp_String *s, Lisp_Object property,
 DEFUN ("get", Fget, 2, 3, 0, /*
 Return the value of OBJECT's PROPNAME property.
 This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'.
 If there is no such property, return optional third arg DEFAULT
-(which defaults to `nil').  OBJECT can be a symbol, face, extent,
+\(which defaults to `nil').  OBJECT can be a symbol, face, extent,
 or string.  See also `put', `remprop', and `object-plist'.
 */
-(object, propname, defalt))           /* Cant spel in C */
+(object, propname, default_))
 {
 Lisp_Object val;
 /* Various places in emacs call Fget() and expect it not to quit,
 so don't quit. */
 /* It's easiest to treat symbols specially because they may not
 be an lrecord */
 if (SYMBOLP (object))
-val = symbol_getprop (object, propname, defalt);
+val = symbol_getprop (object, propname, default_);
 else if (STRINGP (object))
-val = string_getprop (XSTRING (object), propname, defalt);
+val = string_getprop (XSTRING (object), propname, default_);
 else if (LRECORDP (object))
 {
 CONST struct lrecord_implementation
 	*imp = XRECORD_LHEADER (object)->implementation;
 if (imp->getprop)
 	{
 	  val = (imp->getprop) (object, propname);
 	  if (UNBOUNDP (val))
-	    val = defalt;
+	    val = default_;
 	}
 else
 	goto noprops;
 }
 else
 do_cdr:
 QUIT;
 if (EQ_WITH_EBOLA_NOTICE (o1, o2))
 return 1;
 /* Note that (equal 20 20.0) should be nil */
 else if (XTYPE (o1) != XTYPE (o2))
 return 0;
 else if (CONSP (o1))
 {
 if (!internal_equal (XCAR (o1), XCAR (o2), depth + 1))
 return 0;
 }
 #ifndef LRECORD_VECTOR
 else if (VECTORP (o1))
 {
-int indecks;
+int indice;
-int len = vector_length (XVECTOR (o1));
+int len = XVECTOR_LENGTH (o1);
-if (len != vector_length (XVECTOR (o2)))
+if (len != XVECTOR_LENGTH (o2))
 	return 0;
-for (indecks = 0; indecks < len; indecks++)
+for (indice = 0; indice < len; indice++)
 	{
 	  Lisp_Object v1, v2;
-	  v1 = vector_data (XVECTOR (o1)) [indecks];
+	  v1 = XVECTOR_DATA (o1) [indice];
-	  v2 = vector_data (XVECTOR (o2)) [indecks];
+	  v2 = XVECTOR_DATA (o2) [indice];
 	  if (!internal_equal (v1, v2, depth + 1))
 return 0;
 	}
 return 1;
 }
 do_cdr:
 QUIT;
 if (HACKEQ_UNSAFE (o1, o2))
 return 1;
 /* Note that (equal 20 20.0) should be nil */
 else if (XTYPE (o1) != XTYPE (o2))
 return 0;
 else if (CONSP (o1))
 {
 if (!internal_old_equal (XCAR (o1), XCAR (o2), depth + 1))
 return 0;
 }
 #ifndef LRECORD_VECTOR
 else if (VECTORP (o1))
 {
-int indecks;
+int indice;
-int len = vector_length (XVECTOR (o1));
+int len = XVECTOR_LENGTH (o1);
-if (len != vector_length (XVECTOR (o2)))
+if (len != XVECTOR_LENGTH (o2))
 	return 0;
-for (indecks = 0; indecks < len; indecks++)
+for (indice = 0; indice < len; indice++)
 	{
-	  Lisp_Object v1, v2;
+	  if (!internal_old_equal (XVECTOR_DATA (o1) [indice],
-	  v1 = vector_data (XVECTOR (o1)) [indecks];
+				   XVECTOR_DATA (o2) [indice],
-	  v2 = vector_data (XVECTOR (o2)) [indecks];
+				   depth + 1))
-	  if (!internal_old_equal (v1, v2, depth + 1))
 return 0;
 	}
 return 1;
 }
 #endif /* !LRECORD_VECTOR */
 	return 0;
 else if (imp1->equal == 0)
 	/* EQ-ness of the objects was noticed above */
 	return 0;
 else
-	return ((imp1->equal) (o1, o2, depth));
+	return (imp1->equal) (o1, o2, depth);
 }
 return 0;
 }
 (array, item))
 {
 retry:
 if (STRINGP (array))
 {
-Charcount size;
+Charcount len;
 Charcount i;
 Emchar charval;
 struct Lisp_String *s;
 CHECK_CHAR_COERCE_INT (item);
 CHECK_IMPURE (array);
 charval = XCHAR (item);
 s = XSTRING (array);
-size = string_char_length (s);
+len = string_char_length (s);
-for (i = 0; i < size; i++)
+for (i = 0; i < len; i++)
 	set_string_char (s, i, charval);
 bump_string_modiff (array);
 }
 else if (VECTORP (array))
 {
 Lisp_Object *p;
-int size;
+int len;
 int i;
 CHECK_IMPURE (array);
-size = vector_length (XVECTOR (array));
+len = XVECTOR_LENGTH (array);
-p = vector_data (XVECTOR (array));
+p = XVECTOR_DATA (array);
-for (i = 0; i < size; i++)
+for (i = 0; i < len; i++)
 	p[i] = item;
 }
 else if (BIT_VECTORP (array))
 {
 struct Lisp_Bit_Vector *v;
-int size;
+int len;
 int i;
 CHECK_BIT (item);
 CHECK_IMPURE (array);
 v = XBIT_VECTOR (array);
-size = bit_vector_length (v);
+len = bit_vector_length (v);
-for (i = 0; i < size; i++)
+for (i = 0; i < len; i++)
 	set_bit_vector_bit (v, i, XINT (item));
 }
 else
 {
 array = wrong_type_argument (Qarrayp, array);
 in Emacs on freshly created stuff (e.g. you see the idiom
 nconc2 (Fcopy_sequence (foo), bar) a lot).  So we help those
 callers out by protecting the args ourselves to save them
 a lot of temporary-variable grief. */
+again:
 GCPRO1 (args[0]);
 gcpro1.nvars = nargs;
 val = Qnil;
 for (argnum = 0; argnum < nargs; argnum++)
 {
 tem = args[argnum];
 	val = tem;
 if (argnum + 1 == nargs) break;
 if (!CONSP (tem))
-	tem = wrong_type_argument (Qlistp, tem);
+	{
+	  tem = wrong_type_argument (Qlistp, tem);
+	  goto again;
+	}
 while (CONSP (tem))
 	{
 	  tail = tem;
 	  tem = XCDR (tail);
 if (VECTORP (seq))
 {
 for (i = 0; i < leni; i++)
 	{
-	  dummy = vector_data (XVECTOR (seq))[i];
+	  dummy = XVECTOR_DATA (seq)[i];
 	  result = call1 (fn, dummy);
 	  if (vals)
 	    vals[i] = result;
 	}
 }
 mapcar1 (len, args, fn, seq);
 UNGCPRO;
 for (i = len - 1; i >= 0; i--)
 args[i + i] = args[i];
 for (i = 1; i < nargs; i += 2)
 args[i] = sep;
 return Fconcat (nargs, args);
 }
 if (featurep_emacs_version == 0.0)
 	{
 	  featurep_emacs_version = XINT (Vemacs_major_version) +
 	    (XINT (Vemacs_minor_version) / 100.0);
 	}
-return (featurep_emacs_version >= d) ? Qt : Qnil;
+return featurep_emacs_version >= d ? Qt : Qnil;
 }
 else if (CONSP(fexp))
 {
 Lisp_Object tem;

Mercurial > hg > xemacs-beta

comparison src/fns.c @ 173:8eaf7971accc r20-3b13