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 2 */