OSDN Git Service

5839530344074c61cdc39ed685cedc719f9e8531
[pf3gnuchains/gcc-fork.git] / libgfortran / runtime / memory.c
1 /* Memory management routines.
2    Copyright 2002, 2005, 2006 Free Software Foundation, Inc.
3    Contributed by Paul Brook <paul@nowt.org>
4
5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
6
7 Libgfortran is free software; you can redistribute it and/or
8 modify it under the terms of the GNU General Public
9 License as published by the Free Software Foundation; either
10 version 2 of the License, or (at your option) any later version.
11
12 In addition to the permissions in the GNU General Public License, the
13 Free Software Foundation gives you unlimited permission to link the
14 compiled version of this file into combinations with other programs,
15 and to distribute those combinations without any restriction coming
16 from the use of this file.  (The General Public License restrictions
17 do apply in other respects; for example, they cover modification of
18 the file, and distribution when not linked into a combine
19 executable.)
20
21 Libgfortran is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 GNU General Public License for more details.
25
26 You should have received a copy of the GNU General Public
27 License along with libgfortran; see the file COPYING.  If not,
28 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29 Boston, MA 02110-1301, USA.  */
30
31 #include "config.h"
32 #include <stdlib.h>
33 #include "libgfortran.h"
34
35 /* If GFC_CLEAR_MEMORY is defined, the memory allocation routines will
36    return memory that is guaranteed to be set to zero.  This can have
37    a severe efficiency penalty, so it should never be set if good
38    performance is desired, but it can help when you're debugging code.  */
39 /* #define GFC_CLEAR_MEMORY */
40
41 /* If GFC_CHECK_MEMORY is defined, we do some sanity checks at runtime.
42    This causes small overhead, but again, it also helps debugging.  */
43 #define GFC_CHECK_MEMORY
44
45 void *
46 get_mem (size_t n)
47 {
48   void *p;
49
50 #ifdef GFC_CLEAR_MEMORY
51   p = (void *) calloc (1, n);
52 #else
53   p = (void *) malloc (n);
54 #endif
55   if (p == NULL)
56     os_error ("Memory allocation failed");
57
58   return p;
59 }
60
61
62 void
63 free_mem (void *p)
64 {
65   free (p);
66 }
67
68
69 /* Allocate memory for internal (compiler generated) use.  */
70
71 void *
72 internal_malloc_size (size_t size)
73 {
74   if (size == 0)
75     return NULL;
76
77   return get_mem (size);
78 }
79
80 extern void *internal_malloc (GFC_INTEGER_4);
81 export_proto(internal_malloc);
82
83 void *
84 internal_malloc (GFC_INTEGER_4 size)
85 {
86 #ifdef GFC_CHECK_MEMORY
87   /* Under normal circumstances, this is _never_ going to happen!  */
88   if (size < 0)
89     runtime_error ("Attempt to allocate a negative amount of memory.");
90
91 #endif
92   return internal_malloc_size ((size_t) size);
93 }
94
95 extern void *internal_malloc64 (GFC_INTEGER_8);
96 export_proto(internal_malloc64);
97
98 void *
99 internal_malloc64 (GFC_INTEGER_8 size)
100 {
101 #ifdef GFC_CHECK_MEMORY
102   /* Under normal circumstances, this is _never_ going to happen!  */
103   if (size < 0)
104     runtime_error ("Attempt to allocate a negative amount of memory.");
105 #endif
106   return internal_malloc_size ((size_t) size);
107 }
108
109
110 /* Free internally allocated memory.  Pointer is NULLified.  Also used to
111    free user allocated memory.  */
112
113 void
114 internal_free (void *mem)
115 {
116   if (mem != NULL)
117     free (mem);
118 }
119 iexport(internal_free);
120
121 /* Reallocate internal memory MEM so it has SIZE bytes of data.
122    Allocate a new block if MEM is zero, and free the block if
123    SIZE is 0.  */
124
125 static void *
126 internal_realloc_size (void *mem, size_t size)
127 {
128   if (size == 0)
129     {
130       if (mem)
131         free (mem);
132       return NULL;
133     }
134
135   if (mem == 0)
136     return get_mem (size);
137
138   mem = realloc (mem, size);
139   if (!mem)
140     os_error ("Out of memory.");
141
142   return mem;
143 }
144
145 extern void *internal_realloc (void *, GFC_INTEGER_4);
146 export_proto(internal_realloc);
147
148 void *
149 internal_realloc (void *mem, GFC_INTEGER_4 size)
150 {
151 #ifdef GFC_CHECK_MEMORY
152   /* Under normal circumstances, this is _never_ going to happen!  */
153   if (size < 0)
154     runtime_error ("Attempt to allocate a negative amount of memory.");
155 #endif
156   return internal_realloc_size (mem, (size_t) size);
157 }
158
159 extern void *internal_realloc64 (void *, GFC_INTEGER_8);
160 export_proto(internal_realloc64);
161
162 void *
163 internal_realloc64 (void *mem, GFC_INTEGER_8 size)
164 {
165 #ifdef GFC_CHECK_MEMORY
166   /* Under normal circumstances, this is _never_ going to happen!  */
167   if (size < 0)
168     runtime_error ("Attempt to allocate a negative amount of memory.");
169 #endif
170   return internal_realloc_size (mem, (size_t) size);
171 }
172
173
174 /* User-allocate, one call for each member of the alloc-list of an
175    ALLOCATE statement. */
176
177 static void *
178 allocate_size (size_t size, GFC_INTEGER_4 * stat)
179 {
180   void *newmem;
181
182   newmem = malloc (size ? size : 1);
183   if (!newmem)
184     {
185       if (stat)
186         {
187           *stat = 1;
188           return newmem;
189         }
190       else
191         runtime_error ("ALLOCATE: Out of memory.");
192     }
193
194   if (stat)
195     *stat = 0;
196
197   return newmem;
198 }
199
200 extern void *allocate (GFC_INTEGER_4, GFC_INTEGER_4 *);
201 export_proto(allocate);
202
203 void *
204 allocate (GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
205 {
206   if (size < 0)
207     runtime_error ("Attempt to allocate negative amount of memory.  "
208                    "Possible integer overflow");
209
210   return allocate_size ((size_t) size, stat);
211 }
212
213 extern void *allocate64 (GFC_INTEGER_8, GFC_INTEGER_4 *);
214 export_proto(allocate64);
215
216 void *
217 allocate64 (GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
218 {
219   if (size < 0)
220     runtime_error ("ALLOCATE64: Attempt to allocate negative amount of "
221                    "memory. Possible integer overflow");
222
223   return allocate_size ((size_t) size, stat);
224 }
225
226 /* Function to call in an ALLOCATE statement when the argument is an
227    allocatable array.  If the array is currently allocated, it is
228    an error to allocate it again.  32-bit version.  */
229
230 extern void *allocate_array (void *, GFC_INTEGER_4, GFC_INTEGER_4 *);
231 export_proto(allocate_array);
232
233 void *
234 allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
235 {
236   if (mem == NULL)
237     return allocate (size, stat);
238   if (stat)
239     {
240       free (mem);
241       mem = allocate (size, stat);
242       *stat = ERROR_ALLOCATION;
243       return mem;
244     }
245
246   runtime_error ("Attempting to allocate already allocated array.");
247 }
248
249 /* Function to call in an ALLOCATE statement when the argument is an
250    allocatable array.  If the array is currently allocated, it is
251    an error to allocate it again.  64-bit version.  */
252
253 extern void *allocate64_array (void *, GFC_INTEGER_8, GFC_INTEGER_4 *);
254 export_proto(allocate64_array);
255
256 void *
257 allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
258 {
259   if (mem == NULL)
260     return allocate64 (size, stat);
261   if (stat)
262     {
263       free (mem);
264       mem = allocate (size, stat);
265       *stat = ERROR_ALLOCATION;
266       return mem;
267     }
268
269   runtime_error ("Attempting to allocate already allocated array.");
270 }
271
272 /* User-deallocate; pointer is then NULLified by the front-end. */
273
274 extern void deallocate (void *, GFC_INTEGER_4 *);
275 export_proto(deallocate);
276
277 void
278 deallocate (void *mem, GFC_INTEGER_4 * stat)
279 {
280   if (!mem)
281     {
282       if (stat)
283         {
284           *stat = 1;
285           return;
286         }
287       else
288         runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
289     }
290
291   free (mem);
292
293   if (stat)
294     *stat = 0;
295 }