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