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