Mercurial > hg > xemacs-beta

comparison src/fns.c @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 84b14dcb0985
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
68 68
69 static void 69 static void
70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 70 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
71 { 71 {
72 size_t i; 72 size_t i;
73 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); 73 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
74 size_t len = bit_vector_length (v); 74 size_t len = bit_vector_length (v);
75 size_t last = len; 75 size_t last = len;
76 76
77 if (INTP (Vprint_length)) 77 if (INTP (Vprint_length))
78 last = min (len, XINT (Vprint_length)); 78 last = min (len, XINT (Vprint_length));
90 } 90 }
91 91
92 static int 92 static int
93 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 93 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
94 { 94 {
95 struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); 95 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
96 struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); 96 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
97 97
98 return ((bit_vector_length (v1) == bit_vector_length (v2)) && 98 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
99 !memcmp (v1->bits, v2->bits, 99 !memcmp (v1->bits, v2->bits,
100 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) * 100 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
101 sizeof (long))); 101 sizeof (long)));
102 } 102 }
103 103
104 static unsigned long 104 static unsigned long
105 bit_vector_hash (Lisp_Object obj, int depth) 105 bit_vector_hash (Lisp_Object obj, int depth)
106 { 106 {
107 struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); 107 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
108 return HASH2 (bit_vector_length (v), 108 return HASH2 (bit_vector_length (v),
109 memory_hash (v->bits, 109 memory_hash (v->bits,
110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * 110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
111 sizeof (long))); 111 sizeof (long)));
112 } 112 }
113 113
114 static const struct lrecord_description bit_vector_description[] = { 114 static const struct lrecord_description bit_vector_description[] = {
115 { XD_LISP_OBJECT, offsetof(Lisp_Bit_Vector, next), 1 }, 115 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) },
116 { XD_END } 116 { XD_END }
117 }; 117 };
118 118
119 119
120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, 120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector,
121 mark_bit_vector, print_bit_vector, 0, 121 mark_bit_vector, print_bit_vector, 0,
122 bit_vector_equal, bit_vector_hash, 122 bit_vector_equal, bit_vector_hash,
123 bit_vector_description, 123 bit_vector_description,
124 struct Lisp_Bit_Vector); 124 Lisp_Bit_Vector);
125 125
126 DEFUN ("identity", Fidentity, 1, 1, 0, /* 126 DEFUN ("identity", Fidentity, 1, 1, 0, /*
127 Return the argument unchanged. 127 Return the argument unchanged.
128 */ 128 */
129 (arg)) 129 (arg))
182 { 182 {
183 if (!COMPILED_FUNCTIONP (seq)) 183 if (!COMPILED_FUNCTIONP (seq))
184 return XINT (Flength (seq)); 184 return XINT (Flength (seq));
185 else 185 else
186 { 186 {
187 struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); 187 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq);
188 188
189 return (f->flags.interactivep ? COMPILED_INTERACTIVE : 189 return (f->flags.interactivep ? COMPILED_INTERACTIVE :
190 f->flags.domainp ? COMPILED_DOMAIN : 190 f->flags.domainp ? COMPILED_DOMAIN :
191 COMPILED_DOC_STRING) 191 COMPILED_DOC_STRING)
192 + 1; 192 + 1;
266 Symbols are also allowed; their print names are used instead. 266 Symbols are also allowed; their print names are used instead.
267 */ 267 */
268 (s1, s2)) 268 (s1, s2))
269 { 269 {
270 Bytecount len; 270 Bytecount len;
271 struct Lisp_String *p1, *p2; 271 Lisp_String *p1, *p2;
272 272
273 if (SYMBOLP (s1)) 273 if (SYMBOLP (s1))
274 p1 = XSYMBOL (s1)->name; 274 p1 = XSYMBOL (s1)->name;
275 else 275 else
276 { 276 {
313 Unicode. When Unicode support is added to XEmacs/Mule, this problem 313 Unicode. When Unicode support is added to XEmacs/Mule, this problem
314 may be solved. 314 may be solved.
315 */ 315 */
316 (s1, s2)) 316 (s1, s2))
317 { 317 {
318 struct Lisp_String *p1, *p2; 318 Lisp_String *p1, *p2;
319 Charcount end, len2; 319 Charcount end, len2;
320 int i; 320 int i;
321 321
322 if (SYMBOLP (s1)) 322 if (SYMBOLP (s1))
323 p1 = XSYMBOL (s1)->name; 323 p1 = XSYMBOL (s1)->name;
392 Each string has a tick counter which is incremented each time the contents 392 Each string has a tick counter which is incremented each time the contents
393 of the string are changed (e.g. with `aset'). It wraps around occasionally. 393 of the string are changed (e.g. with `aset'). It wraps around occasionally.
394 */ 394 */
395 (string)) 395 (string))
396 { 396 {
397 struct Lisp_String *s; 397 Lisp_String *s;
398 398
399 CHECK_STRING (string); 399 CHECK_STRING (string);
400 s = XSTRING (string); 400 s = XSTRING (string);
401 if (CONSP (s->plist) && INTP (XCAR (s->plist))) 401 if (CONSP (s->plist) && INTP (XCAR (s->plist)))
402 return XCAR (s->plist); 402 return XCAR (s->plist);
405 } 405 }
406 406
407 void 407 void
408 bump_string_modiff (Lisp_Object str) 408 bump_string_modiff (Lisp_Object str)
409 { 409 {
410 struct Lisp_String *s = XSTRING (str); 410 Lisp_String *s = XSTRING (str);
411 Lisp_Object *ptr = &s->plist; 411 Lisp_Object *ptr = &s->plist;
412 412
413 #ifdef I18N3 413 #ifdef I18N3
414 /* #### remove the `string-translatable' property from the string, 414 /* #### remove the `string-translatable' property from the string,
415 if there is one. */ 415 if there is one. */
2599 majority of cases, where the string is never modified and has no 2599 majority of cases, where the string is never modified and has no
2600 extent info. */ 2600 extent info. */
2601 2601
2602 2602
2603 static Lisp_Object * 2603 static Lisp_Object *
2604 string_plist_ptr (struct Lisp_String *s) 2604 string_plist_ptr (Lisp_String *s)
2605 { 2605 {
2606 Lisp_Object *ptr = &s->plist; 2606 Lisp_Object *ptr = &s->plist;
2607 2607
2608 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) 2608 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
2609 ptr = &XCDR (*ptr); 2609 ptr = &XCDR (*ptr);
2611 ptr = &XCDR (*ptr); 2611 ptr = &XCDR (*ptr);
2612 return ptr; 2612 return ptr;
2613 } 2613 }
2614 2614
2615 static Lisp_Object 2615 static Lisp_Object
2616 string_getprop (struct Lisp_String *s, Lisp_Object property, 2616 string_getprop (Lisp_String *s, Lisp_Object property,
2617 Lisp_Object default_) 2617 Lisp_Object default_)
2618 { 2618 {
2619 Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0, 2619 Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0,
2620 ERROR_ME); 2620 ERROR_ME);
2621 return UNBOUNDP (val) ? default_ : val; 2621 return UNBOUNDP (val) ? default_ : val;
2622 } 2622 }
2623 2623
2624 static void 2624 static void
2625 string_putprop (struct Lisp_String *s, Lisp_Object property, 2625 string_putprop (Lisp_String *s, Lisp_Object property,
2626 Lisp_Object value) 2626 Lisp_Object value)
2627 { 2627 {
2628 external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME); 2628 external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME);
2629 } 2629 }
2630 2630
2631 static int 2631 static int
2632 string_remprop (struct Lisp_String *s, Lisp_Object property) 2632 string_remprop (Lisp_String *s, Lisp_Object property)
2633 { 2633 {
2634 return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME); 2634 return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME);
2635 } 2635 }
2636 2636
2637 static Lisp_Object 2637 static Lisp_Object
2638 string_plist (struct Lisp_String *s) 2638 string_plist (Lisp_String *s)
2639 { 2639 {
2640 return *string_plist_ptr (s); 2640 return *string_plist_ptr (s);
2641 } 2641 }
2642 2642
2643 DEFUN ("get", Fget, 2, 3, 0, /* 2643 DEFUN ("get", Fget, 2, 3, 0, /*
2870 (array, item)) 2870 (array, item))
2871 { 2871 {
2872 retry: 2872 retry:
2873 if (STRINGP (array)) 2873 if (STRINGP (array))
2874 { 2874 {
2875 struct Lisp_String *s = XSTRING (array); 2875 Lisp_String *s = XSTRING (array);
2876 Bytecount old_bytecount = string_length (s); 2876 Bytecount old_bytecount = string_length (s);
2877 Bytecount new_bytecount; 2877 Bytecount new_bytecount;
2878 Bytecount item_bytecount; 2878 Bytecount item_bytecount;
2879 Bufbyte item_buf[MAX_EMCHAR_LEN]; 2879 Bufbyte item_buf[MAX_EMCHAR_LEN];
2880 Bufbyte *p; 2880 Bufbyte *p;
2904 while (len--) 2904 while (len--)
2905 *p++ = item; 2905 *p++ = item;
2906 } 2906 }
2907 else if (BIT_VECTORP (array)) 2907 else if (BIT_VECTORP (array))
2908 { 2908 {
2909 struct Lisp_Bit_Vector *v = XBIT_VECTOR (array); 2909 Lisp_Bit_Vector *v = XBIT_VECTOR (array);
2910 int len = bit_vector_length (v); 2910 int len = bit_vector_length (v);
2911 int bit; 2911 int bit;
2912 CHECK_BIT (item); 2912 CHECK_BIT (item);
2913 CHECK_LISP_WRITEABLE (array); 2913 CHECK_LISP_WRITEABLE (array);
2914 bit = XINT (item); 2914 bit = XINT (item);
3157 if (vals) vals[gcpro1.nvars++] = result; 3157 if (vals) vals[gcpro1.nvars++] = result;
3158 } 3158 }
3159 } 3159 }
3160 else if (BIT_VECTORP (sequence)) 3160 else if (BIT_VECTORP (sequence))
3161 { 3161 {
3162 struct Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); 3162 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence);
3163 for (i = 0; i < leni; i++) 3163 for (i = 0; i < leni; i++)
3164 { 3164 {
3165 args[1] = make_int (bit_vector_bit (v, i)); 3165 args[1] = make_int (bit_vector_bit (v, i));
3166 result = Ffuncall (2, args); 3166 result = Ffuncall (2, args);
3167 if (vals) vals[gcpro1.nvars++] = result; 3167 if (vals) vals[gcpro1.nvars++] = result;