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