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