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