src/alloca.c

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