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