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