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