gl/alloca.c

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