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

Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 3ecd8885ac67
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
36 #include "buffer.h" 36 #include "buffer.h"
37 37
38 static Lisp_Object 38 static Lisp_Object
39 mark_marker (Lisp_Object obj) 39 mark_marker (Lisp_Object obj)
40 { 40 {
41 struct Lisp_Marker *marker = XMARKER (obj); 41 Lisp_Marker *marker = XMARKER (obj);
42 Lisp_Object buf; 42 Lisp_Object buf;
43 /* DO NOT mark through the marker's chain. 43 /* DO NOT mark through the marker's chain.
44 The buffer's markers chain does not preserve markers from gc; 44 The buffer's markers chain does not preserve markers from gc;
45 Instead, markers are removed from the chain when they are freed 45 Instead, markers are removed from the chain when they are freed
46 by gc. 46 by gc.
53 } 53 }
54 54
55 static void 55 static void
56 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 56 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
57 { 57 {
58 struct Lisp_Marker *marker = XMARKER (obj); 58 Lisp_Marker *marker = XMARKER (obj);
59 char buf[200]; 59 char buf[200];
60 60
61 if (print_readably) 61 if (print_readably)
62 error ("printing unreadable object #<marker 0x%lx>", (long) marker); 62 error ("printing unreadable object #<marker 0x%lx>", (long) marker);
63 63
75 } 75 }
76 76
77 static int 77 static int
78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
79 { 79 {
80 struct Lisp_Marker *marker1 = XMARKER (obj1); 80 Lisp_Marker *marker1 = XMARKER (obj1);
81 struct Lisp_Marker *marker2 = XMARKER (obj2); 81 Lisp_Marker *marker2 = XMARKER (obj2);
82 82
83 return ((marker1->buffer == marker2->buffer) && 83 return ((marker1->buffer == marker2->buffer) &&
84 (marker1->memind == marker2->memind || 84 (marker1->memind == marker2->memind ||
85 /* All markers pointing nowhere are equal */ 85 /* All markers pointing nowhere are equal */
86 !marker1->buffer)); 86 !marker1->buffer));
94 hash = HASH2 (hash, XMARKER (obj)->memind); 94 hash = HASH2 (hash, XMARKER (obj)->memind);
95 return hash; 95 return hash;
96 } 96 }
97 97
98 static const struct lrecord_description marker_description[] = { 98 static const struct lrecord_description marker_description[] = {
99 { XD_LISP_OBJECT, offsetof(struct Lisp_Marker, next), 3 }, 99 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next) },
100 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev) },
101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) },
100 { XD_END } 102 { XD_END }
101 }; 103 };
102 104
103 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 105 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
104 mark_marker, print_marker, 0, 106 mark_marker, print_marker, 0,
105 marker_equal, marker_hash, marker_description, 107 marker_equal, marker_hash, marker_description,
106 struct Lisp_Marker); 108 Lisp_Marker);
107 109
108 /* Operations on markers. */ 110 /* Operations on markers. */
109 111
110 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* 112 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
111 Return the buffer that MARKER points into, or nil if none. 113 Return the buffer that MARKER points into, or nil if none.
138 #if 0 /* useful debugging function */ 140 #if 0 /* useful debugging function */
139 141
140 static void 142 static void
141 check_marker_circularities (struct buffer *buf) 143 check_marker_circularities (struct buffer *buf)
142 { 144 {
143 struct Lisp_Marker *tortoise, *hare; 145 Lisp_Marker *tortoise, *hare;
144 146
145 tortoise = BUF_MARKERS (buf); 147 tortoise = BUF_MARKERS (buf);
146 hare = tortoise; 148 hare = tortoise;
147 149
148 if (!tortoise) 150 if (!tortoise)
169 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer, 171 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
170 int restricted_p) 172 int restricted_p)
171 { 173 {
172 Bufpos charno; 174 Bufpos charno;
173 struct buffer *b; 175 struct buffer *b;
174 struct Lisp_Marker *m; 176 Lisp_Marker *m;
175 int point_p; 177 int point_p;
176 178
177 CHECK_MARKER (marker); 179 CHECK_MARKER (marker);
178 180
179 point_p = POINT_MARKER_P (marker); 181 point_p = POINT_MARKER_P (marker);
285 including those in chain fields of markers. */ 287 including those in chain fields of markers. */
286 288
287 void 289 void
288 unchain_marker (Lisp_Object m) 290 unchain_marker (Lisp_Object m)
289 { 291 {
290 struct Lisp_Marker *marker = XMARKER (m); 292 Lisp_Marker *marker = XMARKER (m);
291 struct buffer *b = marker->buffer; 293 struct buffer *b = marker->buffer;
292 294
293 if (b == 0) 295 if (b == 0)
294 return; 296 return;
295 297
312 } 314 }
313 315
314 Bytind 316 Bytind
315 bi_marker_position (Lisp_Object marker) 317 bi_marker_position (Lisp_Object marker)
316 { 318 {
317 struct Lisp_Marker *m = XMARKER (marker); 319 Lisp_Marker *m = XMARKER (marker);
318 struct buffer *buf = m->buffer; 320 struct buffer *buf = m->buffer;
319 Bytind pos; 321 Bytind pos;
320 322
321 if (!buf) 323 if (!buf)
322 error ("Marker does not point anywhere"); 324 error ("Marker does not point anywhere");
349 } 351 }
350 352
351 void 353 void
352 set_bi_marker_position (Lisp_Object marker, Bytind pos) 354 set_bi_marker_position (Lisp_Object marker, Bytind pos)
353 { 355 {
354 struct Lisp_Marker *m = XMARKER (marker); 356 Lisp_Marker *m = XMARKER (marker);
355 struct buffer *buf = m->buffer; 357 struct buffer *buf = m->buffer;
356 358
357 if (!buf) 359 if (!buf)
358 error ("Marker does not point anywhere"); 360 error ("Marker does not point anywhere");
359 361
456 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* 458 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
457 Return t if there are markers pointing at POSITION in the current buffer. 459 Return t if there are markers pointing at POSITION in the current buffer.
458 */ 460 */
459 (position)) 461 (position))
460 { 462 {
461 struct Lisp_Marker *marker; 463 Lisp_Marker *marker;
462 Memind pos; 464 Memind pos;
463 465
464 /* A small optimization trick: convert POS to memind now, rather 466 /* A small optimization trick: convert POS to memind now, rather
465 than converting every marker's memory index to bufpos. */ 467 than converting every marker's memory index to bufpos. */
466 pos = bytind_to_memind (current_buffer, 468 pos = bytind_to_memind (current_buffer,
485 #ifdef MEMORY_USAGE_STATS 487 #ifdef MEMORY_USAGE_STATS
486 488
487 int 489 int
488 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) 490 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
489 { 491 {
490 struct Lisp_Marker *m; 492 Lisp_Marker *m;
491 int total = 0; 493 int total = 0;
492 int overhead; 494 int overhead;
493 495
494 for (m = BUF_MARKERS (b); m; m = m->next) 496 for (m = BUF_MARKERS (b); m; m = m->next)
495 total += sizeof (struct Lisp_Marker); 497 total += sizeof (Lisp_Marker);
496 ovstats->was_requested += total; 498 ovstats->was_requested += total;
497 overhead = fixed_type_block_overhead (total); 499 overhead = fixed_type_block_overhead (total);
498 /* #### claiming this is all malloc overhead is not really right, 500 /* #### claiming this is all malloc overhead is not really right,
499 but it has to go somewhere. */ 501 but it has to go somewhere. */
500 ovstats->malloc_overhead += overhead; 502 ovstats->malloc_overhead += overhead;
536 void 538 void
537 uninit_buffer_markers (struct buffer *b) 539 uninit_buffer_markers (struct buffer *b)
538 { 540 {
539 /* Unchain all markers of this buffer 541 /* Unchain all markers of this buffer
540 and leave them pointing nowhere. */ 542 and leave them pointing nowhere. */
541 REGISTER struct Lisp_Marker *m, *next; 543 REGISTER Lisp_Marker *m, *next;
542 for (m = BUF_MARKERS (b); m; m = next) 544 for (m = BUF_MARKERS (b); m; m = next)
543 { 545 {
544 m->buffer = 0; 546 m->buffer = 0;
545 next = marker_next (m); 547 next = marker_next (m);
546 marker_next (m) = 0; 548 marker_next (m) = 0;