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 #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
  56 you
  57 lose
  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)
  69 long 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
  93 static int stack_dir;           /* 1 or -1 once known.  */
  94 #   define STACK_DIR    stack_dir
  95
  96 static void
  97 find_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
 131 typedef 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
 141 static 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
 150 void *
 151 alloca (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 */
 230 struct 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
 245 struct 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.  */
 283 struct 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
 312 struct 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
 340 static long
 341 i00afunc (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
 414 static long
 415 i00afunc (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 3 */