Auto-commit of generated files.
[emacs.git] / src / ralloc.c
blob896ad9f3155b06fde7914f889f3d2c9fa2e777fb
1 /* Block-relocating memory allocator.
2 Copyright (C) 1993, 1995, 2000-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 /* NOTES:
21 Only relocate the blocs necessary for SIZE in r_alloc_sbrk,
22 rather than all of them. This means allowing for a possible
23 hole between the first bloc and the end of malloc storage. */
25 #ifdef emacs
27 #include <config.h>
28 #include <setjmp.h>
29 #include "lisp.h" /* Needed for VALBITS. */
30 #include "blockinput.h"
32 #include <unistd.h>
34 typedef POINTER_TYPE *POINTER;
35 typedef size_t SIZE;
37 #ifdef DOUG_LEA_MALLOC
38 #define M_TOP_PAD -2
39 extern int mallopt (int, int);
40 #else /* not DOUG_LEA_MALLOC */
41 #ifndef SYSTEM_MALLOC
42 extern size_t __malloc_extra_blocks;
43 #endif /* SYSTEM_MALLOC */
44 #endif /* not DOUG_LEA_MALLOC */
46 #else /* not emacs */
48 #include <stddef.h>
50 typedef size_t SIZE;
51 typedef void *POINTER;
53 #include <unistd.h>
54 #include <malloc.h>
56 #endif /* not emacs */
59 #include "getpagesize.h"
61 #define NIL ((POINTER) 0)
63 /* A flag to indicate whether we have initialized ralloc yet. For
64 Emacs's sake, please do not make this local to malloc_init; on some
65 machines, the dumping procedure makes all static variables
66 read-only. On these machines, the word static is #defined to be
67 the empty string, meaning that r_alloc_initialized becomes an
68 automatic variable, and loses its value each time Emacs is started
69 up. */
71 static int r_alloc_initialized = 0;
73 static void r_alloc_init (void);
76 /* Declarations for working with the malloc, ralloc, and system breaks. */
78 /* Function to set the real break value. */
79 POINTER (*real_morecore) (long int);
81 /* The break value, as seen by malloc. */
82 static POINTER virtual_break_value;
84 /* The address of the end of the last data in use by ralloc,
85 including relocatable blocs as well as malloc data. */
86 static POINTER break_value;
88 /* This is the size of a page. We round memory requests to this boundary. */
89 static int page_size;
91 /* Whenever we get memory from the system, get this many extra bytes. This
92 must be a multiple of page_size. */
93 static int extra_bytes;
95 /* Macros for rounding. Note that rounding to any value is possible
96 by changing the definition of PAGE. */
97 #define PAGE (getpagesize ())
98 #define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
99 #define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
100 & ~(page_size - 1))
101 #define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
103 #define MEM_ALIGN sizeof (double)
104 #define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
105 & ~(MEM_ALIGN - 1))
107 /* The hook `malloc' uses for the function which gets more space
108 from the system. */
110 #ifndef SYSTEM_MALLOC
111 extern POINTER (*__morecore) (long int);
112 #endif
116 /***********************************************************************
117 Implementation using sbrk
118 ***********************************************************************/
120 /* Data structures of heaps and blocs. */
122 /* The relocatable objects, or blocs, and the malloc data
123 both reside within one or more heaps.
124 Each heap contains malloc data, running from `start' to `bloc_start',
125 and relocatable objects, running from `bloc_start' to `free'.
127 Relocatable objects may relocate within the same heap
128 or may move into another heap; the heaps themselves may grow
129 but they never move.
131 We try to make just one heap and make it larger as necessary.
132 But sometimes we can't do that, because we can't get contiguous
133 space to add onto the heap. When that happens, we start a new heap. */
135 typedef struct heap
137 struct heap *next;
138 struct heap *prev;
139 /* Start of memory range of this heap. */
140 POINTER start;
141 /* End of memory range of this heap. */
142 POINTER end;
143 /* Start of relocatable data in this heap. */
144 POINTER bloc_start;
145 /* Start of unused space in this heap. */
146 POINTER free;
147 /* First bloc in this heap. */
148 struct bp *first_bloc;
149 /* Last bloc in this heap. */
150 struct bp *last_bloc;
151 } *heap_ptr;
153 #define NIL_HEAP ((heap_ptr) 0)
154 #define HEAP_PTR_SIZE (sizeof (struct heap))
156 /* This is the first heap object.
157 If we need additional heap objects, each one resides at the beginning of
158 the space it covers. */
159 static struct heap heap_base;
161 /* Head and tail of the list of heaps. */
162 static heap_ptr first_heap, last_heap;
164 /* These structures are allocated in the malloc arena.
165 The linked list is kept in order of increasing '.data' members.
166 The data blocks abut each other; if b->next is non-nil, then
167 b->data + b->size == b->next->data.
169 An element with variable==NIL denotes a freed block, which has not yet
170 been collected. They may only appear while r_alloc_freeze_level > 0,
171 and will be freed when the arena is thawed. Currently, these blocs are
172 not reusable, while the arena is frozen. Very inefficient. */
174 typedef struct bp
176 struct bp *next;
177 struct bp *prev;
178 POINTER *variable;
179 POINTER data;
180 SIZE size;
181 POINTER new_data; /* temporarily used for relocation */
182 struct heap *heap; /* Heap this bloc is in. */
183 } *bloc_ptr;
185 #define NIL_BLOC ((bloc_ptr) 0)
186 #define BLOC_PTR_SIZE (sizeof (struct bp))
188 /* Head and tail of the list of relocatable blocs. */
189 static bloc_ptr first_bloc, last_bloc;
191 static int use_relocatable_buffers;
193 /* If >0, no relocation whatsoever takes place. */
194 static int r_alloc_freeze_level;
197 /* Functions to get and return memory from the system. */
199 /* Find the heap that ADDRESS falls within. */
201 static heap_ptr
202 find_heap (POINTER address)
204 heap_ptr heap;
206 for (heap = last_heap; heap; heap = heap->prev)
208 if (heap->start <= address && address <= heap->end)
209 return heap;
212 return NIL_HEAP;
215 /* Find SIZE bytes of space in a heap.
216 Try to get them at ADDRESS (which must fall within some heap's range)
217 if we can get that many within one heap.
219 If enough space is not presently available in our reserve, this means
220 getting more page-aligned space from the system. If the returned space
221 is not contiguous to the last heap, allocate a new heap, and append it
222 to the heap list.
224 obtain does not try to keep track of whether space is in use or not
225 in use. It just returns the address of SIZE bytes that fall within a
226 single heap. If you call obtain twice in a row with the same arguments,
227 you typically get the same value. It's the caller's responsibility to
228 keep track of what space is in use.
230 Return the address of the space if all went well, or zero if we couldn't
231 allocate the memory. */
233 static POINTER
234 obtain (POINTER address, SIZE size)
236 heap_ptr heap;
237 SIZE already_available;
239 /* Find the heap that ADDRESS falls within. */
240 for (heap = last_heap; heap; heap = heap->prev)
242 if (heap->start <= address && address <= heap->end)
243 break;
246 if (! heap)
247 abort ();
249 /* If we can't fit SIZE bytes in that heap,
250 try successive later heaps. */
251 while (heap && (char *) address + size > (char *) heap->end)
253 heap = heap->next;
254 if (heap == NIL_HEAP)
255 break;
256 address = heap->bloc_start;
259 /* If we can't fit them within any existing heap,
260 get more space. */
261 if (heap == NIL_HEAP)
263 POINTER new = (*real_morecore)(0);
264 SIZE get;
266 already_available = (char *)last_heap->end - (char *)address;
268 if (new != last_heap->end)
270 /* Someone else called sbrk. Make a new heap. */
272 heap_ptr new_heap = (heap_ptr) MEM_ROUNDUP (new);
273 POINTER bloc_start = (POINTER) MEM_ROUNDUP ((POINTER)(new_heap + 1));
275 if ((*real_morecore) ((char *) bloc_start - (char *) new) != new)
276 return 0;
278 new_heap->start = new;
279 new_heap->end = bloc_start;
280 new_heap->bloc_start = bloc_start;
281 new_heap->free = bloc_start;
282 new_heap->next = NIL_HEAP;
283 new_heap->prev = last_heap;
284 new_heap->first_bloc = NIL_BLOC;
285 new_heap->last_bloc = NIL_BLOC;
286 last_heap->next = new_heap;
287 last_heap = new_heap;
289 address = bloc_start;
290 already_available = 0;
293 /* Add space to the last heap (which we may have just created).
294 Get some extra, so we can come here less often. */
296 get = size + extra_bytes - already_available;
297 get = (char *) ROUNDUP ((char *)last_heap->end + get)
298 - (char *) last_heap->end;
300 if ((*real_morecore) (get) != last_heap->end)
301 return 0;
303 last_heap->end = (char *) last_heap->end + get;
306 return address;
309 /* Return unused heap space to the system
310 if there is a lot of unused space now.
311 This can make the last heap smaller;
312 it can also eliminate the last heap entirely. */
314 static void
315 relinquish (void)
317 register heap_ptr h;
318 long excess = 0;
320 /* Add the amount of space beyond break_value
321 in all heaps which have extend beyond break_value at all. */
323 for (h = last_heap; h && break_value < h->end; h = h->prev)
325 excess += (char *) h->end - (char *) ((break_value < h->bloc_start)
326 ? h->bloc_start : break_value);
329 if (excess > extra_bytes * 2 && (*real_morecore) (0) == last_heap->end)
331 /* Keep extra_bytes worth of empty space.
332 And don't free anything unless we can free at least extra_bytes. */
333 excess -= extra_bytes;
335 if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess)
337 /* This heap should have no blocs in it. */
338 if (last_heap->first_bloc != NIL_BLOC
339 || last_heap->last_bloc != NIL_BLOC)
340 abort ();
342 /* Return the last heap, with its header, to the system. */
343 excess = (char *)last_heap->end - (char *)last_heap->start;
344 last_heap = last_heap->prev;
345 last_heap->next = NIL_HEAP;
347 else
349 excess = (char *) last_heap->end
350 - (char *) ROUNDUP ((char *)last_heap->end - excess);
351 last_heap->end = (char *) last_heap->end - excess;
354 if ((*real_morecore) (- excess) == 0)
356 /* If the system didn't want that much memory back, adjust
357 the end of the last heap to reflect that. This can occur
358 if break_value is still within the original data segment. */
359 last_heap->end = (char *) last_heap->end + excess;
360 /* Make sure that the result of the adjustment is accurate.
361 It should be, for the else clause above; the other case,
362 which returns the entire last heap to the system, seems
363 unlikely to trigger this mode of failure. */
364 if (last_heap->end != (*real_morecore) (0))
365 abort ();
370 /* Return the total size in use by relocating allocator,
371 above where malloc gets space. */
373 long
374 r_alloc_size_in_use (void)
376 return (char *) break_value - (char *) virtual_break_value;
379 /* The meat - allocating, freeing, and relocating blocs. */
381 /* Find the bloc referenced by the address in PTR. Returns a pointer
382 to that block. */
384 static bloc_ptr
385 find_bloc (POINTER *ptr)
387 register bloc_ptr p = first_bloc;
389 while (p != NIL_BLOC)
391 /* Consistency check. Don't return inconsistent blocs.
392 Don't abort here, as callers might be expecting this, but
393 callers that always expect a bloc to be returned should abort
394 if one isn't to avoid a memory corruption bug that is
395 difficult to track down. */
396 if (p->variable == ptr && p->data == *ptr)
397 return p;
399 p = p->next;
402 return p;
405 /* Allocate a bloc of SIZE bytes and append it to the chain of blocs.
406 Returns a pointer to the new bloc, or zero if we couldn't allocate
407 memory for the new block. */
409 static bloc_ptr
410 get_bloc (SIZE size)
412 register bloc_ptr new_bloc;
413 register heap_ptr heap;
415 if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE))
416 || ! (new_bloc->data = obtain (break_value, size)))
418 free (new_bloc);
420 return 0;
423 break_value = (char *) new_bloc->data + size;
425 new_bloc->size = size;
426 new_bloc->next = NIL_BLOC;
427 new_bloc->variable = (POINTER *) NIL;
428 new_bloc->new_data = 0;
430 /* Record in the heap that this space is in use. */
431 heap = find_heap (new_bloc->data);
432 heap->free = break_value;
434 /* Maintain the correspondence between heaps and blocs. */
435 new_bloc->heap = heap;
436 heap->last_bloc = new_bloc;
437 if (heap->first_bloc == NIL_BLOC)
438 heap->first_bloc = new_bloc;
440 /* Put this bloc on the doubly-linked list of blocs. */
441 if (first_bloc)
443 new_bloc->prev = last_bloc;
444 last_bloc->next = new_bloc;
445 last_bloc = new_bloc;
447 else
449 first_bloc = last_bloc = new_bloc;
450 new_bloc->prev = NIL_BLOC;
453 return new_bloc;
456 /* Calculate new locations of blocs in the list beginning with BLOC,
457 relocating it to start at ADDRESS, in heap HEAP. If enough space is
458 not presently available in our reserve, call obtain for
459 more space.
461 Store the new location of each bloc in its new_data field.
462 Do not touch the contents of blocs or break_value. */
464 static int
465 relocate_blocs (bloc_ptr bloc, heap_ptr heap, POINTER address)
467 register bloc_ptr b = bloc;
469 /* No need to ever call this if arena is frozen, bug somewhere! */
470 if (r_alloc_freeze_level)
471 abort ();
473 while (b)
475 /* If bloc B won't fit within HEAP,
476 move to the next heap and try again. */
477 while (heap && (char *) address + b->size > (char *) heap->end)
479 heap = heap->next;
480 if (heap == NIL_HEAP)
481 break;
482 address = heap->bloc_start;
485 /* If BLOC won't fit in any heap,
486 get enough new space to hold BLOC and all following blocs. */
487 if (heap == NIL_HEAP)
489 register bloc_ptr tb = b;
490 register SIZE s = 0;
492 /* Add up the size of all the following blocs. */
493 while (tb != NIL_BLOC)
495 if (tb->variable)
496 s += tb->size;
498 tb = tb->next;
501 /* Get that space. */
502 address = obtain (address, s);
503 if (address == 0)
504 return 0;
506 heap = last_heap;
509 /* Record the new address of this bloc
510 and update where the next bloc can start. */
511 b->new_data = address;
512 if (b->variable)
513 address = (char *) address + b->size;
514 b = b->next;
517 return 1;
520 /* Update the records of which heaps contain which blocs, starting
521 with heap HEAP and bloc BLOC. */
523 static void
524 update_heap_bloc_correspondence (bloc_ptr bloc, heap_ptr heap)
526 register bloc_ptr b;
528 /* Initialize HEAP's status to reflect blocs before BLOC. */
529 if (bloc != NIL_BLOC && bloc->prev != NIL_BLOC && bloc->prev->heap == heap)
531 /* The previous bloc is in HEAP. */
532 heap->last_bloc = bloc->prev;
533 heap->free = (char *) bloc->prev->data + bloc->prev->size;
535 else
537 /* HEAP contains no blocs before BLOC. */
538 heap->first_bloc = NIL_BLOC;
539 heap->last_bloc = NIL_BLOC;
540 heap->free = heap->bloc_start;
543 /* Advance through blocs one by one. */
544 for (b = bloc; b != NIL_BLOC; b = b->next)
546 /* Advance through heaps, marking them empty,
547 till we get to the one that B is in. */
548 while (heap)
550 if (heap->bloc_start <= b->data && b->data <= heap->end)
551 break;
552 heap = heap->next;
553 /* We know HEAP is not null now,
554 because there has to be space for bloc B. */
555 heap->first_bloc = NIL_BLOC;
556 heap->last_bloc = NIL_BLOC;
557 heap->free = heap->bloc_start;
560 /* Update HEAP's status for bloc B. */
561 heap->free = (char *) b->data + b->size;
562 heap->last_bloc = b;
563 if (heap->first_bloc == NIL_BLOC)
564 heap->first_bloc = b;
566 /* Record that B is in HEAP. */
567 b->heap = heap;
570 /* If there are any remaining heaps and no blocs left,
571 mark those heaps as empty. */
572 heap = heap->next;
573 while (heap)
575 heap->first_bloc = NIL_BLOC;
576 heap->last_bloc = NIL_BLOC;
577 heap->free = heap->bloc_start;
578 heap = heap->next;
582 /* Resize BLOC to SIZE bytes. This relocates the blocs
583 that come after BLOC in memory. */
585 static int
586 resize_bloc (bloc_ptr bloc, SIZE size)
588 register bloc_ptr b;
589 heap_ptr heap;
590 POINTER address;
591 SIZE old_size;
593 /* No need to ever call this if arena is frozen, bug somewhere! */
594 if (r_alloc_freeze_level)
595 abort ();
597 if (bloc == NIL_BLOC || size == bloc->size)
598 return 1;
600 for (heap = first_heap; heap != NIL_HEAP; heap = heap->next)
602 if (heap->bloc_start <= bloc->data && bloc->data <= heap->end)
603 break;
606 if (heap == NIL_HEAP)
607 abort ();
609 old_size = bloc->size;
610 bloc->size = size;
612 /* Note that bloc could be moved into the previous heap. */
613 address = (bloc->prev ? (char *) bloc->prev->data + bloc->prev->size
614 : (char *) first_heap->bloc_start);
615 while (heap)
617 if (heap->bloc_start <= address && address <= heap->end)
618 break;
619 heap = heap->prev;
622 if (! relocate_blocs (bloc, heap, address))
624 bloc->size = old_size;
625 return 0;
628 if (size > old_size)
630 for (b = last_bloc; b != bloc; b = b->prev)
632 if (!b->variable)
634 b->size = 0;
635 b->data = b->new_data;
637 else
639 if (b->new_data != b->data)
640 memmove (b->new_data, b->data, b->size);
641 *b->variable = b->data = b->new_data;
644 if (!bloc->variable)
646 bloc->size = 0;
647 bloc->data = bloc->new_data;
649 else
651 if (bloc->new_data != bloc->data)
652 memmove (bloc->new_data, bloc->data, old_size);
653 memset ((char *) bloc->new_data + old_size, 0, size - old_size);
654 *bloc->variable = bloc->data = bloc->new_data;
657 else
659 for (b = bloc; b != NIL_BLOC; b = b->next)
661 if (!b->variable)
663 b->size = 0;
664 b->data = b->new_data;
666 else
668 if (b->new_data != b->data)
669 memmove (b->new_data, b->data, b->size);
670 *b->variable = b->data = b->new_data;
675 update_heap_bloc_correspondence (bloc, heap);
677 break_value = (last_bloc ? (char *) last_bloc->data + last_bloc->size
678 : (char *) first_heap->bloc_start);
679 return 1;
682 /* Free BLOC from the chain of blocs, relocating any blocs above it.
683 This may return space to the system. */
685 static void
686 free_bloc (bloc_ptr bloc)
688 heap_ptr heap = bloc->heap;
690 if (r_alloc_freeze_level)
692 bloc->variable = (POINTER *) NIL;
693 return;
696 resize_bloc (bloc, 0);
698 if (bloc == first_bloc && bloc == last_bloc)
700 first_bloc = last_bloc = NIL_BLOC;
702 else if (bloc == last_bloc)
704 last_bloc = bloc->prev;
705 last_bloc->next = NIL_BLOC;
707 else if (bloc == first_bloc)
709 first_bloc = bloc->next;
710 first_bloc->prev = NIL_BLOC;
712 else
714 bloc->next->prev = bloc->prev;
715 bloc->prev->next = bloc->next;
718 /* Update the records of which blocs are in HEAP. */
719 if (heap->first_bloc == bloc)
721 if (bloc->next != 0 && bloc->next->heap == heap)
722 heap->first_bloc = bloc->next;
723 else
724 heap->first_bloc = heap->last_bloc = NIL_BLOC;
726 if (heap->last_bloc == bloc)
728 if (bloc->prev != 0 && bloc->prev->heap == heap)
729 heap->last_bloc = bloc->prev;
730 else
731 heap->first_bloc = heap->last_bloc = NIL_BLOC;
734 relinquish ();
735 free (bloc);
738 /* Interface routines. */
740 /* Obtain SIZE bytes of storage from the free pool, or the system, as
741 necessary. If relocatable blocs are in use, this means relocating
742 them. This function gets plugged into the GNU malloc's __morecore
743 hook.
745 We provide hysteresis, never relocating by less than extra_bytes.
747 If we're out of memory, we should return zero, to imitate the other
748 __morecore hook values - in particular, __default_morecore in the
749 GNU malloc package. */
751 POINTER
752 r_alloc_sbrk (long int size)
754 register bloc_ptr b;
755 POINTER address;
757 if (! r_alloc_initialized)
758 r_alloc_init ();
760 if (! use_relocatable_buffers)
761 return (*real_morecore) (size);
763 if (size == 0)
764 return virtual_break_value;
766 if (size > 0)
768 /* Allocate a page-aligned space. GNU malloc would reclaim an
769 extra space if we passed an unaligned one. But we could
770 not always find a space which is contiguous to the previous. */
771 POINTER new_bloc_start;
772 heap_ptr h = first_heap;
773 SIZE get = ROUNDUP (size);
775 address = (POINTER) ROUNDUP (virtual_break_value);
777 /* Search the list upward for a heap which is large enough. */
778 while ((char *) h->end < (char *) MEM_ROUNDUP ((char *)address + get))
780 h = h->next;
781 if (h == NIL_HEAP)
782 break;
783 address = (POINTER) ROUNDUP (h->start);
786 /* If not found, obtain more space. */
787 if (h == NIL_HEAP)
789 get += extra_bytes + page_size;
791 if (! obtain (address, get))
792 return 0;
794 if (first_heap == last_heap)
795 address = (POINTER) ROUNDUP (virtual_break_value);
796 else
797 address = (POINTER) ROUNDUP (last_heap->start);
798 h = last_heap;
801 new_bloc_start = (POINTER) MEM_ROUNDUP ((char *)address + get);
803 if (first_heap->bloc_start < new_bloc_start)
805 /* This is no clean solution - no idea how to do it better. */
806 if (r_alloc_freeze_level)
807 return NIL;
809 /* There is a bug here: if the above obtain call succeeded, but the
810 relocate_blocs call below does not succeed, we need to free
811 the memory that we got with obtain. */
813 /* Move all blocs upward. */
814 if (! relocate_blocs (first_bloc, h, new_bloc_start))
815 return 0;
817 /* Note that (POINTER)(h+1) <= new_bloc_start since
818 get >= page_size, so the following does not destroy the heap
819 header. */
820 for (b = last_bloc; b != NIL_BLOC; b = b->prev)
822 if (b->new_data != b->data)
823 memmove (b->new_data, b->data, b->size);
824 *b->variable = b->data = b->new_data;
827 h->bloc_start = new_bloc_start;
829 update_heap_bloc_correspondence (first_bloc, h);
831 if (h != first_heap)
833 /* Give up managing heaps below the one the new
834 virtual_break_value points to. */
835 first_heap->prev = NIL_HEAP;
836 first_heap->next = h->next;
837 first_heap->start = h->start;
838 first_heap->end = h->end;
839 first_heap->free = h->free;
840 first_heap->first_bloc = h->first_bloc;
841 first_heap->last_bloc = h->last_bloc;
842 first_heap->bloc_start = h->bloc_start;
844 if (first_heap->next)
845 first_heap->next->prev = first_heap;
846 else
847 last_heap = first_heap;
850 memset (address, 0, size);
852 else /* size < 0 */
854 SIZE excess = (char *)first_heap->bloc_start
855 - ((char *)virtual_break_value + size);
857 address = virtual_break_value;
859 if (r_alloc_freeze_level == 0 && excess > 2 * extra_bytes)
861 excess -= extra_bytes;
862 first_heap->bloc_start
863 = (POINTER) MEM_ROUNDUP ((char *)first_heap->bloc_start - excess);
865 relocate_blocs (first_bloc, first_heap, first_heap->bloc_start);
867 for (b = first_bloc; b != NIL_BLOC; b = b->next)
869 if (b->new_data != b->data)
870 memmove (b->new_data, b->data, b->size);
871 *b->variable = b->data = b->new_data;
875 if ((char *)virtual_break_value + size < (char *)first_heap->start)
877 /* We found an additional space below the first heap */
878 first_heap->start = (POINTER) ((char *)virtual_break_value + size);
882 virtual_break_value = (POINTER) ((char *)address + size);
883 break_value = (last_bloc
884 ? (char *) last_bloc->data + last_bloc->size
885 : (char *) first_heap->bloc_start);
886 if (size < 0)
887 relinquish ();
889 return address;
893 /* Allocate a relocatable bloc of storage of size SIZE. A pointer to
894 the data is returned in *PTR. PTR is thus the address of some variable
895 which will use the data area.
897 The allocation of 0 bytes is valid.
898 In case r_alloc_freeze_level is set, a best fit of unused blocs could be
899 done before allocating a new area. Not yet done.
901 If we can't allocate the necessary memory, set *PTR to zero, and
902 return zero. */
904 POINTER
905 r_alloc (POINTER *ptr, SIZE size)
907 register bloc_ptr new_bloc;
909 if (! r_alloc_initialized)
910 r_alloc_init ();
912 new_bloc = get_bloc (MEM_ROUNDUP (size));
913 if (new_bloc)
915 new_bloc->variable = ptr;
916 *ptr = new_bloc->data;
918 else
919 *ptr = 0;
921 return *ptr;
924 /* Free a bloc of relocatable storage whose data is pointed to by PTR.
925 Store 0 in *PTR to show there's no block allocated. */
927 void
928 r_alloc_free (register POINTER *ptr)
930 register bloc_ptr dead_bloc;
932 if (! r_alloc_initialized)
933 r_alloc_init ();
935 dead_bloc = find_bloc (ptr);
936 if (dead_bloc == NIL_BLOC)
937 abort (); /* Double free? PTR not originally used to allocate? */
939 free_bloc (dead_bloc);
940 *ptr = 0;
942 #ifdef emacs
943 refill_memory_reserve ();
944 #endif
947 /* Given a pointer at address PTR to relocatable data, resize it to SIZE.
948 Do this by shifting all blocks above this one up in memory, unless
949 SIZE is less than or equal to the current bloc size, in which case
950 do nothing.
952 In case r_alloc_freeze_level is set, a new bloc is allocated, and the
953 memory copied to it. Not very efficient. We could traverse the
954 bloc_list for a best fit of free blocs first.
956 Change *PTR to reflect the new bloc, and return this value.
958 If more memory cannot be allocated, then leave *PTR unchanged, and
959 return zero. */
961 POINTER
962 r_re_alloc (POINTER *ptr, SIZE size)
964 register bloc_ptr bloc;
966 if (! r_alloc_initialized)
967 r_alloc_init ();
969 if (!*ptr)
970 return r_alloc (ptr, size);
971 if (!size)
973 r_alloc_free (ptr);
974 return r_alloc (ptr, 0);
977 bloc = find_bloc (ptr);
978 if (bloc == NIL_BLOC)
979 abort (); /* Already freed? PTR not originally used to allocate? */
981 if (size < bloc->size)
983 /* Wouldn't it be useful to actually resize the bloc here? */
984 /* I think so too, but not if it's too expensive... */
985 if ((bloc->size - MEM_ROUNDUP (size) >= page_size)
986 && r_alloc_freeze_level == 0)
988 resize_bloc (bloc, MEM_ROUNDUP (size));
989 /* Never mind if this fails, just do nothing... */
990 /* It *should* be infallible! */
993 else if (size > bloc->size)
995 if (r_alloc_freeze_level)
997 bloc_ptr new_bloc;
998 new_bloc = get_bloc (MEM_ROUNDUP (size));
999 if (new_bloc)
1001 new_bloc->variable = ptr;
1002 *ptr = new_bloc->data;
1003 bloc->variable = (POINTER *) NIL;
1005 else
1006 return NIL;
1008 else
1010 if (! resize_bloc (bloc, MEM_ROUNDUP (size)))
1011 return NIL;
1014 return *ptr;
1017 /* Disable relocations, after making room for at least SIZE bytes
1018 of non-relocatable heap if possible. The relocatable blocs are
1019 guaranteed to hold still until thawed, even if this means that
1020 malloc must return a null pointer. */
1022 void
1023 r_alloc_freeze (long int size)
1025 if (! r_alloc_initialized)
1026 r_alloc_init ();
1028 /* If already frozen, we can't make any more room, so don't try. */
1029 if (r_alloc_freeze_level > 0)
1030 size = 0;
1031 /* If we can't get the amount requested, half is better than nothing. */
1032 while (size > 0 && r_alloc_sbrk (size) == 0)
1033 size /= 2;
1034 ++r_alloc_freeze_level;
1035 if (size > 0)
1036 r_alloc_sbrk (-size);
1039 void
1040 r_alloc_thaw (void)
1043 if (! r_alloc_initialized)
1044 r_alloc_init ();
1046 if (--r_alloc_freeze_level < 0)
1047 abort ();
1049 /* This frees all unused blocs. It is not too inefficient, as the resize
1050 and memcpy is done only once. Afterwards, all unreferenced blocs are
1051 already shrunk to zero size. */
1052 if (!r_alloc_freeze_level)
1054 bloc_ptr *b = &first_bloc;
1055 while (*b)
1056 if (!(*b)->variable)
1057 free_bloc (*b);
1058 else
1059 b = &(*b)->next;
1064 #if defined (emacs) && defined (DOUG_LEA_MALLOC)
1066 /* Reinitialize the morecore hook variables after restarting a dumped
1067 Emacs. This is needed when using Doug Lea's malloc from GNU libc. */
1068 void
1069 r_alloc_reinit (void)
1071 /* Only do this if the hook has been reset, so that we don't get an
1072 infinite loop, in case Emacs was linked statically. */
1073 if (__morecore != r_alloc_sbrk)
1075 real_morecore = __morecore;
1076 __morecore = r_alloc_sbrk;
1080 #endif /* emacs && DOUG_LEA_MALLOC */
1082 #ifdef DEBUG
1084 #include <assert.h>
1086 void
1087 r_alloc_check (void)
1089 int found = 0;
1090 heap_ptr h, ph = 0;
1091 bloc_ptr b, pb = 0;
1093 if (!r_alloc_initialized)
1094 return;
1096 assert (first_heap);
1097 assert (last_heap->end <= (POINTER) sbrk (0));
1098 assert ((POINTER) first_heap < first_heap->start);
1099 assert (first_heap->start <= virtual_break_value);
1100 assert (virtual_break_value <= first_heap->end);
1102 for (h = first_heap; h; h = h->next)
1104 assert (h->prev == ph);
1105 assert ((POINTER) ROUNDUP (h->end) == h->end);
1106 #if 0 /* ??? The code in ralloc.c does not really try to ensure
1107 the heap start has any sort of alignment.
1108 Perhaps it should. */
1109 assert ((POINTER) MEM_ROUNDUP (h->start) == h->start);
1110 #endif
1111 assert ((POINTER) MEM_ROUNDUP (h->bloc_start) == h->bloc_start);
1112 assert (h->start <= h->bloc_start && h->bloc_start <= h->end);
1114 if (ph)
1116 assert (ph->end < h->start);
1117 assert (h->start <= (POINTER)h && (POINTER)(h+1) <= h->bloc_start);
1120 if (h->bloc_start <= break_value && break_value <= h->end)
1121 found = 1;
1123 ph = h;
1126 assert (found);
1127 assert (last_heap == ph);
1129 for (b = first_bloc; b; b = b->next)
1131 assert (b->prev == pb);
1132 assert ((POINTER) MEM_ROUNDUP (b->data) == b->data);
1133 assert ((SIZE) MEM_ROUNDUP (b->size) == b->size);
1135 ph = 0;
1136 for (h = first_heap; h; h = h->next)
1138 if (h->bloc_start <= b->data && b->data + b->size <= h->end)
1139 break;
1140 ph = h;
1143 assert (h);
1145 if (pb && pb->data + pb->size != b->data)
1147 assert (ph && b->data == h->bloc_start);
1148 while (ph)
1150 if (ph->bloc_start <= pb->data
1151 && pb->data + pb->size <= ph->end)
1153 assert (pb->data + pb->size + b->size > ph->end);
1154 break;
1156 else
1158 assert (ph->bloc_start + b->size > ph->end);
1160 ph = ph->prev;
1163 pb = b;
1166 assert (last_bloc == pb);
1168 if (last_bloc)
1169 assert (last_bloc->data + last_bloc->size == break_value);
1170 else
1171 assert (first_heap->bloc_start == break_value);
1174 #endif /* DEBUG */
1176 /* Update the internal record of which variable points to some data to NEW.
1177 Used by buffer-swap-text in Emacs to restore consistency after it
1178 swaps the buffer text between two buffer objects. The OLD pointer
1179 is checked to ensure that memory corruption does not occur due to
1180 misuse. */
1181 void
1182 r_alloc_reset_variable (POINTER *old, POINTER *new)
1184 bloc_ptr bloc = first_bloc;
1186 /* Find the bloc that corresponds to the data pointed to by pointer.
1187 find_bloc cannot be used, as it has internal consistency checks
1188 which fail when the variable needs resetting. */
1189 while (bloc != NIL_BLOC)
1191 if (bloc->data == *new)
1192 break;
1194 bloc = bloc->next;
1197 if (bloc == NIL_BLOC || bloc->variable != old)
1198 abort (); /* Already freed? OLD not originally used to allocate? */
1200 /* Update variable to point to the new location. */
1201 bloc->variable = new;
1205 /***********************************************************************
1206 Initialization
1207 ***********************************************************************/
1209 /* Initialize various things for memory allocation. */
1211 static void
1212 r_alloc_init (void)
1214 if (r_alloc_initialized)
1215 return;
1216 r_alloc_initialized = 1;
1218 page_size = PAGE;
1219 #ifndef SYSTEM_MALLOC
1220 real_morecore = __morecore;
1221 __morecore = r_alloc_sbrk;
1223 first_heap = last_heap = &heap_base;
1224 first_heap->next = first_heap->prev = NIL_HEAP;
1225 first_heap->start = first_heap->bloc_start
1226 = virtual_break_value = break_value = (*real_morecore) (0);
1227 if (break_value == NIL)
1228 abort ();
1230 extra_bytes = ROUNDUP (50000);
1231 #endif
1233 #ifdef DOUG_LEA_MALLOC
1234 BLOCK_INPUT;
1235 mallopt (M_TOP_PAD, 64 * 4096);
1236 UNBLOCK_INPUT;
1237 #else
1238 #ifndef SYSTEM_MALLOC
1239 /* Give GNU malloc's morecore some hysteresis
1240 so that we move all the relocatable blocks much less often. */
1241 __malloc_extra_blocks = 64;
1242 #endif
1243 #endif
1245 #ifndef SYSTEM_MALLOC
1246 first_heap->end = (POINTER) ROUNDUP (first_heap->start);
1248 /* The extra call to real_morecore guarantees that the end of the
1249 address space is a multiple of page_size, even if page_size is
1250 not really the page size of the system running the binary in
1251 which page_size is stored. This allows a binary to be built on a
1252 system with one page size and run on a system with a smaller page
1253 size. */
1254 (*real_morecore) ((char *) first_heap->end - (char *) first_heap->start);
1256 /* Clear the rest of the last page; this memory is in our address space
1257 even though it is after the sbrk value. */
1258 /* Doubly true, with the additional call that explicitly adds the
1259 rest of that page to the address space. */
1260 memset (first_heap->start, 0,
1261 (char *) first_heap->end - (char *) first_heap->start);
1262 virtual_break_value = break_value = first_heap->bloc_start = first_heap->end;
1263 #endif
1265 use_relocatable_buffers = 1;