* trans-stmt.c (gfc_trans_simple_do): New function.
[official-gcc.git] / libiberty / obstack.c
blob02560c9e032e398aeeb726435e9104336d2b1514
1 /* obstack.c - subroutines used implicitly by object stack macros
2 Copyright (C) 1988,89,90,91,92,93,94,96,97 Free Software Foundation, Inc.
5 NOTE: This source is derived from an old version taken from the GNU C
6 Library (glibc).
8 This program is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
21 USA. */
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
27 #include "obstack.h"
29 /* NOTE BEFORE MODIFYING THIS FILE: This version number must be
30 incremented whenever callers compiled using an old obstack.h can no
31 longer properly call the functions in this obstack.c. */
32 #define OBSTACK_INTERFACE_VERSION 1
34 /* Comment out all this code if we are using the GNU C Library, and are not
35 actually compiling the library itself, and the installed library
36 supports the same library interface we do. This code is part of the GNU
37 C Library, but also included in many other GNU distributions. Compiling
38 and linking in this code is a waste when using the GNU C library
39 (especially if it is a shared library). Rather than having every GNU
40 program understand `configure --with-gnu-libc' and omit the object
41 files, it is simpler to just do this in the source for each such file. */
43 #include <stdio.h> /* Random thing to get __GNU_LIBRARY__. */
44 #if !defined (_LIBC) && defined (__GNU_LIBRARY__) && __GNU_LIBRARY__ > 1
45 #include <gnu-versions.h>
46 #if _GNU_OBSTACK_INTERFACE_VERSION == OBSTACK_INTERFACE_VERSION
47 #define ELIDE_CODE
48 #endif
49 #endif
52 #ifndef ELIDE_CODE
55 #if defined (__STDC__) && __STDC__
56 #define POINTER void *
57 #else
58 #define POINTER char *
59 #endif
61 /* Determine default alignment. */
62 struct fooalign {char x; double d;};
63 #define DEFAULT_ALIGNMENT \
64 ((PTR_INT_TYPE) ((char *) &((struct fooalign *) 0)->d - (char *) 0))
65 /* If malloc were really smart, it would round addresses to DEFAULT_ALIGNMENT.
66 But in fact it might be less smart and round addresses to as much as
67 DEFAULT_ROUNDING. So we prepare for it to do that. */
68 union fooround {long x; double d;};
69 #define DEFAULT_ROUNDING (sizeof (union fooround))
71 /* When we copy a long block of data, this is the unit to do it with.
72 On some machines, copying successive ints does not work;
73 in such a case, redefine COPYING_UNIT to `long' (if that works)
74 or `char' as a last resort. */
75 #ifndef COPYING_UNIT
76 #define COPYING_UNIT int
77 #endif
80 /* The functions allocating more room by calling `obstack_chunk_alloc'
81 jump to the handler pointed to by `obstack_alloc_failed_handler'.
82 This variable by default points to the internal function
83 `print_and_abort'. */
84 #if defined (__STDC__) && __STDC__
85 static void print_and_abort (void);
86 void (*obstack_alloc_failed_handler) (void) = print_and_abort;
87 #else
88 static void print_and_abort ();
89 void (*obstack_alloc_failed_handler) () = print_and_abort;
90 #endif
92 /* Exit value used when `print_and_abort' is used. */
93 #if defined __GNU_LIBRARY__ || defined HAVE_STDLIB_H
94 #include <stdlib.h>
95 #endif
96 #ifndef EXIT_FAILURE
97 #define EXIT_FAILURE 1
98 #endif
99 int obstack_exit_failure = EXIT_FAILURE;
101 /* The non-GNU-C macros copy the obstack into this global variable
102 to avoid multiple evaluation. */
104 struct obstack *_obstack;
106 /* Define a macro that either calls functions with the traditional malloc/free
107 calling interface, or calls functions with the mmalloc/mfree interface
108 (that adds an extra first argument), based on the state of use_extra_arg.
109 For free, do not use ?:, since some compilers, like the MIPS compilers,
110 do not allow (expr) ? void : void. */
112 #if defined (__STDC__) && __STDC__
113 #define CALL_CHUNKFUN(h, size) \
114 (((h) -> use_extra_arg) \
115 ? (*(h)->chunkfun) ((h)->extra_arg, (size)) \
116 : (*(struct _obstack_chunk *(*) (long)) (h)->chunkfun) ((size)))
118 #define CALL_FREEFUN(h, old_chunk) \
119 do { \
120 if ((h) -> use_extra_arg) \
121 (*(h)->freefun) ((h)->extra_arg, (old_chunk)); \
122 else \
123 (*(void (*) (void *)) (h)->freefun) ((old_chunk)); \
124 } while (0)
125 #else
126 #define CALL_CHUNKFUN(h, size) \
127 (((h) -> use_extra_arg) \
128 ? (*(h)->chunkfun) ((h)->extra_arg, (size)) \
129 : (*(struct _obstack_chunk *(*) ()) (h)->chunkfun) ((size)))
131 #define CALL_FREEFUN(h, old_chunk) \
132 do { \
133 if ((h) -> use_extra_arg) \
134 (*(h)->freefun) ((h)->extra_arg, (old_chunk)); \
135 else \
136 (*(void (*) ()) (h)->freefun) ((old_chunk)); \
137 } while (0)
138 #endif
141 /* Initialize an obstack H for use. Specify chunk size SIZE (0 means default).
142 Objects start on multiples of ALIGNMENT (0 means use default).
143 CHUNKFUN is the function to use to allocate chunks,
144 and FREEFUN the function to free them.
146 Return nonzero if successful, zero if out of memory.
147 To recover from an out of memory error,
148 free up some memory, then call this again. */
151 _obstack_begin (h, size, alignment, chunkfun, freefun)
152 struct obstack *h;
153 int size;
154 int alignment;
155 #if defined (__STDC__) && __STDC__
156 POINTER (*chunkfun) (long);
157 void (*freefun) (void *);
158 #else
159 POINTER (*chunkfun) ();
160 void (*freefun) ();
161 #endif
163 register struct _obstack_chunk *chunk; /* points to new chunk */
165 if (alignment == 0)
166 alignment = (int) DEFAULT_ALIGNMENT;
167 if (size == 0)
168 /* Default size is what GNU malloc can fit in a 4096-byte block. */
170 /* 12 is sizeof (mhead) and 4 is EXTRA from GNU malloc.
171 Use the values for range checking, because if range checking is off,
172 the extra bytes won't be missed terribly, but if range checking is on
173 and we used a larger request, a whole extra 4096 bytes would be
174 allocated.
176 These number are irrelevant to the new GNU malloc. I suspect it is
177 less sensitive to the size of the request. */
178 int extra = ((((12 + DEFAULT_ROUNDING - 1) & ~(DEFAULT_ROUNDING - 1))
179 + 4 + DEFAULT_ROUNDING - 1)
180 & ~(DEFAULT_ROUNDING - 1));
181 size = 4096 - extra;
184 #if defined (__STDC__) && __STDC__
185 h->chunkfun = (struct _obstack_chunk * (*)(void *, long)) chunkfun;
186 h->freefun = (void (*) (void *, struct _obstack_chunk *)) freefun;
187 #else
188 h->chunkfun = (struct _obstack_chunk * (*)()) chunkfun;
189 h->freefun = freefun;
190 #endif
191 h->chunk_size = size;
192 h->alignment_mask = alignment - 1;
193 h->use_extra_arg = 0;
195 chunk = h->chunk = CALL_CHUNKFUN (h, h -> chunk_size);
196 if (!chunk)
197 (*obstack_alloc_failed_handler) ();
198 h->next_free = h->object_base = chunk->contents;
199 h->chunk_limit = chunk->limit
200 = (char *) chunk + h->chunk_size;
201 chunk->prev = 0;
202 /* The initial chunk now contains no empty object. */
203 h->maybe_empty_object = 0;
204 h->alloc_failed = 0;
205 return 1;
209 _obstack_begin_1 (h, size, alignment, chunkfun, freefun, arg)
210 struct obstack *h;
211 int size;
212 int alignment;
213 #if defined (__STDC__) && __STDC__
214 POINTER (*chunkfun) (POINTER, long);
215 void (*freefun) (POINTER, POINTER);
216 #else
217 POINTER (*chunkfun) ();
218 void (*freefun) ();
219 #endif
220 POINTER arg;
222 register struct _obstack_chunk *chunk; /* points to new chunk */
224 if (alignment == 0)
225 alignment = (int) DEFAULT_ALIGNMENT;
226 if (size == 0)
227 /* Default size is what GNU malloc can fit in a 4096-byte block. */
229 /* 12 is sizeof (mhead) and 4 is EXTRA from GNU malloc.
230 Use the values for range checking, because if range checking is off,
231 the extra bytes won't be missed terribly, but if range checking is on
232 and we used a larger request, a whole extra 4096 bytes would be
233 allocated.
235 These number are irrelevant to the new GNU malloc. I suspect it is
236 less sensitive to the size of the request. */
237 int extra = ((((12 + DEFAULT_ROUNDING - 1) & ~(DEFAULT_ROUNDING - 1))
238 + 4 + DEFAULT_ROUNDING - 1)
239 & ~(DEFAULT_ROUNDING - 1));
240 size = 4096 - extra;
243 #if defined(__STDC__) && __STDC__
244 h->chunkfun = (struct _obstack_chunk * (*)(void *,long)) chunkfun;
245 h->freefun = (void (*) (void *, struct _obstack_chunk *)) freefun;
246 #else
247 h->chunkfun = (struct _obstack_chunk * (*)()) chunkfun;
248 h->freefun = freefun;
249 #endif
250 h->chunk_size = size;
251 h->alignment_mask = alignment - 1;
252 h->extra_arg = arg;
253 h->use_extra_arg = 1;
255 chunk = h->chunk = CALL_CHUNKFUN (h, h -> chunk_size);
256 if (!chunk)
257 (*obstack_alloc_failed_handler) ();
258 h->next_free = h->object_base = chunk->contents;
259 h->chunk_limit = chunk->limit
260 = (char *) chunk + h->chunk_size;
261 chunk->prev = 0;
262 /* The initial chunk now contains no empty object. */
263 h->maybe_empty_object = 0;
264 h->alloc_failed = 0;
265 return 1;
268 /* Allocate a new current chunk for the obstack *H
269 on the assumption that LENGTH bytes need to be added
270 to the current object, or a new object of length LENGTH allocated.
271 Copies any partial object from the end of the old chunk
272 to the beginning of the new one. */
274 void
275 _obstack_newchunk (h, length)
276 struct obstack *h;
277 int length;
279 register struct _obstack_chunk *old_chunk = h->chunk;
280 register struct _obstack_chunk *new_chunk;
281 register long new_size;
282 register long obj_size = h->next_free - h->object_base;
283 register long i;
284 long already;
286 /* Compute size for new chunk. */
287 new_size = (obj_size + length) + (obj_size >> 3) + 100;
288 if (new_size < h->chunk_size)
289 new_size = h->chunk_size;
291 /* Allocate and initialize the new chunk. */
292 new_chunk = CALL_CHUNKFUN (h, new_size);
293 if (!new_chunk)
294 (*obstack_alloc_failed_handler) ();
295 h->chunk = new_chunk;
296 new_chunk->prev = old_chunk;
297 new_chunk->limit = h->chunk_limit = (char *) new_chunk + new_size;
299 /* Move the existing object to the new chunk.
300 Word at a time is fast and is safe if the object
301 is sufficiently aligned. */
302 if (h->alignment_mask + 1 >= DEFAULT_ALIGNMENT)
304 for (i = obj_size / sizeof (COPYING_UNIT) - 1;
305 i >= 0; i--)
306 ((COPYING_UNIT *)new_chunk->contents)[i]
307 = ((COPYING_UNIT *)h->object_base)[i];
308 /* We used to copy the odd few remaining bytes as one extra COPYING_UNIT,
309 but that can cross a page boundary on a machine
310 which does not do strict alignment for COPYING_UNITS. */
311 already = obj_size / sizeof (COPYING_UNIT) * sizeof (COPYING_UNIT);
313 else
314 already = 0;
315 /* Copy remaining bytes one by one. */
316 for (i = already; i < obj_size; i++)
317 new_chunk->contents[i] = h->object_base[i];
319 /* If the object just copied was the only data in OLD_CHUNK,
320 free that chunk and remove it from the chain.
321 But not if that chunk might contain an empty object. */
322 if (h->object_base == old_chunk->contents && ! h->maybe_empty_object)
324 new_chunk->prev = old_chunk->prev;
325 CALL_FREEFUN (h, old_chunk);
328 h->object_base = new_chunk->contents;
329 h->next_free = h->object_base + obj_size;
330 /* The new chunk certainly contains no empty object yet. */
331 h->maybe_empty_object = 0;
334 /* Return nonzero if object OBJ has been allocated from obstack H.
335 This is here for debugging.
336 If you use it in a program, you are probably losing. */
338 #if defined (__STDC__) && __STDC__
339 /* Suppress -Wmissing-prototypes warning. We don't want to declare this in
340 obstack.h because it is just for debugging. */
341 int _obstack_allocated_p (struct obstack *h, POINTER obj);
342 #endif
345 _obstack_allocated_p (h, obj)
346 struct obstack *h;
347 POINTER obj;
349 register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
350 register struct _obstack_chunk *plp; /* point to previous chunk if any */
352 lp = (h)->chunk;
353 /* We use >= rather than > since the object cannot be exactly at
354 the beginning of the chunk but might be an empty object exactly
355 at the end of an adjacent chunk. */
356 while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
358 plp = lp->prev;
359 lp = plp;
361 return lp != 0;
364 /* Free objects in obstack H, including OBJ and everything allocate
365 more recently than OBJ. If OBJ is zero, free everything in H. */
367 #undef obstack_free
369 /* This function has two names with identical definitions.
370 This is the first one, called from non-ANSI code. */
372 void
373 _obstack_free (h, obj)
374 struct obstack *h;
375 POINTER obj;
377 register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
378 register struct _obstack_chunk *plp; /* point to previous chunk if any */
380 lp = h->chunk;
381 /* We use >= because there cannot be an object at the beginning of a chunk.
382 But there can be an empty object at that address
383 at the end of another chunk. */
384 while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
386 plp = lp->prev;
387 CALL_FREEFUN (h, lp);
388 lp = plp;
389 /* If we switch chunks, we can't tell whether the new current
390 chunk contains an empty object, so assume that it may. */
391 h->maybe_empty_object = 1;
393 if (lp)
395 h->object_base = h->next_free = (char *) (obj);
396 h->chunk_limit = lp->limit;
397 h->chunk = lp;
399 else if (obj != 0)
400 /* obj is not in any of the chunks! */
401 abort ();
404 /* This function is used from ANSI code. */
406 void
407 obstack_free (h, obj)
408 struct obstack *h;
409 POINTER obj;
411 register struct _obstack_chunk *lp; /* below addr of any objects in this chunk */
412 register struct _obstack_chunk *plp; /* point to previous chunk if any */
414 lp = h->chunk;
415 /* We use >= because there cannot be an object at the beginning of a chunk.
416 But there can be an empty object at that address
417 at the end of another chunk. */
418 while (lp != 0 && ((POINTER) lp >= obj || (POINTER) (lp)->limit < obj))
420 plp = lp->prev;
421 CALL_FREEFUN (h, lp);
422 lp = plp;
423 /* If we switch chunks, we can't tell whether the new current
424 chunk contains an empty object, so assume that it may. */
425 h->maybe_empty_object = 1;
427 if (lp)
429 h->object_base = h->next_free = (char *) (obj);
430 h->chunk_limit = lp->limit;
431 h->chunk = lp;
433 else if (obj != 0)
434 /* obj is not in any of the chunks! */
435 abort ();
439 _obstack_memory_used (h)
440 struct obstack *h;
442 register struct _obstack_chunk* lp;
443 register int nbytes = 0;
445 for (lp = h->chunk; lp != 0; lp = lp->prev)
447 nbytes += lp->limit - (char *) lp;
449 return nbytes;
452 /* Define the error handler. */
453 #ifndef _
454 # if (HAVE_LIBINTL_H && ENABLE_NLS) || defined _LIBC
455 # include <libintl.h>
456 # ifndef _
457 # define _(Str) gettext (Str)
458 # endif
459 # else
460 # define _(Str) (Str)
461 # endif
462 #endif
464 static void
465 print_and_abort ()
467 fputs (_("memory exhausted\n"), stderr);
468 exit (obstack_exit_failure);
471 #if 0
472 /* These are now turned off because the applications do not use it
473 and it uses bcopy via obstack_grow, which causes trouble on sysV. */
475 /* Now define the functional versions of the obstack macros.
476 Define them to simply use the corresponding macros to do the job. */
478 #if defined (__STDC__) && __STDC__
479 /* These function definitions do not work with non-ANSI preprocessors;
480 they won't pass through the macro names in parentheses. */
482 /* The function names appear in parentheses in order to prevent
483 the macro-definitions of the names from being expanded there. */
485 POINTER (obstack_base) (obstack)
486 struct obstack *obstack;
488 return obstack_base (obstack);
491 POINTER (obstack_next_free) (obstack)
492 struct obstack *obstack;
494 return obstack_next_free (obstack);
497 int (obstack_object_size) (obstack)
498 struct obstack *obstack;
500 return obstack_object_size (obstack);
503 int (obstack_room) (obstack)
504 struct obstack *obstack;
506 return obstack_room (obstack);
509 int (obstack_make_room) (obstack, length)
510 struct obstack *obstack;
511 int length;
513 return obstack_make_room (obstack, length);
516 void (obstack_grow) (obstack, pointer, length)
517 struct obstack *obstack;
518 POINTER pointer;
519 int length;
521 obstack_grow (obstack, pointer, length);
524 void (obstack_grow0) (obstack, pointer, length)
525 struct obstack *obstack;
526 POINTER pointer;
527 int length;
529 obstack_grow0 (obstack, pointer, length);
532 void (obstack_1grow) (obstack, character)
533 struct obstack *obstack;
534 int character;
536 obstack_1grow (obstack, character);
539 void (obstack_blank) (obstack, length)
540 struct obstack *obstack;
541 int length;
543 obstack_blank (obstack, length);
546 void (obstack_1grow_fast) (obstack, character)
547 struct obstack *obstack;
548 int character;
550 obstack_1grow_fast (obstack, character);
553 void (obstack_blank_fast) (obstack, length)
554 struct obstack *obstack;
555 int length;
557 obstack_blank_fast (obstack, length);
560 POINTER (obstack_finish) (obstack)
561 struct obstack *obstack;
563 return obstack_finish (obstack);
566 POINTER (obstack_alloc) (obstack, length)
567 struct obstack *obstack;
568 int length;
570 return obstack_alloc (obstack, length);
573 POINTER (obstack_copy) (obstack, pointer, length)
574 struct obstack *obstack;
575 POINTER pointer;
576 int length;
578 return obstack_copy (obstack, pointer, length);
581 POINTER (obstack_copy0) (obstack, pointer, length)
582 struct obstack *obstack;
583 POINTER pointer;
584 int length;
586 return obstack_copy0 (obstack, pointer, length);
589 #endif /* __STDC__ */
591 #endif /* 0 */
593 #endif /* !ELIDE_CODE */