annotate src/ralloc.c @ 5041:efaa6cd845e5

add regexp-debugging -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-02-15 Ben Wing <ben@xemacs.org> * regex.c: * regex.c (DEBUG_FAIL_PRINT1): * regex.c (PUSH_FAILURE_POINT): * regex.c (POP_FAILURE_POINT): * regex.c (regex_compile): * regex.c (re_match_2_internal): * regex.h: * search.c: * search.c (search_buffer): * search.c (debug_regexps_changed): * search.c (vars_of_search): Add an internal variable debug_regexps and a corresponding Lisp variable `debug-regexps' that takes a list of areas in which to display debugging info about regex compilation and matching (currently three areas exist). Use existing debugging code already in regex.c and modify it so that it recognizes the debug_regexps variable and the flags in it. Rename variable `debug-xemacs-searches' to just `debug-searches', consistent with other debug vars. tests/ChangeLog addition: 2010-02-15 Ben Wing <ben@xemacs.org> * automated/search-tests.el (let): * automated/search-tests.el (boundp): debug-xemacs-searches renamed to debug-searches.
author Ben Wing <ben@xemacs.org>
date Mon, 15 Feb 2010 21:51:22 -0600
parents d674024a8674
children 6f2158fa75ed
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Block-relocating memory allocator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Synched Up with: FSF 20.2 (non-mmap portion only)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* NOTES:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 Only relocate the blocs necessary for SIZE in r_alloc_sbrk,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 rather than all of them. This means allowing for a possible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 hole between the first bloc and the end of malloc storage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #ifdef HAVE_CONFIG_H
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #ifdef HAVE_UNISTD_H
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include <unistd.h> /* for getpagesize() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #ifdef emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* The important properties of this type are that 1) it's a pointer, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 2) arithmetic on it should work as if the size of the object pointed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 to has a size of 1. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #if 0 /* Arithmetic on void* is a GCC extension. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #ifdef __STDC__
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 typedef void *POINTER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 typedef unsigned char *POINTER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* Unconditionally use unsigned char * for this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 typedef unsigned char *POINTER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #define M_TOP_PAD -2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #include <malloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #include "getpagesize.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #include <string.h>
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3025
diff changeset
64 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 void refill_memory_reserve (void);
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3025
diff changeset
66 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #else /* Not emacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
70 #define REGEX_MALLOC_CHECK()
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
71
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #include <stddef.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 typedef void *POINTER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #include <unistd.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 #include <malloc.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 #include <string.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #endif /* emacs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 void init_ralloc (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 #define NIL ((POINTER) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 /* A flag to indicate whether we have initialized ralloc yet. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Emacs's sake, please do not make this local to malloc_init; on some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 machines, the dumping procedure makes all static variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 read-only. On these machines, the word static is #defined to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 the empty string, meaning that r_alloc_initialized becomes an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 automatic variable, and loses its value each time Emacs is started up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 static int r_alloc_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 /* Declarations for working with the malloc, ralloc, and system breaks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 /* Function to set the real break value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 static POINTER (*real_morecore) (ptrdiff_t size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 /* The break value, as seen by malloc (). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 static POINTER virtual_break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 /* The break value, viewed by the relocatable blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 static POINTER break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 /* This is the size of a page. We round memory requests to this boundary. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 static int page_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* Whenever we get memory from the system, get this many extra bytes. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 must be a multiple of page_size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 static int extra_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 /* Macros for rounding. Note that rounding to any value is possible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 by changing the definition of PAGE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define PAGE (getpagesize ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 #define ALIGNED(addr) (((unsigned long int) (addr) & (page_size - 1)) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #define ROUNDUP(size) (((unsigned long int) (size) + page_size - 1) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 & ~(page_size - 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 #define ROUND_TO_PAGE(addr) (addr & (~(page_size - 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 #define MEM_ALIGN sizeof(double)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 #define MEM_ROUNDUP(addr) (((unsigned long int)(addr) + MEM_ALIGN - 1) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 & ~(MEM_ALIGN - 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 /* Data structures of heaps and blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 /* The relocatable objects, or blocs, and the malloc data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 both reside within one or more heaps.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Each heap contains malloc data, running from `start' to `bloc_start',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 and relocatable objects, running from `bloc_start' to `free'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Relocatable objects may relocate within the same heap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 or may move into another heap; the heaps themselves may grow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 but they never move.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 We try to make just one heap and make it larger as necessary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 But sometimes we can't do that, because we can't get contiguous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 space to add onto the heap. When that happens, we start a new heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 typedef struct heap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 struct heap *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 struct heap *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 /* Start of memory range of this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 POINTER start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 /* End of memory range of this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 POINTER end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 /* Start of relocatable data in this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 POINTER bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 /* Start of unused space in this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 POINTER free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 /* First bloc in this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 struct bp *first_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* Last bloc in this heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 struct bp *last_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 } *heap_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 #define NIL_HEAP ((heap_ptr) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 #define HEAP_PTR_SIZE (sizeof (struct heap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 /* This is the first heap object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 If we need additional heap objects, each one resides at the beginning of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 the space it covers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 static struct heap heap_base;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 /* Head and tail of the list of heaps. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 static heap_ptr first_heap, last_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 /* These structures are allocated in the malloc arena.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 The linked list is kept in order of increasing '.data' members.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 The data blocks abut each other; if b->next is non-nil, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 b->data + b->size == b->next->data.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 An element with variable==NIL denotes a freed block, which has not yet
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 been collected. They may only appear while r_alloc_freeze > 0, and will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 freed when the arena is thawed. Currently, these blocs are not reusable,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 while the arena is frozen. Very inefficient. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 typedef struct bp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 struct bp *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 struct bp *prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 POINTER *variable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 POINTER data;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
188 size_t size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 POINTER new_data; /* temporarily used for relocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 struct heap *heap; /* Heap this bloc is in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 } *bloc_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 #define NIL_BLOC ((bloc_ptr) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 #define BLOC_PTR_SIZE (sizeof (struct bp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 /* Head and tail of the list of relocatable blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 static bloc_ptr first_bloc, last_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 static int use_relocatable_buffers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 /* If >0, no relocation whatsoever takes place. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 static int r_alloc_freeze_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 /* Obtain SIZE bytes of space. If enough space is not presently available
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 in our process reserve, (i.e., (page_break_value - break_value)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 this means getting more page-aligned space from the system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Return non-zero if all went well, or zero if we couldn't allocate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 the memory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Functions to get and return memory from the system. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 /* Find the heap that ADDRESS falls within. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 static heap_ptr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 find_heap (POINTER address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 heap_ptr heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 for (heap = last_heap; heap; heap = heap->prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 if (heap->start <= address && address <= heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 return NIL_HEAP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 /* Find SIZE bytes of space in a heap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Try to get them at ADDRESS (which must fall within some heap's range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 if we can get that many within one heap.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 If enough space is not presently available in our reserve, this means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 getting more page-aligned space from the system. If the returned space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 is not contiguous to the last heap, allocate a new heap, and append it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 obtain does not try to keep track of whether space is in use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 or not in use. It just returns the address of SIZE bytes that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 fall within a single heap. If you call obtain twice in a row
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 with the same arguments, you typically get the same value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 to the heap list. It's the caller's responsibility to keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 track of what space is in use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 Return the address of the space if all went well, or zero if we couldn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 allocate the memory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 static POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
248 obtain (POINTER address, size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 heap_ptr heap;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
251 size_t already_available;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 /* Find the heap that ADDRESS falls within. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 for (heap = last_heap; heap; heap = heap->prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 if (heap->start <= address && address <= heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 if (! heap)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
261 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 /* If we can't fit SIZE bytes in that heap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 try successive later heaps. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 while (heap && address + size > heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 heap = heap->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 if (heap == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 address = heap->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 /* If we can't fit them within any existing heap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 get more space. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 if (heap == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 {
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2796
diff changeset
277 POINTER new_ = (*real_morecore)(0);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
278 size_t get;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 already_available = (char *)last_heap->end - (char *)address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2796
diff changeset
282 if (new_ != last_heap->end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 /* Someone else called sbrk. Make a new heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2796
diff changeset
286 heap_ptr new_heap = (heap_ptr) MEM_ROUNDUP (new_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 POINTER bloc_start = (POINTER) MEM_ROUNDUP ((POINTER)(new_heap + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2796
diff changeset
289 if ((*real_morecore) (bloc_start - new_) != new_)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2796
diff changeset
292 new_heap->start = new_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 new_heap->end = bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 new_heap->bloc_start = bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 new_heap->free = bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 new_heap->next = NIL_HEAP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 new_heap->prev = last_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 new_heap->first_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 new_heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 last_heap->next = new_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 last_heap = new_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 address = bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 already_available = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 /* Add space to the last heap (which we may have just created).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 Get some extra, so we can come here less often. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 get = size + extra_bytes - already_available;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 get = (char *) ROUNDUP ((char *)last_heap->end + get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 - (char *) last_heap->end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 if ((*real_morecore) (get) != last_heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 last_heap->end += get;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 return address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 /* Obtain SIZE bytes of space and return a pointer to the new area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 If we could not allocate the space, return zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 static POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
328 get_more_space (size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 POINTER ptr = break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 if (obtain (size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 return ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 /* Note that SIZE bytes of space have been relinquished by the process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 If SIZE is more than a page, return the space to the system. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 relinquish (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 register heap_ptr h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 int excess = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 /* Add the amount of space beyond break_value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 in all heaps which have extend beyond break_value at all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 for (h = last_heap; h && break_value < h->end; h = h->prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 excess += (char *) h->end - (char *) ((break_value < h->bloc_start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 ? h->bloc_start : break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 if (excess > extra_bytes * 2 && (*real_morecore) (0) == last_heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 /* Keep extra_bytes worth of empty space.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 And don't free anything unless we can free at least extra_bytes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 excess -= extra_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 if ((char *)last_heap->end - (char *)last_heap->bloc_start <= excess)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 /* This heap should have no blocs in it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 if (last_heap->first_bloc != NIL_BLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 || last_heap->last_bloc != NIL_BLOC)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
367 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 /* Return the last heap, with its header, to the system. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 excess = (char *)last_heap->end - (char *)last_heap->start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 last_heap = last_heap->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 last_heap->next = NIL_HEAP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 excess = (char *) last_heap->end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 - (char *) ROUNDUP ((char *)last_heap->end - excess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 last_heap->end -= excess;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if ((*real_morecore) (- excess) == 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
382 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 /* Return the total size in use by relocating allocator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 above where malloc gets space. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 long r_alloc_size_in_use (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 long
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
391 r_alloc_size_in_use (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 return break_value - virtual_break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 /* The meat - allocating, freeing, and relocating blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 /* Find the bloc referenced by the address in PTR. Returns a pointer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 to that block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 static bloc_ptr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 find_bloc (POINTER *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 register bloc_ptr p = first_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 while (p != NIL_BLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (p->variable == ptr && p->data == *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 p = p->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 return p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 /* Allocate a bloc of SIZE bytes and append it to the chain of blocs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 Returns a pointer to the new bloc, or zero if we couldn't allocate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 memory for the new block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 static bloc_ptr
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
423 get_bloc (size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 register bloc_ptr new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 register heap_ptr heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 if (! (new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 || ! (new_bloc->data = obtain (break_value, size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 if (new_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 free (new_bloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 break_value = new_bloc->data + size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 new_bloc->size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 new_bloc->next = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 new_bloc->variable = (POINTER *) NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 new_bloc->new_data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 /* Record in the heap that this space is in use. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 heap = find_heap (new_bloc->data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 heap->free = break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 /* Maintain the correspondence between heaps and blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 new_bloc->heap = heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 heap->last_bloc = new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 if (heap->first_bloc == NIL_BLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 heap->first_bloc = new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 /* Put this bloc on the doubly-linked list of blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 if (first_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 new_bloc->prev = last_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 last_bloc->next = new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 last_bloc = new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 first_bloc = last_bloc = new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 new_bloc->prev = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 return new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 /* Calculate new locations of blocs in the list beginning with BLOC,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 relocating it to start at ADDRESS, in heap HEAP. If enough space is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 not presently available in our reserve, call obtain for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 more space.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Store the new location of each bloc in its new_data field.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 Do not touch the contents of blocs or break_value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 relocate_blocs (bloc_ptr bloc, heap_ptr heap, POINTER address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 register bloc_ptr b = bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 /* No need to ever call this if arena is frozen, bug somewhere! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 if (r_alloc_freeze_level)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
485 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 while (b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 /* If bloc B won't fit within HEAP,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 move to the next heap and try again. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 while (heap && address + b->size > heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 heap = heap->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 if (heap == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 address = heap->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 /* If BLOC won't fit in any heap,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 get enough new space to hold BLOC and all following blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 if (heap == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 register bloc_ptr tb = b;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
504 register size_t s = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 /* Add up the size of all the following blocs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 while (tb != NIL_BLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 if (tb->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 s += tb->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 tb = tb->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 /* Get that space. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 address = obtain (address, s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 if (address == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 heap = last_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 /* Record the new address of this bloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 and update where the next bloc can start. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 b->new_data = address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 if (b->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 address += b->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 b = b->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 #if 0 /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 /* Reorder the bloc BLOC to go before bloc BEFORE in the doubly linked list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 This is necessary if we put the memory of space of BLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 before that of BEFORE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 reorder_bloc (bloc_ptr bloc, bloc_ptr before)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 bloc_ptr prev, next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /* Splice BLOC out from where it is. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 prev = bloc->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 next = bloc->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 prev->next = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 if (next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 next->prev = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 /* Splice it in before BEFORE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 prev = before->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 prev->next = bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 bloc->prev = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 before->prev = bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 bloc->next = before;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 #endif /* unused */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 /* Update the records of which heaps contain which blocs, starting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 with heap HEAP and bloc BLOC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 update_heap_bloc_correspondence (bloc_ptr bloc, heap_ptr heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 register bloc_ptr b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 /* Initialize HEAP's status to reflect blocs before BLOC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (bloc != NIL_BLOC && bloc->prev != NIL_BLOC && bloc->prev->heap == heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 /* The previous bloc is in HEAP. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 heap->last_bloc = bloc->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 heap->free = bloc->prev->data + bloc->prev->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 /* HEAP contains no blocs before BLOC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 heap->first_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 heap->free = heap->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 /* Advance through blocs one by one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 for (b = bloc; b != NIL_BLOC; b = b->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 /* Advance through heaps, marking them empty,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 till we get to the one that B is in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 while (heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 if (heap->bloc_start <= b->data && b->data <= heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 heap = heap->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 /* We know HEAP is not null now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 because there has to be space for bloc B. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 heap->first_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 heap->free = heap->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 /* Update HEAP's status for bloc B. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 heap->free = b->data + b->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 heap->last_bloc = b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 if (heap->first_bloc == NIL_BLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 heap->first_bloc = b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 /* Record that B is in HEAP. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 b->heap = heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 /* If there are any remaining heaps and no blocs left,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 mark those heaps as empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 heap = heap->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 while (heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 heap->first_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 heap->free = heap->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 heap = heap->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 /* Resize BLOC to SIZE bytes. This relocates the blocs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 that come after BLOC in memory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
631 resize_bloc (bloc_ptr bloc, size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 register bloc_ptr b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 heap_ptr heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 POINTER address;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
636 size_t old_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 /* No need to ever call this if arena is frozen, bug somewhere! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 if (r_alloc_freeze_level)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
640 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 if (bloc == NIL_BLOC || size == bloc->size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 for (heap = first_heap; heap != NIL_HEAP; heap = heap->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 if (heap->bloc_start <= bloc->data && bloc->data <= heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 if (heap == NIL_HEAP)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
652 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 old_size = bloc->size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 bloc->size = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 /* Note that bloc could be moved into the previous heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 address = (bloc->prev ? bloc->prev->data + bloc->prev->size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 : first_heap->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 while (heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 if (heap->bloc_start <= address && address <= heap->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 heap = heap->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 if (! relocate_blocs (bloc, heap, address))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 bloc->size = old_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 if (size > old_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 for (b = last_bloc; b != bloc; b = b->prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 if (!b->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 b->size = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
684 memmove (b->new_data, b->data, b->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 *b->variable = b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 if (!bloc->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 bloc->size = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 bloc->data = bloc->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
695 memmove (bloc->new_data, bloc->data, old_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 memset (bloc->new_data + old_size, 0, size - old_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 *bloc->variable = bloc->data = bloc->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 for (b = bloc; b != NIL_BLOC; b = b->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 if (!b->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 b->size = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
711 memmove (b->new_data, b->data, b->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 *b->variable = b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 update_heap_bloc_correspondence (bloc, heap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 break_value = (last_bloc ? last_bloc->data + last_bloc->size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 : first_heap->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 /* Free BLOC from the chain of blocs, relocating any blocs above it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 and returning BLOC->size bytes to the free area. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 free_bloc (bloc_ptr bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 heap_ptr heap = bloc->heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 if (r_alloc_freeze_level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 bloc->variable = (POINTER *) NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 resize_bloc (bloc, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 if (bloc == first_bloc && bloc == last_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 first_bloc = last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 else if (bloc == last_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 last_bloc = bloc->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 last_bloc->next = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 else if (bloc == first_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 first_bloc = bloc->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 first_bloc->prev = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 bloc->next->prev = bloc->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 bloc->prev->next = bloc->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 /* Update the records of which blocs are in HEAP. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 if (heap->first_bloc == bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 if (bloc->next != 0 && bloc->next->heap == heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 heap->first_bloc = bloc->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 heap->first_bloc = heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 if (heap->last_bloc == bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 if (bloc->prev != 0 && bloc->prev->heap == heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 heap->last_bloc = bloc->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 heap->first_bloc = heap->last_bloc = NIL_BLOC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 relinquish ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 free (bloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 /* Interface routines. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 /* Obtain SIZE bytes of storage from the free pool, or the system, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 necessary. If relocatable blocs are in use, this means relocating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 them. This function gets plugged into the GNU malloc's __morecore
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 hook.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 We provide hysteresis, never relocating by less than extra_bytes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 If we're out of memory, we should return zero, to imitate the other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 __morecore hook values - in particular, __default_morecore in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 GNU malloc package. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 POINTER r_alloc_sbrk (ptrdiff_t size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 POINTER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 r_alloc_sbrk (ptrdiff_t size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 register bloc_ptr b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 POINTER address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 if (! use_relocatable_buffers)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 return (*real_morecore) (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 return virtual_break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 if (size > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 /* Allocate a page-aligned space. GNU malloc would reclaim an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 extra space if we passed an unaligned one. But we could
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 not always find a space which is contiguous to the previous. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 POINTER new_bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 heap_ptr h = first_heap;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
816 size_t get = ROUNDUP (size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 address = (POINTER) ROUNDUP (virtual_break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 /* Search the list upward for a heap which is large enough. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 while ((char *) h->end < (char *) MEM_ROUNDUP ((char *)address + get))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 h = h->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 if (h == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 address = (POINTER) ROUNDUP (h->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 /* If not found, obtain more space. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 if (h == NIL_HEAP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 get += extra_bytes + page_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 if (! obtain (address, get))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 if (first_heap == last_heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 address = (POINTER) ROUNDUP (virtual_break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 address = (POINTER) ROUNDUP (last_heap->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 h = last_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 new_bloc_start = (POINTER) MEM_ROUNDUP ((char *)address + get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 if (first_heap->bloc_start < new_bloc_start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 /* This is no clean solution - no idea how to do it better. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 if (r_alloc_freeze_level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 return NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 /* There is a bug here: if the above obtain call succeeded, but the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 relocate_blocs call below does not succeed, we need to free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 the memory that we got with obtain. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 /* Move all blocs upward. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 if (! relocate_blocs (first_bloc, h, new_bloc_start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 /* Note that (POINTER)(h+1) <= new_bloc_start since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 get >= page_size, so the following does not destroy the heap
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 for (b = last_bloc; b != NIL_BLOC; b = b->prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
865 memmove (b->new_data, b->data, b->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 *b->variable = b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 h->bloc_start = new_bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 update_heap_bloc_correspondence (first_bloc, h);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 if (h != first_heap)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 /* Give up managing heaps below the one the new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 virtual_break_value points to. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 first_heap->prev = NIL_HEAP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 first_heap->next = h->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 first_heap->start = h->start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 first_heap->end = h->end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 first_heap->free = h->free;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 first_heap->first_bloc = h->first_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 first_heap->last_bloc = h->last_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 first_heap->bloc_start = h->bloc_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 if (first_heap->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 first_heap->next->prev = first_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 last_heap = first_heap;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 memset (address, 0, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 else /* size < 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
896 size_t excess = (char *)first_heap->bloc_start
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 - ((char *)virtual_break_value + size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 address = virtual_break_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 if (r_alloc_freeze_level == 0 && excess > 2 * extra_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 excess -= extra_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 first_heap->bloc_start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 = (POINTER) MEM_ROUNDUP ((char *)first_heap->bloc_start - excess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 relocate_blocs (first_bloc, first_heap, first_heap->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 for (b = first_bloc; b != NIL_BLOC; b = b->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
911 memmove (b->new_data, b->data, b->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 *b->variable = b->data = b->new_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 if ((char *)virtual_break_value + size < (char *)first_heap->start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 /* We found an additional space below the first heap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 first_heap->start = (POINTER) ((char *)virtual_break_value + size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 virtual_break_value = (POINTER) ((char *)address + size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 break_value = (last_bloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 ? last_bloc->data + last_bloc->size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 : first_heap->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 if (size < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 relinquish ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 return address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 /* Allocate a relocatable bloc of storage of size SIZE. A pointer to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 the data is returned in *PTR. PTR is thus the address of some variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 which will use the data area.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 The allocation of 0 bytes is valid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 In case r_alloc_freeze is set, a best fit of unused blocs could be done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 before allocating a new area. Not yet done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 If we can't allocate the necessary memory, set *PTR to zero, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 return zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
944 POINTER r_alloc (POINTER *ptr, size_t size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
946 r_alloc (POINTER *ptr, size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 bloc_ptr new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
950 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
951
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 new_bloc = get_bloc (size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 if (new_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 new_bloc->variable = ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 *ptr = new_bloc->data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 *ptr = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 return *ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 /* Free a bloc of relocatable storage whose data is pointed to by PTR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 Store 0 in *PTR to show there's no block allocated. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 void r_alloc_free (POINTER *ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 r_alloc_free (POINTER *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 register bloc_ptr dead_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
976 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
977
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 dead_bloc = find_bloc (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 if (dead_bloc == NIL_BLOC)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
983 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 free_bloc (dead_bloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 *ptr = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 #ifdef emacs
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3025
diff changeset
989 #ifndef NEW_GC
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 refill_memory_reserve ();
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3025
diff changeset
991 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 /* Given a pointer at address PTR to relocatable data, resize it to SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 Do this by shifting all blocks above this one up in memory, unless
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 SIZE is less than or equal to the current bloc size, in which case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 In case r_alloc_freeze is set, a new bloc is allocated, and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 memory copied to it. Not very efficient. We could traverse the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 bloc_list for a best fit of free blocs first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 Change *PTR to reflect the new bloc, and return this value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 If more memory cannot be allocated, then leave *PTR unchanged, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 return zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1009 POINTER r_re_alloc (POINTER *ptr, size_t size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1011 r_re_alloc (POINTER *ptr, size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 register bloc_ptr bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1015 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1016
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 if (!*ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 return r_alloc (ptr, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 if (!size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 r_alloc_free (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 return r_alloc (ptr, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 bloc = find_bloc (ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 if (bloc == NIL_BLOC)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1030 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 if (size < bloc->size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* Wouldn't it be useful to actually resize the bloc here? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 /* I think so too, but not if it's too expensive... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 if ((bloc->size - MEM_ROUNDUP (size) >= page_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 && r_alloc_freeze_level == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 resize_bloc (bloc, MEM_ROUNDUP (size));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 /* Never mind if this fails, just do nothing... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 /* It *should* be infallible! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 else if (size > bloc->size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 if (r_alloc_freeze_level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 bloc_ptr new_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 new_bloc = get_bloc (MEM_ROUNDUP (size));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 if (new_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 new_bloc->variable = ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 *ptr = new_bloc->data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 bloc->variable = (POINTER *) NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 return NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 if (! resize_bloc (bloc, MEM_ROUNDUP (size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 return NIL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 return *ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 /* Disable relocations, after making room for at least SIZE bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 of non-relocatable heap if possible. The relocatable blocs are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 guaranteed to hold still until thawed, even if this means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 malloc must return a null pointer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 void r_alloc_freeze (long size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 r_alloc_freeze (long size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 /* If already frozen, we can't make any more room, so don't try. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 if (r_alloc_freeze_level > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 size = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 /* If we can't get the amount requested, half is better than nothing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 while (size > 0 && r_alloc_sbrk (size) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 size /= 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 ++r_alloc_freeze_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 if (size > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 r_alloc_sbrk (-size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 void r_alloc_thaw (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 r_alloc_thaw (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 if (! r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 init_ralloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 if (--r_alloc_freeze_level < 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1100 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 /* This frees all unused blocs. It is not too inefficient, as the resize
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1103 and memmove is done only once. Afterwards, all unreferenced blocs are
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 already shrunk to zero size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 if (!r_alloc_freeze_level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 bloc_ptr *b = &first_bloc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 while (*b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 if (!(*b)->variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 free_bloc (*b);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 b = &(*b)->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 /* The hook `malloc' uses for the function which gets more space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 from the system. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 #ifndef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 extern POINTER (*__morecore) (ptrdiff_t size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 /* Initialize various things for memory allocation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 init_ralloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 if (r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 r_alloc_initialized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 real_morecore = (POINTER (*) (ptrdiff_t)) __morecore;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 __morecore =
1799
19c89a2e24b6 [xemacs-hg @ 2003-11-20 16:04:45 by james]
james
parents: 1792
diff changeset
1134 #ifdef TYPEOF
19c89a2e24b6 [xemacs-hg @ 2003-11-20 16:04:45 by james]
james
parents: 1792
diff changeset
1135 (TYPEOF (__morecore))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 r_alloc_sbrk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 first_heap = last_heap = &heap_base;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 first_heap->next = first_heap->prev = NIL_HEAP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 first_heap->start = first_heap->bloc_start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 = virtual_break_value = break_value = (*real_morecore) (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 if (break_value == NIL)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1144 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 page_size = PAGE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 extra_bytes = ROUNDUP (50000);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 #ifdef DOUG_LEA_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 mallopt (M_TOP_PAD, 64 * 4096);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 #if 0 /* Hasn't been synched yet */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 /* Give GNU malloc's morecore some hysteresis
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 so that we move all the relocatable blocks much less often. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 __malloc_extra_blocks = 64;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 first_heap->end = (POINTER) ROUNDUP (first_heap->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 /* The extra call to real_morecore guarantees that the end of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 address space is a multiple of page_size, even if page_size is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 not really the page size of the system running the binary in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 which page_size is stored. This allows a binary to be built on a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 system with one page size and run on a system with a smaller page
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 (*real_morecore) (first_heap->end - first_heap->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 /* Clear the rest of the last page; this memory is in our address space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 even though it is after the sbrk value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 /* Doubly true, with the additional call that explicitly adds the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 rest of that page to the address space. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 memset (first_heap->start, 0, first_heap->end - first_heap->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 virtual_break_value = break_value = first_heap->bloc_start = first_heap->end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 use_relocatable_buffers = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 #if defined (emacs) && defined (DOUG_LEA_MALLOC)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 /* Reinitialize the morecore hook variables after restarting a dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 Emacs. This is needed when using Doug Lea's malloc from GNU libc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 void r_alloc_reinit (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 r_alloc_reinit (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 /* Only do this if the hook has been reset, so that we don't get an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 infinite loop, in case Emacs was linked statically. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 if ( (POINTER (*) (ptrdiff_t)) __morecore != r_alloc_sbrk)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 real_morecore = (POINTER (*) (ptrdiff_t)) __morecore;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 __morecore =
1799
19c89a2e24b6 [xemacs-hg @ 2003-11-20 16:04:45 by james]
james
parents: 1792
diff changeset
1192 #ifdef TYPEOF
19c89a2e24b6 [xemacs-hg @ 2003-11-20 16:04:45 by james]
james
parents: 1792
diff changeset
1193 (TYPEOF (__morecore))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 r_alloc_sbrk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 #ifdef DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 r_alloc_check (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 int found = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 heap_ptr h, ph = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 bloc_ptr b, pb = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 if (!r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 assert (first_heap);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 assert (last_heap->end <= (POINTER) sbrk (0));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 assert ((POINTER) first_heap < first_heap->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 assert (first_heap->start <= virtual_break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 assert (virtual_break_value <= first_heap->end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 for (h = first_heap; h; h = h->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 assert (h->prev == ph);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 assert ((POINTER) ROUNDUP (h->end) == h->end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 #if 0 /* ??? The code in ralloc.c does not really try to ensure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 the heap start has any sort of alignment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 Perhaps it should. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 assert ((POINTER) MEM_ROUNDUP (h->start) == h->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 assert ((POINTER) MEM_ROUNDUP (h->bloc_start) == h->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 assert (h->start <= h->bloc_start && h->bloc_start <= h->end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 if (ph)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 assert (ph->end < h->start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 assert (h->start <= (POINTER)h && (POINTER)(h+1) <= h->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 if (h->bloc_start <= break_value && break_value <= h->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 found = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 ph = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 assert (found);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 assert (last_heap == ph);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 for (b = first_bloc; b; b = b->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 assert (b->prev == pb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 assert ((POINTER) MEM_ROUNDUP (b->data) == b->data);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1248 assert ((size_t) MEM_ROUNDUP (b->size) == b->size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 ph = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 for (h = first_heap; h; h = h->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 if (h->bloc_start <= b->data && b->data + b->size <= h->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 ph = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 assert (h);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 if (pb && pb->data + pb->size != b->data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 assert (ph && b->data == h->bloc_start);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 while (ph)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 if (ph->bloc_start <= pb->data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 && pb->data + pb->size <= ph->end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 assert (pb->data + pb->size + b->size > ph->end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 assert (ph->bloc_start + b->size > ph->end);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 ph = ph->prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 pb = b;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 assert (last_bloc == pb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 if (last_bloc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 assert (last_bloc->data + last_bloc->size == break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 assert (first_heap->bloc_start == break_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 #endif /* DEBUG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 #else /* HAVE_MMAP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 A relocating allocator built using the mmap(2) facility available
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 in some OSes. Based on another version written by Paul Flinders,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 from which code (and comments) are snarfed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 The OS should support mmap() with MAP_ANONYMOUS attribute, or have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 /dev/zero. It should support private memory mapping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 Paul Flinders wrote a version which works well for systems that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 allow callers to specify (virtual) addresses to mmap().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 Unfortunately, such a scheme doesn't work for certain systems like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 HP-UX that have a system-wide virtual->real address map, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 consequently impose restrictions on the virtual address values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 permitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 NB: The mapping scheme in HP-UX is motivated by the inverted page
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 table design in some HP processors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 This alternate implementation allows for the addresses to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 optionally chosen by the system. Fortunately, buffer allocation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 doesn't insist upon contiguous memory which Flinders' scheme
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 provides, and this one doesn't.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 We don't really provide for hysteresis here, but add some metering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 to monitor how poorly the allocator actually works. See the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 documentation for `mmap-hysteresis'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 This implementation actually cycles through the blocks allocated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 via mmap() and only sends it to free() if it wasn't one of them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 Unfortunately, this is O(n) in the number of mmapped blocks. (Not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 really, as we have a hash table which tries to reduce the cost.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 Also, this dereferences the pointer passed, so it would cause a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 segfault if garbage was passed to it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 #include <fcntl.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 #include <sys/mman.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 #include <stdio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 typedef void *VM_ADDR; /* VM addresses */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1334 static const VM_ADDR VM_FAILURE_ADDR = (VM_ADDR) -1; /* mmap returns this when it fails. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 /* Configuration for relocating allocator. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 /* #define MMAP_GENERATE_ADDRESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 /* Define this if you want Emacs to manage the address table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 It is not recommended unless you have major problems with the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 default scheme, which allows the OS to pick addresses. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 /* USELESS_LOWER_ADDRESS_BITS defines the number of bits which can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 discarded while computing the hash, as they're always zero. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 default is appropriate for a page size of 4096 bytes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 #define USELESS_LOWER_ADDRESS_BITS 12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 /* Size of hash table for inverted VM_ADDR->MMAP_HANDLE lookup */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 #define MHASH_PRIME 89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 /* Whether we want to enable metering of some ralloc performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 This incurs a constant penalty for each mmap operation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 #define MMAP_METERING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 /* Rename the following to protect against a some smartness elsewhere.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 We need access to the allocator used for non-mmap allocation
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 elsewhere, in case we get passed a handle that we didn't allocate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 ourselves. Currently, this default allocator is also used to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 maintain local structures for relocatable blocks. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 #define UNDERLYING_MALLOC malloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 #define UNDERLYING_FREE free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 #define UNDERLYING_REALLOC realloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 /* MAP_ADDRCHOICE_FLAG is set to MAP_FIXED if MMAP_GENERATE_ADDRESSES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 is defined, and MAP_VARIABLE otherwise. Some losing systems don't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 define the _FIXED/_VARIABLE flags, in which case it is set to 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 #ifdef MMAP_GENERATE_ADDRESSES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 # ifdef MAP_FIXED
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 # define MAP_ADDRCHOICE_FLAG MAP_FIXED
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 #else /* !MMAP_GENERATE_ADDRESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 # ifdef MAP_VARIABLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 # define MAP_ADDRCHOICE_FLAG MAP_VARIABLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 #endif /* MMAP_GENERATE_ADDRESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 /* Default case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 #ifndef MAP_ADDRCHOICE_FLAG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 # define MAP_ADDRCHOICE_FLAG 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 #endif /* MAP_ADDRCHOICE_FLAG */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 #ifdef MAP_ANONYMOUS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 # define MAP_FLAGS (MAP_PRIVATE | MAP_ADDRCHOICE_FLAG | MAP_ANONYMOUS)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 # define MAP_FLAGS (MAP_PRIVATE | MAP_ADDRCHOICE_FLAG)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 #endif /* MAP_ANONYMOUS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 /* (ptf): A flag to indicate whether we have initialized ralloc yet. For
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 Emacs's sake, please do not make this local to malloc_init; on some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 machines, the dumping procedure makes all static variables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 read-only. On these machines, the word static is #defined to be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 the empty string, meaning that r_alloc_initialized becomes an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 automatic variable, and loses its value each time Emacs is started up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 If we're using mmap this flag has three possible values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 0 - initial value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 1 - Normal value when running temacs. In this case buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 are allocated using malloc so that any data that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 contain becomes part of the undumped executable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 2 - Normal value when running emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 static int r_alloc_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 /* (ptf): Macros for rounding. Note that rounding to any value is possible
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 by changing the definition of PAGE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 #define PAGE (getpagesize ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 #define PAGES_FOR(size) (((unsigned long int) (size) + page_size - 1)/page_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 #define ROUNDUP(size) ((unsigned long int)PAGES_FOR(size)*page_size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 /* DEV_ZERO_FD is -1 normally, but for systems without MAP_ANONYMOUS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 points to a file descriptor opened on /dev/zero */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 static int DEV_ZERO_FD = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 /* We actually need a data structure that can be usefully structured
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 based on the VM address, and allows an ~O(1) lookup on an arbitrary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 address, i.e. a hash table. Maybe the XEmacs hash table can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 coaxed enough. At the moment, we use lookup on a hash table to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 decide whether to do an O(n) search on the malloced block list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 Addresses are hashed to a bucket modulo MHASH_PRIME. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 /* We settle for a standard doubly-linked-list. The dynarr type isn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 very amenable to deletion of items in the middle, so we conjure up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 yet another stupid datastructure. The structure is maintained as a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 ring, and the singleton ring has the sole element as its left and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 right neighbours. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 static void init_MHASH_table (void); /* Forward reference */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 typedef struct alloc_dll
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 size_t size; /* #bytes currently in use */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 size_t space_for; /* #bytes we really have */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 POINTER* aliased_address; /* Address of aliased variable, to tweak if relocating */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 VM_ADDR vm_addr; /* VM address returned by mmap */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 struct alloc_dll *left; /* Left link in circular doubly linked list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 struct alloc_dll *right;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 } *MMAP_HANDLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 static MMAP_HANDLE mmap_start = 0; /* Head of linked list */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 static size_t page_size = 0; /* Size of VM pages */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 442
diff changeset
1453 static Fixnum mmap_hysteresis; /* Logically a "size_t" */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 /* Get a new handle for a fresh block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 static MMAP_HANDLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 new_mmap_handle (size_t nsiz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 MMAP_HANDLE h = (MMAP_HANDLE) UNDERLYING_MALLOC( sizeof (struct alloc_dll));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 if ( h == 0) return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 h->size = nsiz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 if (mmap_start == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 init_MHASH_table ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 mmap_start = h; mmap_start->left = h; mmap_start->right = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 MMAP_HANDLE prev = mmap_start->left;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 MMAP_HANDLE nex = mmap_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 /* Four pointers need fixing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 h->right = nex;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 h->left = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 prev->right = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 nex->left = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 return h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 /* Find a handle given the aliased address using linear search. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 static MMAP_HANDLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 find_mmap_handle_lsearch (POINTER *alias)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 MMAP_HANDLE h = mmap_start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 if (h == 0) return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 do {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 if (h->aliased_address == alias && *alias == h->vm_addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 return h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 h = h->right;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 } while( h != mmap_start );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 return 0; /* Bogus alias passed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 /* Free a handle. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 free_mmap_handle (MMAP_HANDLE h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 MMAP_HANDLE prev = h->left;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 MMAP_HANDLE nex = h->right;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 if (prev == h || nex == h) /* In fact, this should be && */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 { /* We're the singleton dll */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 UNDERLYING_FREE( h ); /* Free the sole item */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 mmap_start = 0; return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 else if (h == mmap_start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 mmap_start = nex; /* Make sure mmap_start isn't bogus. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 prev->right = nex;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 nex->left = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 UNDERLYING_FREE( h );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 /* A simple hash table to speed up the inverted lookup of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 VM_ADDR->MMAP_HANDLE. We maintain the number of hits for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 particular bucket. We invalidate a hash table entry during block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 deletion if the hash has cached the deleted block's address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 /* Simple hash check. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 struct {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 int n_hits; /* How many addresses map to this? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 MMAP_HANDLE handle; /* What is the current handle? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 VM_ADDR addr; /* What is its VM address? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 } MHASH_HITS[ MHASH_PRIME ];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 init_MHASH_table (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 int i = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 for (; i < MHASH_PRIME; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 MHASH_HITS[i].n_hits = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 MHASH_HITS[i].addr = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 MHASH_HITS[i].handle = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 /* Compute the hash value for an address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 MHASH (VM_ADDR addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 #if (LONGBITS == 64)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 unsigned long int addr_shift = (unsigned long int)(addr) >> USELESS_LOWER_ADDRESS_BITS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 unsigned int addr_shift = (unsigned int)(addr) >> USELESS_LOWER_ADDRESS_BITS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 int hval = addr_shift % MHASH_PRIME; /* We could have addresses which are -ve
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 when converted to signed ints */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 return ((hval >= 0) ? hval : MHASH_PRIME + hval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 /* Add a VM address with its corresponding handle to the table. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 MHASH_ADD (VM_ADDR addr, MMAP_HANDLE h)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 int kVal = MHASH( addr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 if (MHASH_HITS[kVal].n_hits++ == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 { /* Only overwrite the table if there were no hits so far. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 MHASH_HITS[kVal].addr = addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 MHASH_HITS[kVal].handle = h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 /* Delete a VM address entry from the hash table. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 MHASH_DEL (VM_ADDR addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 int kVal = MHASH( addr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 MHASH_HITS[kVal].n_hits--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 if (addr == MHASH_HITS[kVal].addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 MHASH_HITS[kVal].addr = 0; /* Invalidate cache. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 MHASH_HITS[kVal].handle = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 /* End of hash buckets */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 /* Metering malloc performance. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 #ifdef MMAP_METERING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 /* If we're metering, we introduce some extra symbols to aid the noble
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 cause of bloating XEmacs core size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 static Lisp_Object Qmmap_times_mapped;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 static Lisp_Object Qmmap_pages_mapped;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 static Lisp_Object Qmmap_times_unmapped;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 static Lisp_Object Qmmap_times_remapped;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 static Lisp_Object Qmmap_didnt_copy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 static Lisp_Object Qmmap_pages_copied;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 static Lisp_Object Qmmap_average_bumpval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 static Lisp_Object Qmmap_wastage;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 static Lisp_Object Qmmap_live_pages;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 static Lisp_Object Qmmap_addr_looked_up;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 static Lisp_Object Qmmap_hash_worked;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 static Lisp_Object Qmmap_addrlist_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 #define M_Map 0 /* How many times allocated? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 #define M_Pages_Map 1 /* How many pages allocated? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 #define M_Unmap 2 /* How many times freed? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 #define M_Remap 3 /* How many times increased in size? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 #define M_Didnt_Copy 4 /* How many times didn't need to copy? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 #define M_Copy_Pages 5 /* Total # pages copied */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 #define M_Average_Bumpval 6 /* Average bump value */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 #define M_Wastage 7 /* Remaining (unused space) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 #define M_Live_Pages 8 /* #live pages */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 #define M_Address_Lookup 9 /* How many times did we need to check if an addr is in the block? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 #define M_Hash_Worked 10 /* How many times did the simple hash check work? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 #define M_Addrlist_Size 11 /* What is the size of the XEmacs memory map? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 #define N_Meterables 12 /* Total number of meterables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 #define MEMMETER(x) {x;}
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 #define MVAL(x) (meter[x])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 #define MLVAL(x) (make_int (meter[x]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 static int meter[N_Meterables];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 DEFUN ("mmap-allocator-status", Fmmap_allocator_status, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Return some information about mmap-based allocator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 mmap-times-mapped: number of times r_alloc was called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 mmap-pages-mapped: number of pages mapped by r_alloc calls only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 mmap-times-unmapped: number of times r_free was called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 mmap-times-remapped: number of times r_re_alloc was called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 mmap-didnt-copy: number of times re-alloc did NOT have to move the block.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 mmap-pages-copied: total number of pages copied.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 mmap-average-bumpval: average increase in size demanded to re-alloc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 mmap-wastage: total number of bytes allocated, but not currently in use.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 mmap-live-pages: total number of pages live.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 mmap-addr-looked-up: total number of times needed to check if addr is in block.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 mmap-hash-worked: total number of times the simple hash check worked.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 mmap-addrlist-size: number of entries in address picking list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 result = cons3 (Qmmap_addrlist_size, MLVAL (M_Addrlist_Size), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 result = cons3 (Qmmap_hash_worked, MLVAL (M_Hash_Worked), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 result = cons3 (Qmmap_addr_looked_up, MLVAL (M_Address_Lookup), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 result = cons3 (Qmmap_live_pages, MLVAL (M_Live_Pages), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 result = cons3 (Qmmap_wastage, MLVAL (M_Wastage), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 result = cons3 (Qmmap_average_bumpval,MLVAL (M_Average_Bumpval), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 result = cons3 (Qmmap_pages_copied, MLVAL (M_Copy_Pages), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 result = cons3 (Qmmap_didnt_copy, MLVAL (M_Didnt_Copy), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 result = cons3 (Qmmap_times_remapped, MLVAL (M_Remap), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 result = cons3 (Qmmap_times_unmapped, MLVAL (M_Unmap), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 result = cons3 (Qmmap_pages_mapped, MLVAL (M_Pages_Map), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 result = cons3 (Qmmap_times_mapped, MLVAL (M_Map), result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 #else /* !MMAP_METERING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 #define MEMMETER(x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 #define MVAL(x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 #endif /* MMAP_METERING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 static MMAP_HANDLE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 find_mmap_handle (POINTER *alias)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 int kval = MHASH( *alias );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 MEMMETER( MVAL(M_Address_Lookup)++ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 switch( MHASH_HITS[kval].n_hits)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 MEMMETER( MVAL( M_Hash_Worked )++ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 if (*alias == MHASH_HITS[kval].addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 MEMMETER( MVAL( M_Hash_Worked) ++ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 return MHASH_HITS[kval].handle;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 /* FALL THROUGH */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 return find_mmap_handle_lsearch( alias );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 } /* switch */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 Some kernels don't like being asked to pick addresses for mapping
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 themselves---IRIX is known to become extremely slow if mmap is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 passed a ZERO as the first argument. In such cases, we use an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 address map which is managed local to the XEmacs process. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 address map maintains an ordered linked list of (address, size,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 occupancy) triples ordered by the absolute address. Initially, a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 large address area is marked as being empty. The address picking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 scheme takes bites off the first block which is still empty and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 large enough. If mmap with the specified address fails, it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 marked unavailable and not attempted thereafter. The scheme will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 keep fragmenting the large empty block until it finds an address
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 which can be successfully mmapped, or until there are no free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 blocks of the given size left.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 Note that this scheme, given its first-fit strategy, is prone to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 fragmentation of the first part of memory earmarked for this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 purpose. [ACP Vol I]. We can't use the workaround of using a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 randomized first fit because we don't want to presume too much
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 about the memory map. Instead, we try to coalesce empty or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 unavailable blocks at any available opportunity. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 /* Initialization procedure for address picking scheme */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 static void Addr_Block_initialize(void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 /* Get a suitable VM_ADDR via mmap */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1708 static VM_ADDR New_Addr_Block (size_t sz);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 /* Free a VM_ADDR allocated via New_Addr_Block */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1711 static void Free_Addr_Block (VM_ADDR addr, size_t sz);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 #ifdef MMAP_GENERATE_ADDRESSES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 /* Implementation of the three calls for address picking when XEmacs is incharge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 /* The enum denotes the status of the following block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 typedef enum { empty = 0, occupied, unavailable } addr_status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 typedef struct addr_chain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 POINTER addr;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1722 size_t sz;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 addr_status flag;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 struct addr_chain *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 } ADDRESS_BLOCK, *ADDRESS_CHAIN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 /* NB: empty and unavailable blocks are concatenated. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 static ADDRESS_CHAIN addr_chain = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 /* Start off the address block chain with a humongous address block
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 which is empty to start with. Note that addr_chain is invariant
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 WRT the addition/deletion of address blocks because of the assert
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 in Coalesce() and the strict ordering of blocks by their address
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1734 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1735 Addr_Block_initialize (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 MEMMETER( MVAL( M_Addrlist_Size )++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 addr_chain = (ADDRESS_CHAIN) UNDERLYING_MALLOC( sizeof( ADDRESS_BLOCK ));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 addr_chain->next = 0; /* Last block in chain */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 addr_chain->sz = 0x0c000000; /* Size */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1741 addr_chain->addr = (POINTER) (0x04000000);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 addr_chain->flag = empty;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 /* Coalesce address blocks if they are contiguous. Only empty and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 unavailable slots are coalesced. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1747 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1748 Coalesce_Addr_Blocks (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 ADDRESS_CHAIN p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 for (p = addr_chain; p; p = p->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 while (p->next && p->flag == p->next->flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 ADDRESS_CHAIN np;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 np = p->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 if (p->flag == occupied) break; /* No cigar */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 /* Check if the addresses are contiguous. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 if (p->addr + p->sz != np->addr) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 MEMMETER( MVAL( M_Addrlist_Size )--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 /* We can coalesce these two. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 p->sz += np->sz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 p->next = np->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 assert( np != addr_chain ); /* We're not freeing the head of the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 UNDERLYING_FREE( np );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 } /* for all p */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 /* Get an empty address block of specified size. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1774 static VM_ADDR
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1775 New_Addr_Block (size_t sz)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 ADDRESS_CHAIN p = addr_chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 VM_ADDR new_addr = VM_FAILURE_ADDR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 for (; p; p = p->next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 if (p->flag == empty && p->sz > sz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 /* Create a new entry following p which is empty. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 ADDRESS_CHAIN remainder = (ADDRESS_CHAIN) UNDERLYING_MALLOC( sizeof( ADDRESS_BLOCK ) );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 remainder->next = p->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 remainder->flag = empty;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 remainder->addr = p->addr + sz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 remainder->sz = p->sz - sz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 MEMMETER( MVAL( M_Addrlist_Size )++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 /* Now make p become an occupied block with the appropriate size */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 p->next = remainder;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 p->sz = sz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 new_addr = mmap( (VM_ADDR) p->addr, p->sz, PROT_READ|PROT_WRITE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 MAP_FLAGS, DEV_ZERO_FD, 0 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 if (new_addr == VM_FAILURE_ADDR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 p->flag = unavailable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 p->flag = occupied;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 Coalesce_Addr_Blocks();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 return new_addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 /* Free an address block. We mark the block as being empty, and attempt to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 do any coalescing that may have resulted from this. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1812 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1813 Free_Addr_Block (VM_ADDR addr, size_t sz)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 ADDRESS_CHAIN p = addr_chain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 for (; p; p = p->next )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 if (p->addr == addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 {
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1820 if (p->sz != sz) ABORT(); /* ACK! Shouldn't happen at all. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 munmap( (VM_ADDR) p->addr, p->sz );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 p->flag = empty;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 }
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1826 if (!p) ABORT(); /* Can't happen... we've got a block to free which is not in
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 the address list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 Coalesce_Addr_Blocks();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 #else /* !MMAP_GENERATE_ADDRESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 /* This is an alternate (simpler) implementation in cases where the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 address is picked by the kernel. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1834 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1835 Addr_Block_initialize (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 /* Nothing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1840 static VM_ADDR
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1841 New_Addr_Block (size_t sz)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 return mmap (0, sz, PROT_READ|PROT_WRITE, MAP_FLAGS,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 DEV_ZERO_FD, 0 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1847 static void
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1848 Free_Addr_Block (VM_ADDR addr, size_t sz)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 munmap ((caddr_t) addr, sz );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 #endif /* MMAP_GENERATE_ADDRESSES */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 /* IMPLEMENTATION OF EXPORTED RELOCATOR INTERFACE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 /*
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1859 r_alloc (POINTER, SIZE): Allocate a relocatable area with the start
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 address aliased to the first parameter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1863 POINTER r_alloc (POINTER *ptr, size_t size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1865 r_alloc (POINTER *ptr, size_t size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 MMAP_HANDLE mh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1869 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1870
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 switch(r_alloc_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 case 0:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1874 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 *ptr = (POINTER) UNDERLYING_MALLOC(size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 mh = new_mmap_handle( size );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 if (mh)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1882 size_t hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1883 size_t mmapped_size = ROUNDUP( size + hysteresis );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 MEMMETER( MVAL(M_Map)++ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 MEMMETER( MVAL(M_Pages_Map) += (mmapped_size/page_size) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 MEMMETER( MVAL(M_Wastage) += mmapped_size - size )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 MEMMETER( MVAL(M_Live_Pages) += (mmapped_size/page_size) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 mh->vm_addr = New_Addr_Block( mmapped_size );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 if (mh->vm_addr == VM_FAILURE_ADDR) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 free_mmap_handle( mh ); /* Free the loser */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 *ptr = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 return 0; /* ralloc failed due to mmap() failure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 MHASH_ADD( mh->vm_addr, mh );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 mh->space_for = mmapped_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 mh->aliased_address = ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 *ptr = (POINTER) mh->vm_addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 *ptr = 0; /* Malloc of block failed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 return *ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 /* Free a bloc of relocatable storage whose data is pointed to by PTR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 Store 0 in *PTR to show there's no block allocated. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 void r_alloc_free (POINTER *ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 r_alloc_free (POINTER *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 {
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1913 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1914
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 switch( r_alloc_initialized) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 case 0:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1917 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 UNDERLYING_FREE( *ptr ); /* Certain this is from the heap. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 MMAP_HANDLE dead_handle = find_mmap_handle( ptr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 /* Check if we've got it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 if (dead_handle == 0) /* Didn't find it in the list of mmap handles */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 UNDERLYING_FREE( *ptr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 MEMMETER( MVAL( M_Wastage ) -= (dead_handle->space_for - dead_handle->size) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 MEMMETER( MVAL( M_Live_Pages ) -= (dead_handle->space_for / page_size ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 MEMMETER(MVAL(M_Unmap)++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 MHASH_DEL( dead_handle->vm_addr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 Free_Addr_Block( dead_handle->vm_addr, dead_handle->space_for );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938 free_mmap_handle (dead_handle);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 } /* r_alloc_initialized */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 *ptr = 0; /* Zap the pointer's contents. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 /* Given a pointer at address PTR to relocatable data, resize it to SIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 Change *PTR to reflect the new bloc, and return this value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 If more memory cannot be allocated, then leave *PTR unchanged, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 return zero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1953 POINTER r_re_alloc (POINTER *ptr, size_t sz);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 POINTER
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1955 r_re_alloc (POINTER *ptr, size_t sz)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 {
1333
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1957 REGEX_MALLOC_CHECK ();
1b0339b048ce [xemacs-hg @ 2003-03-02 09:38:37 by ben]
ben
parents: 909
diff changeset
1958
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 if (r_alloc_initialized == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 {
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1799
diff changeset
1961 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 return 0; /* suppress compiler warning */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 else if (r_alloc_initialized == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 POINTER tmp = (POINTER) realloc(*ptr, sz);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 if (tmp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 *ptr = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 return tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1973 size_t hysteresis = (mmap_hysteresis > 0 ? mmap_hysteresis : 0);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1974 size_t actual_sz = ROUNDUP( sz + hysteresis );
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 MMAP_HANDLE h = find_mmap_handle( ptr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 VM_ADDR new_vm_addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 if ( h == 0 ) /* Was allocated using malloc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 POINTER tmp = (POINTER) UNDERLYING_REALLOC(*ptr, sz);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 if (tmp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 *ptr = tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 return tmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 MEMMETER(
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 MVAL(M_Average_Bumpval) =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 (((double) MVAL(M_Remap) * MVAL(M_Average_Bumpval)) + (sz - h->size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 / (double) (MVAL(M_Remap) + 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 MEMMETER(MVAL(M_Remap)++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 if (h->space_for > sz) /* We've got some more room */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 { /* Also, if a shrinkage was asked for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 MEMMETER( MVAL(M_Didnt_Copy)++ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 MEMMETER( MVAL(M_Wastage) -= (sz - h->size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 /* We're pretty dumb at handling shrinkage. We should check for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 a larger gap than the standard hysteresis allowable, and if so,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 shrink the number of pages. Right now, we simply reset the size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 component and return. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 h->size = sz;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 return *ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 new_vm_addr = New_Addr_Block( actual_sz );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 if (new_vm_addr == VM_FAILURE_ADDR)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 {/* Failed to realloc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 /* *ptr = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 MHASH_ADD( new_vm_addr, h );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 /* We got a block OK: now we should move the old contents to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 new address. We use the old size of this block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 memmove(new_vm_addr, h->vm_addr, h->size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 MHASH_DEL( h->vm_addr );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 Free_Addr_Block( h->vm_addr, h->space_for ); /* Unmap old area. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 MEMMETER( MVAL( M_Copy_Pages ) += (h->space_for/page_size) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 MEMMETER( MVAL( M_Live_Pages ) -= (h->space_for / page_size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 MEMMETER( MVAL( M_Live_Pages ) += (actual_sz / page_size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 MEMMETER( MVAL( M_Wastage ) -= (h->space_for - h->size))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 MEMMETER( MVAL( M_Wastage ) += (actual_sz - sz) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 /* Update block datastructure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 h->space_for = actual_sz; /* New total space */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 h->size = sz; /* New (requested) size */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 h->vm_addr = new_vm_addr; /* New VM start address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 h->aliased_address = ptr; /* Change alias to reflect block relocation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 *ptr = (POINTER) h->vm_addr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 return *ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 /* Initialize various things for memory allocation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 init_ralloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 int i = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 if (r_alloc_initialized > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 return; /* used to return 1 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042
909
a703d313962d [xemacs-hg @ 2002-07-09 11:55:35 by michaels]
michaels
parents: 613
diff changeset
2043 #ifdef PDUMP
a703d313962d [xemacs-hg @ 2002-07-09 11:55:35 by michaels]
michaels
parents: 613
diff changeset
2044 /* Under pdump, we need to activate ralloc on the first go. */
a703d313962d [xemacs-hg @ 2002-07-09 11:55:35 by michaels]
michaels
parents: 613
diff changeset
2045 ++r_alloc_initialized;
a703d313962d [xemacs-hg @ 2002-07-09 11:55:35 by michaels]
michaels
parents: 613
diff changeset
2046 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 if (++r_alloc_initialized == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 return; /* used to return 1 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 Addr_Block_initialize(); /* Initialize the address picker, if required. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 page_size = PAGE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 assert( page_size > 0 ); /* getpagesize() bogosity check. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 #ifndef MAP_ANONYMOUS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 DEV_ZERO_FD = open( "/dev/zero", O_RDWR );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 if (DEV_ZERO_FD < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 /* Failed. Perhaps we should abort here? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 return; /* used to return 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 #ifdef MMAP_METERING
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 for(i = 0; i < N_Meterables; i++ )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064 meter[i] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 #endif /* MMAP_METERING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070 syms_of_ralloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 #ifdef MMAP_METERING
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2073 DEFSYMBOL (Qmmap_times_mapped);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2074 DEFSYMBOL (Qmmap_pages_mapped);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2075 DEFSYMBOL (Qmmap_times_unmapped);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2076 DEFSYMBOL (Qmmap_times_remapped);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2077 DEFSYMBOL (Qmmap_didnt_copy);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2078 DEFSYMBOL (Qmmap_pages_copied);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2079 DEFSYMBOL (Qmmap_average_bumpval);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2080 DEFSYMBOL (Qmmap_wastage);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2081 DEFSYMBOL (Qmmap_live_pages);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2082 DEFSYMBOL (Qmmap_addr_looked_up);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2083 DEFSYMBOL (Qmmap_hash_worked);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
2084 DEFSYMBOL (Qmmap_addrlist_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 DEFSUBR (Fmmap_allocator_status);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 #endif /* MMAP_METERING */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 vars_of_ralloc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 DEFVAR_INT ("mmap-hysteresis", &mmap_hysteresis /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 Extra room left at the end of an allocated arena,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 so that a re-alloc requesting extra space smaller than this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 does not actually cause a new arena to be allocated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 A negative value is considered equal to zero. This is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 minimum amount of space guaranteed to be left at the end of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 the arena. Because allocation happens in multiples of the OS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 page size, it is possible for more space to be left unused.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 mmap_hysteresis = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 #endif /* HAVE_MMAP */