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