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