alloca.c revision 33965
133965Sjdp/* alloca.c -- allocate automatically reclaimed memory
233965Sjdp   (Mostly) portable public-domain implementation -- D A Gwyn
333965Sjdp
433965Sjdp   This implementation of the PWB library alloca function,
533965Sjdp   which is used to allocate space off the run-time stack so
633965Sjdp   that it is automatically reclaimed upon procedure exit,
733965Sjdp   was inspired by discussions with J. Q. Johnson of Cornell.
833965Sjdp   J.Otto Tennant <jot@cray.com> contributed the Cray support.
933965Sjdp
1033965Sjdp   There are some preprocessor constants that can
1133965Sjdp   be defined when compiling for your specific system, for
1233965Sjdp   improved efficiency; however, the defaults should be okay.
1333965Sjdp
1433965Sjdp   The general concept of this implementation is to keep
1533965Sjdp   track of all alloca-allocated blocks, and reclaim any
1633965Sjdp   that are found to be deeper in the stack than the current
1733965Sjdp   invocation.  This heuristic does not reclaim storage as
1833965Sjdp   soon as it becomes invalid, but it will do so eventually.
1933965Sjdp
2033965Sjdp   As a special case, alloca(0) reclaims storage without
2133965Sjdp   allocating any.  It is a good idea to use alloca(0) in
2233965Sjdp   your main control loop, etc. to force garbage collection.  */
2333965Sjdp
2433965Sjdp#ifdef HAVE_CONFIG_H
2533965Sjdp#include "config.h"
2633965Sjdp#endif
2733965Sjdp
2833965Sjdp/* If compiling with GCC, this file's not needed.  */
2933965Sjdp#ifndef alloca
3033965Sjdp
3133965Sjdp#ifdef emacs
3233965Sjdp#ifdef static
3333965Sjdp/* actually, only want this if static is defined as ""
3433965Sjdp   -- this is for usg, in which emacs must undefine static
3533965Sjdp   in order to make unexec workable
3633965Sjdp   */
3733965Sjdp#ifndef STACK_DIRECTION
3833965Sjdpyou
3933965Sjdplose
4033965Sjdp-- must know STACK_DIRECTION at compile-time
4133965Sjdp#endif /* STACK_DIRECTION undefined */
4233965Sjdp#endif /* static */
4333965Sjdp#endif /* emacs */
4433965Sjdp
4533965Sjdp/* If your stack is a linked list of frames, you have to
4633965Sjdp   provide an "address metric" ADDRESS_FUNCTION macro.  */
4733965Sjdp
4833965Sjdp#if defined (CRAY) && defined (CRAY_STACKSEG_END)
4933965Sjdplong i00afunc ();
5033965Sjdp#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
5133965Sjdp#else
5233965Sjdp#define ADDRESS_FUNCTION(arg) &(arg)
5333965Sjdp#endif
5433965Sjdp
5533965Sjdp#if __STDC__
5633965Sjdp#include <stddef.h>
5733965Sjdptypedef void *pointer;
5833965Sjdp#else
5933965Sjdptypedef char *pointer;
6033965Sjdptypedef unsigned size_t;
6133965Sjdp#endif
6233965Sjdp
6333965Sjdp#ifndef NULL
6433965Sjdp#define	NULL	0
6533965Sjdp#endif
6633965Sjdp
6733965Sjdp/* Different portions of Emacs need to call different versions of
6833965Sjdp   malloc.  The Emacs executable needs alloca to call xmalloc, because
6933965Sjdp   ordinary malloc isn't protected from input signals.  On the other
7033965Sjdp   hand, the utilities in lib-src need alloca to call malloc; some of
7133965Sjdp   them are very simple, and don't have an xmalloc routine.
7233965Sjdp
7333965Sjdp   Non-Emacs programs expect this to call use xmalloc.
7433965Sjdp
7533965Sjdp   Callers below should use malloc.  */
7633965Sjdp
7733965Sjdp#ifndef emacs
7833965Sjdp#define malloc xmalloc
7933965Sjdpextern pointer xmalloc ();
8033965Sjdp#endif
8133965Sjdp
8233965Sjdp/* Define STACK_DIRECTION if you know the direction of stack
8333965Sjdp   growth for your system; otherwise it will be automatically
8433965Sjdp   deduced at run-time.
8533965Sjdp
8633965Sjdp   STACK_DIRECTION > 0 => grows toward higher addresses
8733965Sjdp   STACK_DIRECTION < 0 => grows toward lower addresses
8833965Sjdp   STACK_DIRECTION = 0 => direction of growth unknown  */
8933965Sjdp
9033965Sjdp#ifndef STACK_DIRECTION
9133965Sjdp#define	STACK_DIRECTION	0	/* Direction unknown.  */
9233965Sjdp#endif
9333965Sjdp
9433965Sjdp#if STACK_DIRECTION != 0
9533965Sjdp
9633965Sjdp#define	STACK_DIR	STACK_DIRECTION	/* Known at compile-time.  */
9733965Sjdp
9833965Sjdp#else /* STACK_DIRECTION == 0; need run-time code.  */
9933965Sjdp
10033965Sjdpstatic int stack_dir;		/* 1 or -1 once known.  */
10133965Sjdp#define	STACK_DIR	stack_dir
10233965Sjdp
10333965Sjdpstatic void
10433965Sjdpfind_stack_direction ()
10533965Sjdp{
10633965Sjdp  static char *addr = NULL;	/* Address of first `dummy', once known.  */
10733965Sjdp  auto char dummy;		/* To get stack address.  */
10833965Sjdp
10933965Sjdp  if (addr == NULL)
11033965Sjdp    {				/* Initial entry.  */
11133965Sjdp      addr = ADDRESS_FUNCTION (dummy);
11233965Sjdp
11333965Sjdp      find_stack_direction ();	/* Recurse once.  */
11433965Sjdp    }
11533965Sjdp  else
11633965Sjdp    {
11733965Sjdp      /* Second entry.  */
11833965Sjdp      if (ADDRESS_FUNCTION (dummy) > addr)
11933965Sjdp	stack_dir = 1;		/* Stack grew upward.  */
12033965Sjdp      else
12133965Sjdp	stack_dir = -1;		/* Stack grew downward.  */
12233965Sjdp    }
12333965Sjdp}
12433965Sjdp
12533965Sjdp#endif /* STACK_DIRECTION == 0 */
12633965Sjdp
12733965Sjdp/* An "alloca header" is used to:
12833965Sjdp   (a) chain together all alloca'ed blocks;
12933965Sjdp   (b) keep track of stack depth.
13033965Sjdp
13133965Sjdp   It is very important that sizeof(header) agree with malloc
13233965Sjdp   alignment chunk size.  The following default should work okay.  */
13333965Sjdp
13433965Sjdp#ifndef	ALIGN_SIZE
13533965Sjdp#define	ALIGN_SIZE	sizeof(double)
13633965Sjdp#endif
13733965Sjdp
13833965Sjdptypedef union hdr
13933965Sjdp{
14033965Sjdp  char align[ALIGN_SIZE];	/* To force sizeof(header).  */
14133965Sjdp  struct
14233965Sjdp    {
14333965Sjdp      union hdr *next;		/* For chaining headers.  */
14433965Sjdp      char *deep;		/* For stack depth measure.  */
14533965Sjdp    } h;
14633965Sjdp} header;
14733965Sjdp
14833965Sjdpstatic header *last_alloca_header = NULL;	/* -> last alloca header.  */
14933965Sjdp
15033965Sjdp/* Return a pointer to at least SIZE bytes of storage,
15133965Sjdp   which will be automatically reclaimed upon exit from
15233965Sjdp   the procedure that called alloca.  Originally, this space
15333965Sjdp   was supposed to be taken from the current stack frame of the
15433965Sjdp   caller, but that method cannot be made to work for some
15533965Sjdp   implementations of C, for example under Gould's UTX/32.  */
15633965Sjdp
15733965Sjdppointer
15833965Sjdpalloca (size)
15933965Sjdp     size_t size;
16033965Sjdp{
16133965Sjdp  auto char probe;		/* Probes stack depth: */
16233965Sjdp  register char *depth = ADDRESS_FUNCTION (probe);
16333965Sjdp
16433965Sjdp#if STACK_DIRECTION == 0
16533965Sjdp  if (STACK_DIR == 0)		/* Unknown growth direction.  */
16633965Sjdp    find_stack_direction ();
16733965Sjdp#endif
16833965Sjdp
16933965Sjdp  /* Reclaim garbage, defined as all alloca'd storage that
17033965Sjdp     was allocated from deeper in the stack than currently. */
17133965Sjdp
17233965Sjdp  {
17333965Sjdp    register header *hp;	/* Traverses linked list.  */
17433965Sjdp
17533965Sjdp    for (hp = last_alloca_header; hp != NULL;)
17633965Sjdp      if ((STACK_DIR > 0 && hp->h.deep > depth)
17733965Sjdp	  || (STACK_DIR < 0 && hp->h.deep < depth))
17833965Sjdp	{
17933965Sjdp	  register header *np = hp->h.next;
18033965Sjdp
18133965Sjdp	  free ((pointer) hp);	/* Collect garbage.  */
18233965Sjdp
18333965Sjdp	  hp = np;		/* -> next header.  */
18433965Sjdp	}
18533965Sjdp      else
18633965Sjdp	break;			/* Rest are not deeper.  */
18733965Sjdp
18833965Sjdp    last_alloca_header = hp;	/* -> last valid storage.  */
18933965Sjdp  }
19033965Sjdp
19133965Sjdp  if (size == 0)
19233965Sjdp    return NULL;		/* No allocation required.  */
19333965Sjdp
19433965Sjdp  /* Allocate combined header + user data storage.  */
19533965Sjdp
19633965Sjdp  {
19733965Sjdp    register pointer new = malloc (sizeof (header) + size);
19833965Sjdp    /* Address of header.  */
19933965Sjdp
20033965Sjdp    ((header *) new)->h.next = last_alloca_header;
20133965Sjdp    ((header *) new)->h.deep = depth;
20233965Sjdp
20333965Sjdp    last_alloca_header = (header *) new;
20433965Sjdp
20533965Sjdp    /* User storage begins just after header.  */
20633965Sjdp
20733965Sjdp    return (pointer) ((char *) new + sizeof (header));
20833965Sjdp  }
20933965Sjdp}
21033965Sjdp
21133965Sjdp#if defined (CRAY) && defined (CRAY_STACKSEG_END)
21233965Sjdp
21333965Sjdp#ifdef DEBUG_I00AFUNC
21433965Sjdp#include <stdio.h>
21533965Sjdp#endif
21633965Sjdp
21733965Sjdp#ifndef CRAY_STACK
21833965Sjdp#define CRAY_STACK
21933965Sjdp#ifndef CRAY2
22033965Sjdp/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
22133965Sjdpstruct stack_control_header
22233965Sjdp  {
22333965Sjdp    long shgrow:32;		/* Number of times stack has grown.  */
22433965Sjdp    long shaseg:32;		/* Size of increments to stack.  */
22533965Sjdp    long shhwm:32;		/* High water mark of stack.  */
22633965Sjdp    long shsize:32;		/* Current size of stack (all segments).  */
22733965Sjdp  };
22833965Sjdp
22933965Sjdp/* The stack segment linkage control information occurs at
23033965Sjdp   the high-address end of a stack segment.  (The stack
23133965Sjdp   grows from low addresses to high addresses.)  The initial
23233965Sjdp   part of the stack segment linkage control information is
23333965Sjdp   0200 (octal) words.  This provides for register storage
23433965Sjdp   for the routine which overflows the stack.  */
23533965Sjdp
23633965Sjdpstruct stack_segment_linkage
23733965Sjdp  {
23833965Sjdp    long ss[0200];		/* 0200 overflow words.  */
23933965Sjdp    long sssize:32;		/* Number of words in this segment.  */
24033965Sjdp    long ssbase:32;		/* Offset to stack base.  */
24133965Sjdp    long:32;
24233965Sjdp    long sspseg:32;		/* Offset to linkage control of previous
24333965Sjdp				   segment of stack.  */
24433965Sjdp    long:32;
24533965Sjdp    long sstcpt:32;		/* Pointer to task common address block.  */
24633965Sjdp    long sscsnm;		/* Private control structure number for
24733965Sjdp				   microtasking.  */
24833965Sjdp    long ssusr1;		/* Reserved for user.  */
24933965Sjdp    long ssusr2;		/* Reserved for user.  */
25033965Sjdp    long sstpid;		/* Process ID for pid based multi-tasking.  */
25133965Sjdp    long ssgvup;		/* Pointer to multitasking thread giveup.  */
25233965Sjdp    long sscray[7];		/* Reserved for Cray Research.  */
25333965Sjdp    long ssa0;
25433965Sjdp    long ssa1;
25533965Sjdp    long ssa2;
25633965Sjdp    long ssa3;
25733965Sjdp    long ssa4;
25833965Sjdp    long ssa5;
25933965Sjdp    long ssa6;
26033965Sjdp    long ssa7;
26133965Sjdp    long sss0;
26233965Sjdp    long sss1;
26333965Sjdp    long sss2;
26433965Sjdp    long sss3;
26533965Sjdp    long sss4;
26633965Sjdp    long sss5;
26733965Sjdp    long sss6;
26833965Sjdp    long sss7;
26933965Sjdp  };
27033965Sjdp
27133965Sjdp#else /* CRAY2 */
27233965Sjdp/* The following structure defines the vector of words
27333965Sjdp   returned by the STKSTAT library routine.  */
27433965Sjdpstruct stk_stat
27533965Sjdp  {
27633965Sjdp    long now;			/* Current total stack size.  */
27733965Sjdp    long maxc;			/* Amount of contiguous space which would
27833965Sjdp				   be required to satisfy the maximum
27933965Sjdp				   stack demand to date.  */
28033965Sjdp    long high_water;		/* Stack high-water mark.  */
28133965Sjdp    long overflows;		/* Number of stack overflow ($STKOFEN) calls.  */
28233965Sjdp    long hits;			/* Number of internal buffer hits.  */
28333965Sjdp    long extends;		/* Number of block extensions.  */
28433965Sjdp    long stko_mallocs;		/* Block allocations by $STKOFEN.  */
28533965Sjdp    long underflows;		/* Number of stack underflow calls ($STKRETN).  */
28633965Sjdp    long stko_free;		/* Number of deallocations by $STKRETN.  */
28733965Sjdp    long stkm_free;		/* Number of deallocations by $STKMRET.  */
28833965Sjdp    long segments;		/* Current number of stack segments.  */
28933965Sjdp    long maxs;			/* Maximum number of stack segments so far.  */
29033965Sjdp    long pad_size;		/* Stack pad size.  */
29133965Sjdp    long current_address;	/* Current stack segment address.  */
29233965Sjdp    long current_size;		/* Current stack segment size.  This
29333965Sjdp				   number is actually corrupted by STKSTAT to
29433965Sjdp				   include the fifteen word trailer area.  */
29533965Sjdp    long initial_address;	/* Address of initial segment.  */
29633965Sjdp    long initial_size;		/* Size of initial segment.  */
29733965Sjdp  };
29833965Sjdp
29933965Sjdp/* The following structure describes the data structure which trails
30033965Sjdp   any stack segment.  I think that the description in 'asdef' is
30133965Sjdp   out of date.  I only describe the parts that I am sure about.  */
30233965Sjdp
30333965Sjdpstruct stk_trailer
30433965Sjdp  {
30533965Sjdp    long this_address;		/* Address of this block.  */
30633965Sjdp    long this_size;		/* Size of this block (does not include
30733965Sjdp				   this trailer).  */
30833965Sjdp    long unknown2;
30933965Sjdp    long unknown3;
31033965Sjdp    long link;			/* Address of trailer block of previous
31133965Sjdp				   segment.  */
31233965Sjdp    long unknown5;
31333965Sjdp    long unknown6;
31433965Sjdp    long unknown7;
31533965Sjdp    long unknown8;
31633965Sjdp    long unknown9;
31733965Sjdp    long unknown10;
31833965Sjdp    long unknown11;
31933965Sjdp    long unknown12;
32033965Sjdp    long unknown13;
32133965Sjdp    long unknown14;
32233965Sjdp  };
32333965Sjdp
32433965Sjdp#endif /* CRAY2 */
32533965Sjdp#endif /* not CRAY_STACK */
32633965Sjdp
32733965Sjdp#ifdef CRAY2
32833965Sjdp/* Determine a "stack measure" for an arbitrary ADDRESS.
32933965Sjdp   I doubt that "lint" will like this much. */
33033965Sjdp
33133965Sjdpstatic long
33233965Sjdpi00afunc (long *address)
33333965Sjdp{
33433965Sjdp  struct stk_stat status;
33533965Sjdp  struct stk_trailer *trailer;
33633965Sjdp  long *block, size;
33733965Sjdp  long result = 0;
33833965Sjdp
33933965Sjdp  /* We want to iterate through all of the segments.  The first
34033965Sjdp     step is to get the stack status structure.  We could do this
34133965Sjdp     more quickly and more directly, perhaps, by referencing the
34233965Sjdp     $LM00 common block, but I know that this works.  */
34333965Sjdp
34433965Sjdp  STKSTAT (&status);
34533965Sjdp
34633965Sjdp  /* Set up the iteration.  */
34733965Sjdp
34833965Sjdp  trailer = (struct stk_trailer *) (status.current_address
34933965Sjdp				    + status.current_size
35033965Sjdp				    - 15);
35133965Sjdp
35233965Sjdp  /* There must be at least one stack segment.  Therefore it is
35333965Sjdp     a fatal error if "trailer" is null.  */
35433965Sjdp
35533965Sjdp  if (trailer == 0)
35633965Sjdp    abort ();
35733965Sjdp
35833965Sjdp  /* Discard segments that do not contain our argument address.  */
35933965Sjdp
36033965Sjdp  while (trailer != 0)
36133965Sjdp    {
36233965Sjdp      block = (long *) trailer->this_address;
36333965Sjdp      size = trailer->this_size;
36433965Sjdp      if (block == 0 || size == 0)
36533965Sjdp	abort ();
36633965Sjdp      trailer = (struct stk_trailer *) trailer->link;
36733965Sjdp      if ((block <= address) && (address < (block + size)))
36833965Sjdp	break;
36933965Sjdp    }
37033965Sjdp
37133965Sjdp  /* Set the result to the offset in this segment and add the sizes
37233965Sjdp     of all predecessor segments.  */
37333965Sjdp
37433965Sjdp  result = address - block;
37533965Sjdp
37633965Sjdp  if (trailer == 0)
37733965Sjdp    {
37833965Sjdp      return result;
37933965Sjdp    }
38033965Sjdp
38133965Sjdp  do
38233965Sjdp    {
38333965Sjdp      if (trailer->this_size <= 0)
38433965Sjdp	abort ();
38533965Sjdp      result += trailer->this_size;
38633965Sjdp      trailer = (struct stk_trailer *) trailer->link;
38733965Sjdp    }
38833965Sjdp  while (trailer != 0);
38933965Sjdp
39033965Sjdp  /* We are done.  Note that if you present a bogus address (one
39133965Sjdp     not in any segment), you will get a different number back, formed
39233965Sjdp     from subtracting the address of the first block.  This is probably
39333965Sjdp     not what you want.  */
39433965Sjdp
39533965Sjdp  return (result);
39633965Sjdp}
39733965Sjdp
39833965Sjdp#else /* not CRAY2 */
39933965Sjdp/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
40033965Sjdp   Determine the number of the cell within the stack,
40133965Sjdp   given the address of the cell.  The purpose of this
40233965Sjdp   routine is to linearize, in some sense, stack addresses
40333965Sjdp   for alloca.  */
40433965Sjdp
40533965Sjdpstatic long
40633965Sjdpi00afunc (long address)
40733965Sjdp{
40833965Sjdp  long stkl = 0;
40933965Sjdp
41033965Sjdp  long size, pseg, this_segment, stack;
41133965Sjdp  long result = 0;
41233965Sjdp
41333965Sjdp  struct stack_segment_linkage *ssptr;
41433965Sjdp
41533965Sjdp  /* Register B67 contains the address of the end of the
41633965Sjdp     current stack segment.  If you (as a subprogram) store
41733965Sjdp     your registers on the stack and find that you are past
41833965Sjdp     the contents of B67, you have overflowed the segment.
41933965Sjdp
42033965Sjdp     B67 also points to the stack segment linkage control
42133965Sjdp     area, which is what we are really interested in.  */
42233965Sjdp
42333965Sjdp  stkl = CRAY_STACKSEG_END ();
42433965Sjdp  ssptr = (struct stack_segment_linkage *) stkl;
42533965Sjdp
42633965Sjdp  /* If one subtracts 'size' from the end of the segment,
42733965Sjdp     one has the address of the first word of the segment.
42833965Sjdp
42933965Sjdp     If this is not the first segment, 'pseg' will be
43033965Sjdp     nonzero.  */
43133965Sjdp
43233965Sjdp  pseg = ssptr->sspseg;
43333965Sjdp  size = ssptr->sssize;
43433965Sjdp
43533965Sjdp  this_segment = stkl - size;
43633965Sjdp
43733965Sjdp  /* It is possible that calling this routine itself caused
43833965Sjdp     a stack overflow.  Discard stack segments which do not
43933965Sjdp     contain the target address.  */
44033965Sjdp
44133965Sjdp  while (!(this_segment <= address && address <= stkl))
44233965Sjdp    {
44333965Sjdp#ifdef DEBUG_I00AFUNC
44433965Sjdp      fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
44533965Sjdp#endif
44633965Sjdp      if (pseg == 0)
44733965Sjdp	break;
44833965Sjdp      stkl = stkl - pseg;
44933965Sjdp      ssptr = (struct stack_segment_linkage *) stkl;
45033965Sjdp      size = ssptr->sssize;
45133965Sjdp      pseg = ssptr->sspseg;
45233965Sjdp      this_segment = stkl - size;
45333965Sjdp    }
45433965Sjdp
45533965Sjdp  result = address - this_segment;
45633965Sjdp
45733965Sjdp  /* If you subtract pseg from the current end of the stack,
45833965Sjdp     you get the address of the previous stack segment's end.
45933965Sjdp     This seems a little convoluted to me, but I'll bet you save
46033965Sjdp     a cycle somewhere.  */
46133965Sjdp
46233965Sjdp  while (pseg != 0)
46333965Sjdp    {
46433965Sjdp#ifdef DEBUG_I00AFUNC
46533965Sjdp      fprintf (stderr, "%011o %011o\n", pseg, size);
46633965Sjdp#endif
46733965Sjdp      stkl = stkl - pseg;
46833965Sjdp      ssptr = (struct stack_segment_linkage *) stkl;
46933965Sjdp      size = ssptr->sssize;
47033965Sjdp      pseg = ssptr->sspseg;
47133965Sjdp      result += size;
47233965Sjdp    }
47333965Sjdp  return (result);
47433965Sjdp}
47533965Sjdp
47633965Sjdp#endif /* not CRAY2 */
47733965Sjdp#endif /* CRAY */
47833965Sjdp
47933965Sjdp#endif /* no alloca */
480