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
find_stack_direction(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 *
alloca(size_t size)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
i00afunc(long * address)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
i00afunc(long address)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 */
492