Back to index

plt-scheme  4.2.1
alloca.c
Go to the documentation of this file.
00001 /* alloca.c -- allocate automatically reclaimed memory
00002    (Mostly) portable public-domain implementation -- D A Gwyn
00003 
00004    This implementation of the PWB library alloca function,
00005    which is used to allocate space off the run-time stack so
00006    that it is automatically reclaimed upon procedure exit,
00007    was inspired by discussions with J. Q. Johnson of Cornell.
00008    J.Otto Tennant <jot@cray.com> contributed the Cray support.
00009 
00010    There are some preprocessor constants that can
00011    be defined when compiling for your specific system, for
00012    improved efficiency; however, the defaults should be okay.
00013 
00014    The general concept of this implementation is to keep
00015    track of all alloca-allocated blocks, and reclaim any
00016    that are found to be deeper in the stack than the current
00017    invocation.  This heuristic does not reclaim storage as
00018    soon as it becomes invalid, but it will do so eventually.
00019 
00020    As a special case, alloca(0) reclaims storage without
00021    allocating any.  It is a good idea to use alloca(0) in
00022    your main control loop, etc. to force garbage collection.  */
00023 
00024 #ifdef HAVE_CONFIG_H
00025 #include <config.h>
00026 #endif
00027 
00028 #ifdef emacs
00029 #include "blockinput.h"
00030 #endif
00031 
00032 /* If compiling with GCC 2, this file's not needed.  */
00033 #if !defined (__GNUC__) || __GNUC__ < 2
00034 
00035 /* If someone has defined alloca as a macro,
00036    there must be some other way alloca is supposed to work.  */
00037 #ifndef alloca
00038 
00039 #ifdef emacs
00040 #ifdef static
00041 /* actually, only want this if static is defined as ""
00042    -- this is for usg, in which emacs must undefine static
00043    in order to make unexec workable
00044    */
00045 #ifndef STACK_DIRECTION
00046 you
00047 lose
00048 -- must know STACK_DIRECTION at compile-time
00049 #endif /* STACK_DIRECTION undefined */
00050 #endif /* static */
00051 #endif /* emacs */
00052 
00053 /* If your stack is a linked list of frames, you have to
00054    provide an "address metric" ADDRESS_FUNCTION macro.  */
00055 
00056 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
00057 long i00afunc ();
00058 #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
00059 #else
00060 #define ADDRESS_FUNCTION(arg) &(arg)
00061 #endif
00062 
00063 #if __STDC__
00064 typedef void *pointer;
00065 #else
00066 typedef char *pointer;
00067 #endif
00068 
00069 #define       NULL   0
00070 
00071 /* Different portions of Emacs need to call different versions of
00072    malloc.  The Emacs executable needs alloca to call xmalloc, because
00073    ordinary malloc isn't protected from input signals.  On the other
00074    hand, the utilities in lib-src need alloca to call malloc; some of
00075    them are very simple, and don't have an xmalloc routine.
00076 
00077    Non-Emacs programs expect this to call xmalloc.
00078 
00079    Callers below should use malloc.  */
00080 
00081 #ifndef emacs
00082 #define malloc xmalloc
00083 #endif
00084 extern pointer malloc ();
00085 
00086 /* Define STACK_DIRECTION if you know the direction of stack
00087    growth for your system; otherwise it will be automatically
00088    deduced at run-time.
00089 
00090    STACK_DIRECTION > 0 => grows toward higher addresses
00091    STACK_DIRECTION < 0 => grows toward lower addresses
00092    STACK_DIRECTION = 0 => direction of growth unknown  */
00093 
00094 #ifndef STACK_DIRECTION
00095 #define       STACK_DIRECTION      0      /* Direction unknown.  */
00096 #endif
00097 
00098 #if STACK_DIRECTION != 0
00099 
00100 #define       STACK_DIR     STACK_DIRECTION      /* Known at compile-time.  */
00101 
00102 #else /* STACK_DIRECTION == 0; need run-time code.  */
00103 
00104 static int stack_dir;              /* 1 or -1 once known.  */
00105 #define       STACK_DIR     stack_dir
00106 
00107 static void
00108 find_stack_direction ()
00109 {
00110   static char *addr = NULL; /* Address of first `dummy', once known.  */
00111   auto char dummy;          /* To get stack address.  */
00112 
00113   if (addr == NULL)
00114     {                       /* Initial entry.  */
00115       addr = ADDRESS_FUNCTION (dummy);
00116 
00117       find_stack_direction ();     /* Recurse once.  */
00118     }
00119   else
00120     {
00121       /* Second entry.  */
00122       if (ADDRESS_FUNCTION (dummy) > addr)
00123        stack_dir = 1;              /* Stack grew upward.  */
00124       else
00125        stack_dir = -1;             /* Stack grew downward.  */
00126     }
00127 }
00128 
00129 #endif /* STACK_DIRECTION == 0 */
00130 
00131 /* An "alloca header" is used to:
00132    (a) chain together all alloca'ed blocks;
00133    (b) keep track of stack depth.
00134 
00135    It is very important that sizeof(header) agree with malloc
00136    alignment chunk size.  The following default should work okay.  */
00137 
00138 #ifndef       ALIGN_SIZE
00139 #define       ALIGN_SIZE    sizeof(double)
00140 #endif
00141 
00142 typedef union hdr
00143 {
00144   char align[ALIGN_SIZE];   /* To force sizeof(header).  */
00145   struct
00146     {
00147       union hdr *next;             /* For chaining headers.  */
00148       char *deep;           /* For stack depth measure.  */
00149     } h;
00150 } header;
00151 
00152 static header *last_alloca_header = NULL; /* -> last alloca header.  */
00153 
00154 /* Return a pointer to at least SIZE bytes of storage,
00155    which will be automatically reclaimed upon exit from
00156    the procedure that called alloca.  Originally, this space
00157    was supposed to be taken from the current stack frame of the
00158    caller, but that method cannot be made to work for some
00159    implementations of C, for example under Gould's UTX/32.  */
00160 
00161 pointer
00162 alloca (size)
00163      unsigned size;
00164 {
00165   auto char probe;          /* Probes stack depth: */
00166   register char *depth = ADDRESS_FUNCTION (probe);
00167 
00168 #if STACK_DIRECTION == 0
00169   if (STACK_DIR == 0)              /* Unknown growth direction.  */
00170     find_stack_direction ();
00171 #endif
00172 
00173   /* Reclaim garbage, defined as all alloca'd storage that
00174      was allocated from deeper in the stack than currently. */
00175 
00176   {
00177     register header *hp;    /* Traverses linked list.  */
00178 
00179 #ifdef emacs
00180     BLOCK_INPUT;
00181 #endif
00182 
00183     for (hp = last_alloca_header; hp != NULL;)
00184       if ((STACK_DIR > 0 && hp->h.deep > depth)
00185          || (STACK_DIR < 0 && hp->h.deep < depth))
00186        {
00187          register header *np = hp->h.next;
00188 
00189          free ((pointer) hp);      /* Collect garbage.  */
00190 
00191          hp = np;           /* -> next header.  */
00192        }
00193       else
00194        break;               /* Rest are not deeper.  */
00195 
00196     last_alloca_header = hp;       /* -> last valid storage.  */
00197 
00198 #ifdef emacs
00199     UNBLOCK_INPUT;
00200 #endif
00201   }
00202 
00203   if (size == 0)
00204     return NULL;            /* No allocation required.  */
00205 
00206   /* Allocate combined header + user data storage.  */
00207 
00208   {
00209     register pointer new = malloc (sizeof (header) + size);
00210     /* Address of header.  */
00211 
00212     ((header *) new)->h.next = last_alloca_header;
00213     ((header *) new)->h.deep = depth;
00214 
00215     last_alloca_header = (header *) new;
00216 
00217     /* User storage begins just after header.  */
00218 
00219     return (pointer) ((char *) new + sizeof (header));
00220   }
00221 }
00222 
00223 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
00224 
00225 #ifdef DEBUG_I00AFUNC
00226 #include <stdio.h>
00227 #endif
00228 
00229 #ifndef CRAY_STACK
00230 #define CRAY_STACK
00231 #ifndef CRAY2
00232 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
00233 struct stack_control_header
00234   {
00235     long shgrow:32;         /* Number of times stack has grown.  */
00236     long shaseg:32;         /* Size of increments to stack.  */
00237     long shhwm:32;          /* High water mark of stack.  */
00238     long shsize:32;         /* Current size of stack (all segments).  */
00239   };
00240 
00241 /* The stack segment linkage control information occurs at
00242    the high-address end of a stack segment.  (The stack
00243    grows from low addresses to high addresses.)  The initial
00244    part of the stack segment linkage control information is
00245    0200 (octal) words.  This provides for register storage
00246    for the routine which overflows the stack.  */
00247 
00248 struct stack_segment_linkage
00249   {
00250     long ss[0200];          /* 0200 overflow words.  */
00251     long sssize:32;         /* Number of words in this segment.  */
00252     long ssbase:32;         /* Offset to stack base.  */
00253     long:32;
00254     long sspseg:32;         /* Offset to linkage control of previous
00255                                segment of stack.  */
00256     long:32;
00257     long sstcpt:32;         /* Pointer to task common address block.  */
00258     long sscsnm;            /* Private control structure number for
00259                                microtasking.  */
00260     long ssusr1;            /* Reserved for user.  */
00261     long ssusr2;            /* Reserved for user.  */
00262     long sstpid;            /* Process ID for pid based multi-tasking.  */
00263     long ssgvup;            /* Pointer to multitasking thread giveup.  */
00264     long sscray[7];         /* Reserved for Cray Research.  */
00265     long ssa0;
00266     long ssa1;
00267     long ssa2;
00268     long ssa3;
00269     long ssa4;
00270     long ssa5;
00271     long ssa6;
00272     long ssa7;
00273     long sss0;
00274     long sss1;
00275     long sss2;
00276     long sss3;
00277     long sss4;
00278     long sss5;
00279     long sss6;
00280     long sss7;
00281   };
00282 
00283 #else /* CRAY2 */
00284 /* The following structure defines the vector of words
00285    returned by the STKSTAT library routine.  */
00286 struct stk_stat
00287   {
00288     long now;               /* Current total stack size.  */
00289     long maxc;                     /* Amount of contiguous space which would
00290                                be required to satisfy the maximum
00291                                stack demand to date.  */
00292     long high_water;        /* Stack high-water mark.  */
00293     long overflows;         /* Number of stack overflow ($STKOFEN) calls.  */
00294     long hits;                     /* Number of internal buffer hits.  */
00295     long extends;           /* Number of block extensions.  */
00296     long stko_mallocs;             /* Block allocations by $STKOFEN.  */
00297     long underflows;        /* Number of stack underflow calls ($STKRETN).  */
00298     long stko_free;         /* Number of deallocations by $STKRETN.  */
00299     long stkm_free;         /* Number of deallocations by $STKMRET.  */
00300     long segments;          /* Current number of stack segments.  */
00301     long maxs;                     /* Maximum number of stack segments so far.  */
00302     long pad_size;          /* Stack pad size.  */
00303     long current_address;   /* Current stack segment address.  */
00304     long current_size;             /* Current stack segment size.  This
00305                                number is actually corrupted by STKSTAT to
00306                                include the fifteen word trailer area.  */
00307     long initial_address;   /* Address of initial segment.  */
00308     long initial_size;             /* Size of initial segment.  */
00309   };
00310 
00311 /* The following structure describes the data structure which trails
00312    any stack segment.  I think that the description in 'asdef' is
00313    out of date.  I only describe the parts that I am sure about.  */
00314 
00315 struct stk_trailer
00316   {
00317     long this_address;             /* Address of this block.  */
00318     long this_size;         /* Size of this block (does not include
00319                                this trailer).  */
00320     long unknown2;
00321     long unknown3;
00322     long link;                     /* Address of trailer block of previous
00323                                segment.  */
00324     long unknown5;
00325     long unknown6;
00326     long unknown7;
00327     long unknown8;
00328     long unknown9;
00329     long unknown10;
00330     long unknown11;
00331     long unknown12;
00332     long unknown13;
00333     long unknown14;
00334   };
00335 
00336 #endif /* CRAY2 */
00337 #endif /* not CRAY_STACK */
00338 
00339 #ifdef CRAY2
00340 /* Determine a "stack measure" for an arbitrary ADDRESS.
00341    I doubt that "lint" will like this much. */
00342 
00343 static long
00344 i00afunc (long *address)
00345 {
00346   struct stk_stat status;
00347   struct stk_trailer *trailer;
00348   long *block, size;
00349   long result = 0;
00350 
00351   /* We want to iterate through all of the segments.  The first
00352      step is to get the stack status structure.  We could do this
00353      more quickly and more directly, perhaps, by referencing the
00354      $LM00 common block, but I know that this works.  */
00355 
00356   STKSTAT (&status);
00357 
00358   /* Set up the iteration.  */
00359 
00360   trailer = (struct stk_trailer *) (status.current_address
00361                                 + status.current_size
00362                                 - 15);
00363 
00364   /* There must be at least one stack segment.  Therefore it is
00365      a fatal error if "trailer" is null.  */
00366 
00367   if (trailer == 0)
00368     abort ();
00369 
00370   /* Discard segments that do not contain our argument address.  */
00371 
00372   while (trailer != 0)
00373     {
00374       block = (long *) trailer->this_address;
00375       size = trailer->this_size;
00376       if (block == 0 || size == 0)
00377        abort ();
00378       trailer = (struct stk_trailer *) trailer->link;
00379       if ((block <= address) && (address < (block + size)))
00380        break;
00381     }
00382 
00383   /* Set the result to the offset in this segment and add the sizes
00384      of all predecessor segments.  */
00385 
00386   result = address - block;
00387 
00388   if (trailer == 0)
00389     {
00390       return result;
00391     }
00392 
00393   do
00394     {
00395       if (trailer->this_size <= 0)
00396        abort ();
00397       result += trailer->this_size;
00398       trailer = (struct stk_trailer *) trailer->link;
00399     }
00400   while (trailer != 0);
00401 
00402   /* We are done.  Note that if you present a bogus address (one
00403      not in any segment), you will get a different number back, formed
00404      from subtracting the address of the first block.  This is probably
00405      not what you want.  */
00406 
00407   return (result);
00408 }
00409 
00410 #else /* not CRAY2 */
00411 /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
00412    Determine the number of the cell within the stack,
00413    given the address of the cell.  The purpose of this
00414    routine is to linearize, in some sense, stack addresses
00415    for alloca.  */
00416 
00417 static long
00418 i00afunc (long address)
00419 {
00420   long stkl = 0;
00421 
00422   long size, pseg, this_segment, stack;
00423   long result = 0;
00424 
00425   struct stack_segment_linkage *ssptr;
00426 
00427   /* Register B67 contains the address of the end of the
00428      current stack segment.  If you (as a subprogram) store
00429      your registers on the stack and find that you are past
00430      the contents of B67, you have overflowed the segment.
00431 
00432      B67 also points to the stack segment linkage control
00433      area, which is what we are really interested in.  */
00434 
00435   stkl = CRAY_STACKSEG_END ();
00436   ssptr = (struct stack_segment_linkage *) stkl;
00437 
00438   /* If one subtracts 'size' from the end of the segment,
00439      one has the address of the first word of the segment.
00440 
00441      If this is not the first segment, 'pseg' will be
00442      nonzero.  */
00443 
00444   pseg = ssptr->sspseg;
00445   size = ssptr->sssize;
00446 
00447   this_segment = stkl - size;
00448 
00449   /* It is possible that calling this routine itself caused
00450      a stack overflow.  Discard stack segments which do not
00451      contain the target address.  */
00452 
00453   while (!(this_segment <= address && address <= stkl))
00454     {
00455 #ifdef DEBUG_I00AFUNC
00456       fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
00457 #endif
00458       if (pseg == 0)
00459        break;
00460       stkl = stkl - pseg;
00461       ssptr = (struct stack_segment_linkage *) stkl;
00462       size = ssptr->sssize;
00463       pseg = ssptr->sspseg;
00464       this_segment = stkl - size;
00465     }
00466 
00467   result = address - this_segment;
00468 
00469   /* If you subtract pseg from the current end of the stack,
00470      you get the address of the previous stack segment's end.
00471      This seems a little convoluted to me, but I'll bet you save
00472      a cycle somewhere.  */
00473 
00474   while (pseg != 0)
00475     {
00476 #ifdef DEBUG_I00AFUNC
00477       fprintf (stderr, "%011o %011o\n", pseg, size);
00478 #endif
00479       stkl = stkl - pseg;
00480       ssptr = (struct stack_segment_linkage *) stkl;
00481       size = ssptr->sssize;
00482       pseg = ssptr->sspseg;
00483       result += size;
00484     }
00485   return (result);
00486 }
00487 
00488 #endif /* not CRAY2 */
00489 #endif /* CRAY */
00490 
00491 #endif /* no alloca */
00492 #endif /* not GCC version 2 */