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