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