Mercurial > emacs
annotate src/ralloc.c @ 1179:7961d1af11a7
entered into RCS
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 20 Sep 1992 20:58:22 +0000 |
parents | 4b61400a5195 |
children | 761b9b4fd3ed |
rev | line source |
---|---|
118 | 1 /* Block-relocating memory allocator. |
577 | 2 Copyright (C) 1992 Free Software Foundation, Inc. |
118 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 1, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 /* NOTES: | |
21 | |
22 Only relocate the blocs neccessary for SIZE in r_alloc_sbrk, | |
23 rather than all of them. This means allowing for a possible | |
24 hole between the first bloc and the end of malloc storage. */ | |
25 | |
26 #include "config.h" | |
577 | 27 #include "lisp.h" /* Needed for VALBITS. */ |
118 | 28 #undef NULL |
29 #include "mem_limits.h" | |
621 | 30 #include "getpagesize.h" |
118 | 31 |
32 #define NIL ((POINTER) 0) | |
33 | |
34 | |
577 | 35 /* Declarations for working with the malloc, ralloc, and system breaks. */ |
36 | |
118 | 37 /* System call to set the break value. */ |
38 extern POINTER sbrk (); | |
39 | |
40 /* The break value, as seen by malloc (). */ | |
41 static POINTER virtual_break_value; | |
42 | |
43 /* The break value, viewed by the relocatable blocs. */ | |
44 static POINTER break_value; | |
45 | |
46 /* The REAL (i.e., page aligned) break value of the process. */ | |
47 static POINTER page_break_value; | |
48 | |
49 /* Macros for rounding. Note that rounding to any value is possible | |
50 by changing the definition of PAGE. */ | |
51 #define PAGE (getpagesize ()) | |
52 #define ALIGNED(addr) (((unsigned int) (addr) & (PAGE - 1)) == 0) | |
53 #define ROUNDUP(size) (((unsigned int) (size) + PAGE) & ~(PAGE - 1)) | |
54 #define ROUND_TO_PAGE(addr) (addr & (~(PAGE - 1))) | |
55 | |
577 | 56 /* Managing "almost out of memory" warnings. */ |
57 | |
118 | 58 /* Level of warnings issued. */ |
59 static int warnlevel; | |
60 | |
61 /* Function to call to issue a warning; | |
62 0 means don't issue them. */ | |
63 static void (*warnfunction) (); | |
64 | |
65 static void | |
66 check_memory_limits (address) | |
67 POINTER address; | |
68 { | |
69 SIZE data_size = address - data_space_start; | |
70 | |
71 switch (warnlevel) | |
72 { | |
73 case 0: | |
74 if (data_size > (lim_data / 4) * 3) | |
75 { | |
76 warnlevel++; | |
77 (*warnfunction) ("Warning: past 75% of memory limit"); | |
78 } | |
79 break; | |
80 | |
81 case 1: | |
82 if (data_size > (lim_data / 20) * 17) | |
83 { | |
84 warnlevel++; | |
85 (*warnfunction) ("Warning: past 85% of memory limit"); | |
86 } | |
87 break; | |
88 | |
89 case 2: | |
90 if (data_size > (lim_data / 20) * 19) | |
91 { | |
92 warnlevel++; | |
93 (*warnfunction) ("Warning: past 95% of memory limit"); | |
94 } | |
95 break; | |
96 | |
97 default: | |
98 (*warnfunction) ("Warning: past acceptable memory limits"); | |
99 break; | |
100 } | |
101 | |
102 if (EXCEEDS_ELISP_PTR (address)) | |
485 | 103 memory_full (); |
118 | 104 } |
105 | |
577 | 106 /* Functions to get and return memory from the system. */ |
107 | |
118 | 108 /* Obtain SIZE bytes of space. If enough space is not presently available |
109 in our process reserve, (i.e., (page_break_value - break_value)), | |
110 this means getting more page-aligned space from the system. */ | |
111 | |
112 static void | |
113 obtain (size) | |
114 SIZE size; | |
115 { | |
116 SIZE already_available = page_break_value - break_value; | |
117 | |
118 if (already_available < size) | |
119 { | |
577 | 120 SIZE get = ROUNDUP (size - already_available); |
118 | 121 |
122 if (warnfunction) | |
123 check_memory_limits (page_break_value); | |
124 | |
125 if (((int) sbrk (get)) < 0) | |
126 abort (); | |
127 | |
128 page_break_value += get; | |
129 } | |
130 | |
131 break_value += size; | |
132 } | |
133 | |
134 /* Obtain SIZE bytes of space and return a pointer to the new area. */ | |
135 | |
136 static POINTER | |
137 get_more_space (size) | |
138 SIZE size; | |
139 { | |
140 POINTER ptr = break_value; | |
141 obtain (size); | |
142 return ptr; | |
143 } | |
144 | |
145 /* Note that SIZE bytes of space have been relinquished by the process. | |
577 | 146 If SIZE is more than a page, return the space to the system. */ |
118 | 147 |
148 static void | |
149 relinquish (size) | |
150 SIZE size; | |
151 { | |
577 | 152 POINTER new_page_break; |
118 | 153 |
577 | 154 break_value -= size; |
155 new_page_break = (POINTER) ROUNDUP (break_value); | |
156 | |
157 if (new_page_break != page_break_value) | |
118 | 158 { |
577 | 159 if (((int) (sbrk ((char *) new_page_break |
160 - (char *) page_break_value))) < 0) | |
118 | 161 abort (); |
162 | |
577 | 163 page_break_value = new_page_break; |
118 | 164 } |
165 | |
577 | 166 /* Zero the space from the end of the "official" break to the actual |
167 break, so that bugs show up faster. */ | |
168 bzero (break_value, ((char *) page_break_value - (char *) break_value)); | |
118 | 169 } |
170 | |
577 | 171 /* The meat - allocating, freeing, and relocating blocs. */ |
172 | |
173 /* These structures are allocated in the malloc arena. | |
174 The linked list is kept in order of increasing '.data' members. | |
175 The data blocks abut each other; if b->next is non-nil, then | |
176 b->data + b->size == b->next->data. */ | |
118 | 177 typedef struct bp |
178 { | |
179 struct bp *next; | |
180 struct bp *prev; | |
181 POINTER *variable; | |
182 POINTER data; | |
183 SIZE size; | |
184 } *bloc_ptr; | |
185 | |
186 #define NIL_BLOC ((bloc_ptr) 0) | |
187 #define BLOC_PTR_SIZE (sizeof (struct bp)) | |
188 | |
189 /* Head and tail of the list of relocatable blocs. */ | |
190 static bloc_ptr first_bloc, last_bloc; | |
191 | |
577 | 192 /* Declared in dispnew.c, this version doesn't screw up if regions |
193 overlap. */ | |
118 | 194 extern void safe_bcopy (); |
195 | |
577 | 196 /* Find the bloc referenced by the address in PTR. Returns a pointer |
118 | 197 to that block. */ |
198 | |
199 static bloc_ptr | |
200 find_bloc (ptr) | |
201 POINTER *ptr; | |
202 { | |
203 register bloc_ptr p = first_bloc; | |
204 | |
205 while (p != NIL_BLOC) | |
206 { | |
207 if (p->variable == ptr && p->data == *ptr) | |
208 return p; | |
209 | |
210 p = p->next; | |
211 } | |
212 | |
213 return p; | |
214 } | |
215 | |
216 /* Allocate a bloc of SIZE bytes and append it to the chain of blocs. | |
217 Returns a pointer to the new bloc. */ | |
218 | |
219 static bloc_ptr | |
220 get_bloc (size) | |
221 SIZE size; | |
222 { | |
223 register bloc_ptr new_bloc = (bloc_ptr) malloc (BLOC_PTR_SIZE); | |
224 | |
225 new_bloc->data = get_more_space (size); | |
226 new_bloc->size = size; | |
227 new_bloc->next = NIL_BLOC; | |
1013
6bf2c4766d4c
* ralloc.c (get_bloc): When initializing new_bloc->variable, cast
Jim Blandy <jimb@redhat.com>
parents:
734
diff
changeset
|
228 new_bloc->variable = (POINTER *) NIL; |
118 | 229 |
230 if (first_bloc) | |
231 { | |
232 new_bloc->prev = last_bloc; | |
233 last_bloc->next = new_bloc; | |
234 last_bloc = new_bloc; | |
235 } | |
236 else | |
237 { | |
238 first_bloc = last_bloc = new_bloc; | |
239 new_bloc->prev = NIL_BLOC; | |
240 } | |
241 | |
242 return new_bloc; | |
243 } | |
244 | |
245 /* Relocate all blocs from BLOC on upward in the list to the zone | |
246 indicated by ADDRESS. Direction of relocation is determined by | |
247 the position of ADDRESS relative to BLOC->data. | |
248 | |
249 Note that ordering of blocs is not affected by this function. */ | |
250 | |
251 static void | |
252 relocate_some_blocs (bloc, address) | |
253 bloc_ptr bloc; | |
254 POINTER address; | |
255 { | |
256 register bloc_ptr b; | |
257 POINTER data_zone = bloc->data; | |
258 register SIZE data_zone_size = 0; | |
259 register SIZE offset = bloc->data - address; | |
260 POINTER new_data_zone = data_zone - offset; | |
261 | |
262 for (b = bloc; b != NIL_BLOC; b = b->next) | |
263 { | |
264 data_zone_size += b->size; | |
265 b->data -= offset; | |
266 *b->variable = b->data; | |
267 } | |
268 | |
269 safe_bcopy (data_zone, new_data_zone, data_zone_size); | |
270 } | |
271 | |
272 /* Free BLOC from the chain of blocs, relocating any blocs above it | |
273 and returning BLOC->size bytes to the free area. */ | |
274 | |
275 static void | |
276 free_bloc (bloc) | |
277 bloc_ptr bloc; | |
278 { | |
279 if (bloc == first_bloc && bloc == last_bloc) | |
280 { | |
281 first_bloc = last_bloc = NIL_BLOC; | |
282 } | |
283 else if (bloc == last_bloc) | |
284 { | |
285 last_bloc = bloc->prev; | |
286 last_bloc->next = NIL_BLOC; | |
287 } | |
288 else if (bloc == first_bloc) | |
289 { | |
290 first_bloc = bloc->next; | |
291 first_bloc->prev = NIL_BLOC; | |
292 relocate_some_blocs (bloc->next, bloc->data); | |
293 } | |
294 else | |
295 { | |
296 bloc->next->prev = bloc->prev; | |
297 bloc->prev->next = bloc->next; | |
298 relocate_some_blocs (bloc->next, bloc->data); | |
299 } | |
300 | |
301 relinquish (bloc->size); | |
302 free (bloc); | |
303 } | |
304 | |
577 | 305 /* Interface routines. */ |
306 | |
118 | 307 static int use_relocatable_buffers; |
308 | |
309 /* Obtain SIZE bytes of storage from the free pool, or the system, | |
310 as neccessary. If relocatable blocs are in use, this means | |
311 relocating them. */ | |
312 | |
313 POINTER | |
314 r_alloc_sbrk (size) | |
315 long size; | |
316 { | |
317 POINTER ptr; | |
318 | |
319 if (! use_relocatable_buffers) | |
320 return sbrk (size); | |
321 | |
322 if (size > 0) | |
323 { | |
324 obtain (size); | |
325 if (first_bloc) | |
326 { | |
327 relocate_some_blocs (first_bloc, first_bloc->data + size); | |
577 | 328 |
329 /* Zero out the space we just allocated, to help catch bugs | |
330 quickly. */ | |
118 | 331 bzero (virtual_break_value, size); |
332 } | |
333 } | |
334 else if (size < 0) | |
335 { | |
336 if (first_bloc) | |
337 relocate_some_blocs (first_bloc, first_bloc->data + size); | |
338 relinquish (- size); | |
339 } | |
340 | |
341 ptr = virtual_break_value; | |
342 virtual_break_value += size; | |
343 return ptr; | |
344 } | |
345 | |
346 /* Allocate a relocatable bloc of storage of size SIZE. A pointer to | |
347 the data is returned in *PTR. PTR is thus the address of some variable | |
348 which will use the data area. */ | |
349 | |
350 POINTER | |
351 r_alloc (ptr, size) | |
352 POINTER *ptr; | |
353 SIZE size; | |
354 { | |
355 register bloc_ptr new_bloc; | |
356 | |
357 new_bloc = get_bloc (size); | |
358 new_bloc->variable = ptr; | |
359 *ptr = new_bloc->data; | |
360 | |
361 return *ptr; | |
362 } | |
363 | |
364 /* Free a bloc of relocatable storage whose data is pointed to by PTR. */ | |
365 | |
366 void | |
367 r_alloc_free (ptr) | |
368 register POINTER *ptr; | |
369 { | |
370 register bloc_ptr dead_bloc; | |
371 | |
372 dead_bloc = find_bloc (ptr); | |
373 if (dead_bloc == NIL_BLOC) | |
374 abort (); | |
375 | |
376 free_bloc (dead_bloc); | |
377 } | |
378 | |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
379 /* Given a pointer at address PTR to relocatable data, resize it to SIZE. |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
380 This is done by shifting all blocks above this one up in memory, |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
381 unless SIZE is less than or equal to the current bloc size, in |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
382 which case nothing happens and the current value is returned. |
118 | 383 |
384 The contents of PTR is changed to reflect the new bloc, and this | |
385 value is returned. */ | |
386 | |
387 POINTER | |
388 r_re_alloc (ptr, size) | |
389 POINTER *ptr; | |
390 SIZE size; | |
391 { | |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
392 register bloc_ptr bloc; |
118 | 393 |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
394 bloc = find_bloc (ptr); |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
395 if (bloc == NIL_BLOC) |
118 | 396 abort (); |
397 | |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
398 if (size <= bloc->size) |
577 | 399 /* Wouldn't it be useful to actually resize the bloc here? */ |
118 | 400 return *ptr; |
401 | |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
402 obtain (size - bloc->size); |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
403 relocate_some_blocs (bloc->next, bloc->data + size); |
118 | 404 |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
405 /* Zero out the new space in the bloc, to help catch bugs faster. */ |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
406 bzero (bloc->data + bloc->size, size - bloc->size); |
1121 | 407 |
1087
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
408 /* Indicate that this block has a new size. */ |
6c410cc87574
* ralloc.c (r_re_alloc): Instead of allocating a new bloc at the
Jim Blandy <jimb@redhat.com>
parents:
1013
diff
changeset
|
409 bloc->size = size; |
118 | 410 |
411 return *ptr; | |
412 } | |
413 | |
414 /* The hook `malloc' uses for the function which gets more space | |
415 from the system. */ | |
416 extern POINTER (*__morecore) (); | |
417 | |
577 | 418 /* A flag to indicate whether we have initialized ralloc yet. For |
419 Emacs's sake, please do not make this local to malloc_init; on some | |
420 machines, the dumping procedure makes all static variables | |
421 read-only. On these machines, the word static is #defined to be | |
422 the empty string, meaning that malloc_initialized becomes an | |
423 automatic variable, and loses its value each time Emacs is started | |
424 up. */ | |
425 static int malloc_initialized = 0; | |
426 | |
118 | 427 /* Intialize various things for memory allocation. */ |
428 | |
429 void | |
430 malloc_init (start, warn_func) | |
431 POINTER start; | |
432 void (*warn_func) (); | |
433 { | |
434 if (start) | |
435 data_space_start = start; | |
436 | |
437 if (malloc_initialized) | |
438 return; | |
439 | |
440 malloc_initialized = 1; | |
441 __morecore = r_alloc_sbrk; | |
1013
6bf2c4766d4c
* ralloc.c (get_bloc): When initializing new_bloc->variable, cast
Jim Blandy <jimb@redhat.com>
parents:
734
diff
changeset
|
442 |
118 | 443 virtual_break_value = break_value = sbrk (0); |
1013
6bf2c4766d4c
* ralloc.c (get_bloc): When initializing new_bloc->variable, cast
Jim Blandy <jimb@redhat.com>
parents:
734
diff
changeset
|
444 if (break_value == (POINTER)NULL) |
6bf2c4766d4c
* ralloc.c (get_bloc): When initializing new_bloc->variable, cast
Jim Blandy <jimb@redhat.com>
parents:
734
diff
changeset
|
445 (*warn_func)("Malloc initialization returned 0 from sbrk(0)."); |
6bf2c4766d4c
* ralloc.c (get_bloc): When initializing new_bloc->variable, cast
Jim Blandy <jimb@redhat.com>
parents:
734
diff
changeset
|
446 |
118 | 447 page_break_value = (POINTER) ROUNDUP (break_value); |
448 bzero (break_value, (page_break_value - break_value)); | |
449 use_relocatable_buffers = 1; | |
450 | |
451 lim_data = 0; | |
452 warnlevel = 0; | |
453 warnfunction = warn_func; | |
454 | |
455 get_lim_data (); | |
456 } |