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