alloca: one step towards thread-safety
[gnulib.git] / lib / alloca.c
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 #include <config.h>
25
26 #include <alloca.h>
27
28 #include <string.h>
29 #include <stdlib.h>
30
31 #ifdef emacs
32 # include "lisp.h"
33 # include "blockinput.h"
34 # ifdef EMACS_FREE
35 #  undef free
36 #  define free EMACS_FREE
37 # endif
38 #else
39 # define memory_full() abort ()
40 #endif
41
42 /* If compiling with GCC 2, this file's not needed.  */
43 #if !defined (__GNUC__) || __GNUC__ < 2
44
45 /* If someone has defined alloca as a macro,
46    there must be some other way alloca is supposed to work.  */
47 # ifndef alloca
48
49 #  ifdef emacs
50 #   ifdef static
51 /* actually, only want this if static is defined as ""
52    -- this is for usg, in which emacs must undefine static
53    in order to make unexec workable
54    */
55 #    ifndef STACK_DIRECTION
56 you
57 lose
58 -- must know STACK_DIRECTION at compile-time
59 /* Using #error here is not wise since this file should work for
60    old and obscure compilers.  */
61 #    endif /* STACK_DIRECTION undefined */
62 #   endif /* static */
63 #  endif /* emacs */
64
65 /* If your stack is a linked list of frames, you have to
66    provide an "address metric" ADDRESS_FUNCTION macro.  */
67
68 #  if defined (CRAY) && defined (CRAY_STACKSEG_END)
69 long i00afunc ();
70 #   define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
71 #  else
72 #   define ADDRESS_FUNCTION(arg) &(arg)
73 #  endif
74
75 /* Define STACK_DIRECTION if you know the direction of stack
76    growth for your system; otherwise it will be automatically
77    deduced at run-time.
78
79    STACK_DIRECTION > 0 => grows toward higher addresses
80    STACK_DIRECTION < 0 => grows toward lower addresses
81    STACK_DIRECTION = 0 => direction of growth unknown  */
82
83 #  ifndef STACK_DIRECTION
84 #   define STACK_DIRECTION      0       /* Direction unknown.  */
85 #  endif
86
87 #  if STACK_DIRECTION != 0
88
89 #   define STACK_DIR    STACK_DIRECTION /* Known at compile-time.  */
90
91 #  else /* STACK_DIRECTION == 0; need run-time code.  */
92
93 static int stack_dir;           /* 1 or -1 once known.  */
94 #   define STACK_DIR    stack_dir
95
96 static void
97 find_stack_direction (char **ptr)
98 {
99   auto char dummy;              /* To get stack address.  */
100
101   if (*ptr == NULL)
102     {                           /* Initial entry.  */
103       *ptr = ADDRESS_FUNCTION (dummy);
104
105       find_stack_direction (ptr);  /* Recurse once.  */
106     }
107   else
108     {
109       /* Second entry.  */
110       if (ADDRESS_FUNCTION (dummy) > *ptr)
111         stack_dir = 1;          /* Stack grew upward.  */
112       else
113         stack_dir = -1;         /* Stack grew downward.  */
114     }
115 }
116
117 #  endif /* STACK_DIRECTION == 0 */
118
119 /* An "alloca header" is used to:
120    (a) chain together all alloca'ed blocks;
121    (b) keep track of stack depth.
122
123    It is very important that sizeof(header) agree with malloc
124    alignment chunk size.  The following default should work okay.  */
125
126 #  ifndef       ALIGN_SIZE
127 #   define ALIGN_SIZE   sizeof(double)
128 #  endif
129
130 typedef union hdr
131 {
132   char align[ALIGN_SIZE];       /* To force sizeof(header).  */
133   struct
134     {
135       union hdr *next;          /* For chaining headers.  */
136       char *deep;               /* For stack depth measure.  */
137     } h;
138 } header;
139
140 static header *last_alloca_header = NULL;       /* -> last alloca header.  */
141
142 /* Return a pointer to at least SIZE bytes of storage,
143    which will be automatically reclaimed upon exit from
144    the procedure that called alloca.  Originally, this space
145    was supposed to be taken from the current stack frame of the
146    caller, but that method cannot be made to work for some
147    implementations of C, for example under Gould's UTX/32.  */
148
149 void *
150 alloca (size_t size)
151 {
152   auto char probe;              /* Probes stack depth: */
153   register char *depth = ADDRESS_FUNCTION (probe);
154
155 #  if STACK_DIRECTION == 0
156   if (STACK_DIR == 0)           /* Unknown growth direction.  */
157     {
158       char *addr = NULL;        /* Address of first `dummy', once known.  */
159       find_stack_direction (&addr);
160     }
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 */