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