1 | /* alloca.c -- allocate automatically reclaimed memory
|
---|
2 | (Mostly) portable public-domain implementation -- D A Gwyn
|
---|
3 |
|
---|
4 | This implementation of the PWB library alloca function,
|
---|
5 | which is used to allocate space off the run-time stack so
|
---|
6 | that it is automatically reclaimed upon procedure exit,
|
---|
7 | was inspired by discussions with J. Q. Johnson of Cornell.
|
---|
8 | J.Otto Tennant <jot@cray.com> contributed the Cray support.
|
---|
9 |
|
---|
10 | There are some preprocessor constants that can
|
---|
11 | be defined when compiling for your specific system, for
|
---|
12 | improved efficiency; however, the defaults should be okay.
|
---|
13 |
|
---|
14 | The general concept of this implementation is to keep
|
---|
15 | track of all alloca-allocated blocks, and reclaim any
|
---|
16 | that are found to be deeper in the stack than the current
|
---|
17 | invocation. This heuristic does not reclaim storage as
|
---|
18 | soon as it becomes invalid, but it will do so eventually.
|
---|
19 |
|
---|
20 | As a special case, alloca(0) reclaims storage without
|
---|
21 | allocating any. It is a good idea to use alloca(0) in
|
---|
22 | your main control loop, etc. to force garbage collection. */
|
---|
23 |
|
---|
24 | #ifdef HAVE_CONFIG_H
|
---|
25 | # include <config.h>
|
---|
26 | #endif
|
---|
27 |
|
---|
28 | #include <alloca.h>
|
---|
29 |
|
---|
30 | #include <string.h>
|
---|
31 | #include <stdlib.h>
|
---|
32 |
|
---|
33 | #ifdef emacs
|
---|
34 | # include "lisp.h"
|
---|
35 | # include "blockinput.h"
|
---|
36 | # ifdef EMACS_FREE
|
---|
37 | # undef free
|
---|
38 | # define free EMACS_FREE
|
---|
39 | # endif
|
---|
40 | #else
|
---|
41 | # define memory_full() abort ()
|
---|
42 | #endif
|
---|
43 |
|
---|
44 | /* If compiling with GCC 2, this file's not needed. */
|
---|
45 | #if !defined (__GNUC__) || __GNUC__ < 2
|
---|
46 |
|
---|
47 | /* If someone has defined alloca as a macro,
|
---|
48 | there must be some other way alloca is supposed to work. */
|
---|
49 | # ifndef alloca
|
---|
50 |
|
---|
51 | # ifdef emacs
|
---|
52 | # ifdef static
|
---|
53 | /* actually, only want this if static is defined as ""
|
---|
54 | -- this is for usg, in which emacs must undefine static
|
---|
55 | in order to make unexec workable
|
---|
56 | */
|
---|
57 | # ifndef STACK_DIRECTION
|
---|
58 | you
|
---|
59 | lose
|
---|
60 | -- must know STACK_DIRECTION at compile-time
|
---|
61 | /* Using #error here is not wise since this file should work for
|
---|
62 | old and obscure compilers. */
|
---|
63 | # endif /* STACK_DIRECTION undefined */
|
---|
64 | # endif /* static */
|
---|
65 | # endif /* emacs */
|
---|
66 |
|
---|
67 | /* If your stack is a linked list of frames, you have to
|
---|
68 | provide an "address metric" ADDRESS_FUNCTION macro. */
|
---|
69 |
|
---|
70 | # if defined (CRAY) && defined (CRAY_STACKSEG_END)
|
---|
71 | long i00afunc ();
|
---|
72 | # define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
|
---|
73 | # else
|
---|
74 | # define ADDRESS_FUNCTION(arg) &(arg)
|
---|
75 | # endif
|
---|
76 |
|
---|
77 | /* Define STACK_DIRECTION if you know the direction of stack
|
---|
78 | growth for your system; otherwise it will be automatically
|
---|
79 | deduced at run-time.
|
---|
80 |
|
---|
81 | STACK_DIRECTION > 0 => grows toward higher addresses
|
---|
82 | STACK_DIRECTION < 0 => grows toward lower addresses
|
---|
83 | STACK_DIRECTION = 0 => direction of growth unknown */
|
---|
84 |
|
---|
85 | # ifndef STACK_DIRECTION
|
---|
86 | # define STACK_DIRECTION 0 /* Direction unknown. */
|
---|
87 | # endif
|
---|
88 |
|
---|
89 | # if STACK_DIRECTION != 0
|
---|
90 |
|
---|
91 | # define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
|
---|
92 |
|
---|
93 | # else /* STACK_DIRECTION == 0; need run-time code. */
|
---|
94 |
|
---|
95 | static int stack_dir; /* 1 or -1 once known. */
|
---|
96 | # define STACK_DIR stack_dir
|
---|
97 |
|
---|
98 | static void
|
---|
99 | find_stack_direction (void)
|
---|
100 | {
|
---|
101 | static char *addr = NULL; /* Address of first `dummy', once known. */
|
---|
102 | auto char dummy; /* To get stack address. */
|
---|
103 |
|
---|
104 | if (addr == NULL)
|
---|
105 | { /* Initial entry. */
|
---|
106 | addr = ADDRESS_FUNCTION (dummy);
|
---|
107 |
|
---|
108 | find_stack_direction (); /* Recurse once. */
|
---|
109 | }
|
---|
110 | else
|
---|
111 | {
|
---|
112 | /* Second entry. */
|
---|
113 | if (ADDRESS_FUNCTION (dummy) > addr)
|
---|
114 | stack_dir = 1; /* Stack grew upward. */
|
---|
115 | else
|
---|
116 | stack_dir = -1; /* Stack grew downward. */
|
---|
117 | }
|
---|
118 | }
|
---|
119 |
|
---|
120 | # endif /* STACK_DIRECTION == 0 */
|
---|
121 |
|
---|
122 | /* An "alloca header" is used to:
|
---|
123 | (a) chain together all alloca'ed blocks;
|
---|
124 | (b) keep track of stack depth.
|
---|
125 |
|
---|
126 | It is very important that sizeof(header) agree with malloc
|
---|
127 | alignment chunk size. The following default should work okay. */
|
---|
128 |
|
---|
129 | # ifndef ALIGN_SIZE
|
---|
130 | # define ALIGN_SIZE sizeof(double)
|
---|
131 | # endif
|
---|
132 |
|
---|
133 | typedef union hdr
|
---|
134 | {
|
---|
135 | char align[ALIGN_SIZE]; /* To force sizeof(header). */
|
---|
136 | struct
|
---|
137 | {
|
---|
138 | union hdr *next; /* For chaining headers. */
|
---|
139 | char *deep; /* For stack depth measure. */
|
---|
140 | } h;
|
---|
141 | } header;
|
---|
142 |
|
---|
143 | static header *last_alloca_header = NULL; /* -> last alloca header. */
|
---|
144 |
|
---|
145 | /* Return a pointer to at least SIZE bytes of storage,
|
---|
146 | which will be automatically reclaimed upon exit from
|
---|
147 | the procedure that called alloca. Originally, this space
|
---|
148 | was supposed to be taken from the current stack frame of the
|
---|
149 | caller, but that method cannot be made to work for some
|
---|
150 | implementations of C, for example under Gould's UTX/32. */
|
---|
151 |
|
---|
152 | void *
|
---|
153 | alloca (size_t size)
|
---|
154 | {
|
---|
155 | auto char probe; /* Probes stack depth: */
|
---|
156 | register char *depth = ADDRESS_FUNCTION (probe);
|
---|
157 |
|
---|
158 | # if STACK_DIRECTION == 0
|
---|
159 | if (STACK_DIR == 0) /* Unknown growth direction. */
|
---|
160 | find_stack_direction ();
|
---|
161 | # endif
|
---|
162 |
|
---|
163 | /* Reclaim garbage, defined as all alloca'd storage that
|
---|
164 | was allocated from deeper in the stack than currently. */
|
---|
165 |
|
---|
166 | {
|
---|
167 | register header *hp; /* Traverses linked list. */
|
---|
168 |
|
---|
169 | # ifdef emacs
|
---|
170 | BLOCK_INPUT;
|
---|
171 | # endif
|
---|
172 |
|
---|
173 | for (hp = last_alloca_header; hp != NULL;)
|
---|
174 | if ((STACK_DIR > 0 && hp->h.deep > depth)
|
---|
175 | || (STACK_DIR < 0 && hp->h.deep < depth))
|
---|
176 | {
|
---|
177 | register header *np = hp->h.next;
|
---|
178 |
|
---|
179 | free (hp); /* Collect garbage. */
|
---|
180 |
|
---|
181 | hp = np; /* -> next header. */
|
---|
182 | }
|
---|
183 | else
|
---|
184 | break; /* Rest are not deeper. */
|
---|
185 |
|
---|
186 | last_alloca_header = hp; /* -> last valid storage. */
|
---|
187 |
|
---|
188 | # ifdef emacs
|
---|
189 | UNBLOCK_INPUT;
|
---|
190 | # endif
|
---|
191 | }
|
---|
192 |
|
---|
193 | if (size == 0)
|
---|
194 | return NULL; /* No allocation required. */
|
---|
195 |
|
---|
196 | /* Allocate combined header + user data storage. */
|
---|
197 |
|
---|
198 | {
|
---|
199 | /* Address of header. */
|
---|
200 | register header *new;
|
---|
201 |
|
---|
202 | size_t combined_size = sizeof (header) + size;
|
---|
203 | if (combined_size < sizeof (header))
|
---|
204 | memory_full ();
|
---|
205 |
|
---|
206 | new = malloc (combined_size);
|
---|
207 |
|
---|
208 | if (! new)
|
---|
209 | memory_full ();
|
---|
210 |
|
---|
211 | new->h.next = last_alloca_header;
|
---|
212 | new->h.deep = depth;
|
---|
213 |
|
---|
214 | last_alloca_header = new;
|
---|
215 |
|
---|
216 | /* User storage begins just after header. */
|
---|
217 |
|
---|
218 | return (void *) (new + 1);
|
---|
219 | }
|
---|
220 | }
|
---|
221 |
|
---|
222 | # if defined (CRAY) && defined (CRAY_STACKSEG_END)
|
---|
223 |
|
---|
224 | # ifdef DEBUG_I00AFUNC
|
---|
225 | # include <stdio.h>
|
---|
226 | # endif
|
---|
227 |
|
---|
228 | # ifndef CRAY_STACK
|
---|
229 | # define CRAY_STACK
|
---|
230 | # ifndef CRAY2
|
---|
231 | /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
|
---|
232 | struct stack_control_header
|
---|
233 | {
|
---|
234 | long shgrow:32; /* Number of times stack has grown. */
|
---|
235 | long shaseg:32; /* Size of increments to stack. */
|
---|
236 | long shhwm:32; /* High water mark of stack. */
|
---|
237 | long shsize:32; /* Current size of stack (all segments). */
|
---|
238 | };
|
---|
239 |
|
---|
240 | /* The stack segment linkage control information occurs at
|
---|
241 | the high-address end of a stack segment. (The stack
|
---|
242 | grows from low addresses to high addresses.) The initial
|
---|
243 | part of the stack segment linkage control information is
|
---|
244 | 0200 (octal) words. This provides for register storage
|
---|
245 | for the routine which overflows the stack. */
|
---|
246 |
|
---|
247 | struct stack_segment_linkage
|
---|
248 | {
|
---|
249 | long ss[0200]; /* 0200 overflow words. */
|
---|
250 | long sssize:32; /* Number of words in this segment. */
|
---|
251 | long ssbase:32; /* Offset to stack base. */
|
---|
252 | long:32;
|
---|
253 | long sspseg:32; /* Offset to linkage control of previous
|
---|
254 | segment of stack. */
|
---|
255 | long:32;
|
---|
256 | long sstcpt:32; /* Pointer to task common address block. */
|
---|
257 | long sscsnm; /* Private control structure number for
|
---|
258 | microtasking. */
|
---|
259 | long ssusr1; /* Reserved for user. */
|
---|
260 | long ssusr2; /* Reserved for user. */
|
---|
261 | long sstpid; /* Process ID for pid based multi-tasking. */
|
---|
262 | long ssgvup; /* Pointer to multitasking thread giveup. */
|
---|
263 | long sscray[7]; /* Reserved for Cray Research. */
|
---|
264 | long ssa0;
|
---|
265 | long ssa1;
|
---|
266 | long ssa2;
|
---|
267 | long ssa3;
|
---|
268 | long ssa4;
|
---|
269 | long ssa5;
|
---|
270 | long ssa6;
|
---|
271 | long ssa7;
|
---|
272 | long sss0;
|
---|
273 | long sss1;
|
---|
274 | long sss2;
|
---|
275 | long sss3;
|
---|
276 | long sss4;
|
---|
277 | long sss5;
|
---|
278 | long sss6;
|
---|
279 | long sss7;
|
---|
280 | };
|
---|
281 |
|
---|
282 | # else /* CRAY2 */
|
---|
283 | /* The following structure defines the vector of words
|
---|
284 | returned by the STKSTAT library routine. */
|
---|
285 | struct stk_stat
|
---|
286 | {
|
---|
287 | long now; /* Current total stack size. */
|
---|
288 | long maxc; /* Amount of contiguous space which would
|
---|
289 | be required to satisfy the maximum
|
---|
290 | stack demand to date. */
|
---|
291 | long high_water; /* Stack high-water mark. */
|
---|
292 | long overflows; /* Number of stack overflow ($STKOFEN) calls. */
|
---|
293 | long hits; /* Number of internal buffer hits. */
|
---|
294 | long extends; /* Number of block extensions. */
|
---|
295 | long stko_mallocs; /* Block allocations by $STKOFEN. */
|
---|
296 | long underflows; /* Number of stack underflow calls ($STKRETN). */
|
---|
297 | long stko_free; /* Number of deallocations by $STKRETN. */
|
---|
298 | long stkm_free; /* Number of deallocations by $STKMRET. */
|
---|
299 | long segments; /* Current number of stack segments. */
|
---|
300 | long maxs; /* Maximum number of stack segments so far. */
|
---|
301 | long pad_size; /* Stack pad size. */
|
---|
302 | long current_address; /* Current stack segment address. */
|
---|
303 | long current_size; /* Current stack segment size. This
|
---|
304 | number is actually corrupted by STKSTAT to
|
---|
305 | include the fifteen word trailer area. */
|
---|
306 | long initial_address; /* Address of initial segment. */
|
---|
307 | long initial_size; /* Size of initial segment. */
|
---|
308 | };
|
---|
309 |
|
---|
310 | /* The following structure describes the data structure which trails
|
---|
311 | any stack segment. I think that the description in 'asdef' is
|
---|
312 | out of date. I only describe the parts that I am sure about. */
|
---|
313 |
|
---|
314 | struct stk_trailer
|
---|
315 | {
|
---|
316 | long this_address; /* Address of this block. */
|
---|
317 | long this_size; /* Size of this block (does not include
|
---|
318 | this trailer). */
|
---|
319 | long unknown2;
|
---|
320 | long unknown3;
|
---|
321 | long link; /* Address of trailer block of previous
|
---|
322 | segment. */
|
---|
323 | long unknown5;
|
---|
324 | long unknown6;
|
---|
325 | long unknown7;
|
---|
326 | long unknown8;
|
---|
327 | long unknown9;
|
---|
328 | long unknown10;
|
---|
329 | long unknown11;
|
---|
330 | long unknown12;
|
---|
331 | long unknown13;
|
---|
332 | long unknown14;
|
---|
333 | };
|
---|
334 |
|
---|
335 | # endif /* CRAY2 */
|
---|
336 | # endif /* not CRAY_STACK */
|
---|
337 |
|
---|
338 | # ifdef CRAY2
|
---|
339 | /* Determine a "stack measure" for an arbitrary ADDRESS.
|
---|
340 | I doubt that "lint" will like this much. */
|
---|
341 |
|
---|
342 | static long
|
---|
343 | i00afunc (long *address)
|
---|
344 | {
|
---|
345 | struct stk_stat status;
|
---|
346 | struct stk_trailer *trailer;
|
---|
347 | long *block, size;
|
---|
348 | long result = 0;
|
---|
349 |
|
---|
350 | /* We want to iterate through all of the segments. The first
|
---|
351 | step is to get the stack status structure. We could do this
|
---|
352 | more quickly and more directly, perhaps, by referencing the
|
---|
353 | $LM00 common block, but I know that this works. */
|
---|
354 |
|
---|
355 | STKSTAT (&status);
|
---|
356 |
|
---|
357 | /* Set up the iteration. */
|
---|
358 |
|
---|
359 | trailer = (struct stk_trailer *) (status.current_address
|
---|
360 | + status.current_size
|
---|
361 | - 15);
|
---|
362 |
|
---|
363 | /* There must be at least one stack segment. Therefore it is
|
---|
364 | a fatal error if "trailer" is null. */
|
---|
365 |
|
---|
366 | if (trailer == 0)
|
---|
367 | abort ();
|
---|
368 |
|
---|
369 | /* Discard segments that do not contain our argument address. */
|
---|
370 |
|
---|
371 | while (trailer != 0)
|
---|
372 | {
|
---|
373 | block = (long *) trailer->this_address;
|
---|
374 | size = trailer->this_size;
|
---|
375 | if (block == 0 || size == 0)
|
---|
376 | abort ();
|
---|
377 | trailer = (struct stk_trailer *) trailer->link;
|
---|
378 | if ((block <= address) && (address < (block + size)))
|
---|
379 | break;
|
---|
380 | }
|
---|
381 |
|
---|
382 | /* Set the result to the offset in this segment and add the sizes
|
---|
383 | of all predecessor segments. */
|
---|
384 |
|
---|
385 | result = address - block;
|
---|
386 |
|
---|
387 | if (trailer == 0)
|
---|
388 | {
|
---|
389 | return result;
|
---|
390 | }
|
---|
391 |
|
---|
392 | do
|
---|
393 | {
|
---|
394 | if (trailer->this_size <= 0)
|
---|
395 | abort ();
|
---|
396 | result += trailer->this_size;
|
---|
397 | trailer = (struct stk_trailer *) trailer->link;
|
---|
398 | }
|
---|
399 | while (trailer != 0);
|
---|
400 |
|
---|
401 | /* We are done. Note that if you present a bogus address (one
|
---|
402 | not in any segment), you will get a different number back, formed
|
---|
403 | from subtracting the address of the first block. This is probably
|
---|
404 | not what you want. */
|
---|
405 |
|
---|
406 | return (result);
|
---|
407 | }
|
---|
408 |
|
---|
409 | # else /* not CRAY2 */
|
---|
410 | /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
|
---|
411 | Determine the number of the cell within the stack,
|
---|
412 | given the address of the cell. The purpose of this
|
---|
413 | routine is to linearize, in some sense, stack addresses
|
---|
414 | for alloca. */
|
---|
415 |
|
---|
416 | static long
|
---|
417 | i00afunc (long address)
|
---|
418 | {
|
---|
419 | long stkl = 0;
|
---|
420 |
|
---|
421 | long size, pseg, this_segment, stack;
|
---|
422 | long result = 0;
|
---|
423 |
|
---|
424 | struct stack_segment_linkage *ssptr;
|
---|
425 |
|
---|
426 | /* Register B67 contains the address of the end of the
|
---|
427 | current stack segment. If you (as a subprogram) store
|
---|
428 | your registers on the stack and find that you are past
|
---|
429 | the contents of B67, you have overflowed the segment.
|
---|
430 |
|
---|
431 | B67 also points to the stack segment linkage control
|
---|
432 | area, which is what we are really interested in. */
|
---|
433 |
|
---|
434 | stkl = CRAY_STACKSEG_END ();
|
---|
435 | ssptr = (struct stack_segment_linkage *) stkl;
|
---|
436 |
|
---|
437 | /* If one subtracts 'size' from the end of the segment,
|
---|
438 | one has the address of the first word of the segment.
|
---|
439 |
|
---|
440 | If this is not the first segment, 'pseg' will be
|
---|
441 | nonzero. */
|
---|
442 |
|
---|
443 | pseg = ssptr->sspseg;
|
---|
444 | size = ssptr->sssize;
|
---|
445 |
|
---|
446 | this_segment = stkl - size;
|
---|
447 |
|
---|
448 | /* It is possible that calling this routine itself caused
|
---|
449 | a stack overflow. Discard stack segments which do not
|
---|
450 | contain the target address. */
|
---|
451 |
|
---|
452 | while (!(this_segment <= address && address <= stkl))
|
---|
453 | {
|
---|
454 | # ifdef DEBUG_I00AFUNC
|
---|
455 | fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
|
---|
456 | # endif
|
---|
457 | if (pseg == 0)
|
---|
458 | break;
|
---|
459 | stkl = stkl - pseg;
|
---|
460 | ssptr = (struct stack_segment_linkage *) stkl;
|
---|
461 | size = ssptr->sssize;
|
---|
462 | pseg = ssptr->sspseg;
|
---|
463 | this_segment = stkl - size;
|
---|
464 | }
|
---|
465 |
|
---|
466 | result = address - this_segment;
|
---|
467 |
|
---|
468 | /* If you subtract pseg from the current end of the stack,
|
---|
469 | you get the address of the previous stack segment's end.
|
---|
470 | This seems a little convoluted to me, but I'll bet you save
|
---|
471 | a cycle somewhere. */
|
---|
472 |
|
---|
473 | while (pseg != 0)
|
---|
474 | {
|
---|
475 | # ifdef DEBUG_I00AFUNC
|
---|
476 | fprintf (stderr, "%011o %011o\n", pseg, size);
|
---|
477 | # endif
|
---|
478 | stkl = stkl - pseg;
|
---|
479 | ssptr = (struct stack_segment_linkage *) stkl;
|
---|
480 | size = ssptr->sssize;
|
---|
481 | pseg = ssptr->sspseg;
|
---|
482 | result += size;
|
---|
483 | }
|
---|
484 | return (result);
|
---|
485 | }
|
---|
486 |
|
---|
487 | # endif /* not CRAY2 */
|
---|
488 | # endif /* CRAY */
|
---|
489 |
|
---|
490 | # endif /* no alloca */
|
---|
491 | #endif /* not GCC version 2 */
|
---|