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