1 |
14 |
jlechner |
/* Common declarations for all of libgfortran.
|
2 |
|
|
Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
3 |
|
|
Contributed by Paul Brook <paul@nowt.org>, and
|
4 |
|
|
Andy Vaught <andy@xena.eas.asu.edu>
|
5 |
|
|
|
6 |
|
|
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
7 |
|
|
|
8 |
|
|
Libgfortran is free software; you can redistribute it and/or
|
9 |
|
|
modify it under the terms of the GNU Lesser General Public
|
10 |
|
|
License as published by the Free Software Foundation; either
|
11 |
|
|
version 2.1 of the License, or (at your option) any later version.
|
12 |
|
|
|
13 |
|
|
Libgfortran 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 Lesser General Public License for more details.
|
17 |
|
|
|
18 |
|
|
You should have received a copy of the GNU Lesser General Public
|
19 |
|
|
License along with libgfor; see the file COPYING.LIB. If not,
|
20 |
|
|
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
21 |
|
|
Boston, MA 02110-1301, USA. */
|
22 |
|
|
|
23 |
|
|
/* As a special exception, if you link this library with other files,
|
24 |
|
|
some of which are compiled with GCC, to produce an executable,
|
25 |
|
|
this library does not by itself cause the resulting executable
|
26 |
|
|
to be covered by the GNU General Public License.
|
27 |
|
|
This exception does not however invalidate any other reasons why
|
28 |
|
|
the executable file might be covered by the GNU General Public License. */
|
29 |
|
|
|
30 |
|
|
|
31 |
|
|
#ifndef LIBGFOR_H
|
32 |
|
|
#define LIBGFOR_H
|
33 |
|
|
|
34 |
|
|
#include <math.h>
|
35 |
|
|
#include <stddef.h>
|
36 |
|
|
|
37 |
|
|
#ifndef M_PI
|
38 |
|
|
#define M_PI 3.14159265358979323846264338327
|
39 |
|
|
#endif
|
40 |
|
|
|
41 |
|
|
#if HAVE_COMPLEX_H
|
42 |
|
|
# include <complex.h>
|
43 |
|
|
#else
|
44 |
|
|
#define complex __complex__
|
45 |
|
|
#endif
|
46 |
|
|
|
47 |
|
|
#include "config.h"
|
48 |
|
|
#include "c99_protos.h"
|
49 |
|
|
|
50 |
|
|
#if HAVE_IEEEFP_H
|
51 |
|
|
#include <ieeefp.h>
|
52 |
|
|
#endif
|
53 |
|
|
|
54 |
|
|
#include "gstdint.h"
|
55 |
|
|
|
56 |
|
|
#if HAVE_SYS_TYPES_H
|
57 |
|
|
#include <sys/types.h>
|
58 |
|
|
#endif
|
59 |
|
|
typedef off_t gfc_offset;
|
60 |
|
|
|
61 |
|
|
#ifndef NULL
|
62 |
|
|
#define NULL (void *) 0
|
63 |
|
|
#endif
|
64 |
|
|
|
65 |
|
|
#ifndef __GNUC__
|
66 |
|
|
#define __attribute__(x)
|
67 |
|
|
#endif
|
68 |
|
|
|
69 |
|
|
/* For a library, a standard prefix is a requirement in order to partition
|
70 |
|
|
the namespace. IPREFIX is for symbols intended to be internal to the
|
71 |
|
|
library. */
|
72 |
|
|
#define PREFIX(x) _gfortran_ ## x
|
73 |
|
|
#define IPREFIX(x) _gfortrani_ ## x
|
74 |
|
|
|
75 |
|
|
/* Magic to rename a symbol at the compiler level. You continue to refer
|
76 |
|
|
to the symbol as OLD in the source, but it'll be named NEW in the asm. */
|
77 |
|
|
#define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
|
78 |
|
|
#define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
|
79 |
|
|
#define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
|
80 |
|
|
|
81 |
|
|
/* There are several classifications of routines:
|
82 |
|
|
|
83 |
|
|
(1) Symbols used only within the library,
|
84 |
|
|
(2) Symbols to be exported from the library,
|
85 |
|
|
(3) Symbols to be exported from the library, but
|
86 |
|
|
also used inside the library.
|
87 |
|
|
|
88 |
|
|
By telling the compiler about these different classifications we can
|
89 |
|
|
tightly control the interface seen by the user, and get better code
|
90 |
|
|
from the compiler at the same time.
|
91 |
|
|
|
92 |
|
|
One of the following should be used immediately after the declaration
|
93 |
|
|
of each symbol:
|
94 |
|
|
|
95 |
|
|
internal_proto Marks a symbol used only within the library,
|
96 |
|
|
and adds IPREFIX to the assembly-level symbol
|
97 |
|
|
name. The later is important for maintaining
|
98 |
|
|
the namespace partition for the static library.
|
99 |
|
|
|
100 |
|
|
export_proto Marks a symbol to be exported, and adds PREFIX
|
101 |
|
|
to the assembly-level symbol name.
|
102 |
|
|
|
103 |
|
|
export_proto_np Marks a symbol to be exported without adding PREFIX.
|
104 |
|
|
|
105 |
|
|
iexport_proto Marks a function to be exported, but with the
|
106 |
|
|
understanding that it can be used inside as well.
|
107 |
|
|
|
108 |
|
|
iexport_data_proto Similarly, marks a data symbol to be exported.
|
109 |
|
|
Unfortunately, some systems can't play the hidden
|
110 |
|
|
symbol renaming trick on data symbols, thanks to
|
111 |
|
|
the horribleness of COPY relocations.
|
112 |
|
|
|
113 |
|
|
If iexport_proto or iexport_data_proto is used, you must also use
|
114 |
|
|
iexport or iexport_data after the *definition* of the symbol. */
|
115 |
|
|
|
116 |
|
|
#if defined(HAVE_ATTRIBUTE_VISIBILITY)
|
117 |
|
|
# define internal_proto(x) \
|
118 |
|
|
sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
|
119 |
|
|
#else
|
120 |
|
|
# define internal_proto(x) sym_rename(x, IPREFIX(x))
|
121 |
|
|
#endif
|
122 |
|
|
|
123 |
|
|
#if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
|
124 |
|
|
# define export_proto(x) sym_rename(x, PREFIX(x))
|
125 |
|
|
# define export_proto_np(x) extern char swallow_semicolon
|
126 |
|
|
# define iexport_proto(x) internal_proto(x)
|
127 |
|
|
# define iexport(x) iexport1(x, __USER_LABEL_PREFIX__, IPREFIX(x))
|
128 |
|
|
# define iexport1(x,p,y) iexport2(x,p,y)
|
129 |
|
|
# define iexport2(x,p,y) \
|
130 |
|
|
extern __typeof(x) PREFIX(x) __attribute__((__alias__(#p #y)))
|
131 |
|
|
/* ??? We're not currently building a dll, and it's wrong to add dllexport
|
132 |
|
|
to objects going into a static library archive. */
|
133 |
|
|
#elif 0 && defined(HAVE_ATTRIBUTE_DLLEXPORT)
|
134 |
|
|
# define export_proto_np(x) extern __typeof(x) x __attribute__((dllexport))
|
135 |
|
|
# define export_proto(x) sym_rename(x, PREFIX(x)) __attribute__((dllexport))
|
136 |
|
|
# define iexport_proto(x) export_proto(x)
|
137 |
|
|
# define iexport(x) extern char swallow_semicolon
|
138 |
|
|
#else
|
139 |
|
|
# define export_proto(x) sym_rename(x, PREFIX(x))
|
140 |
|
|
# define export_proto_np(x) extern char swallow_semicolon
|
141 |
|
|
# define iexport_proto(x) export_proto(x)
|
142 |
|
|
# define iexport(x) extern char swallow_semicolon
|
143 |
|
|
#endif
|
144 |
|
|
|
145 |
|
|
/* TODO: detect the case when we *can* hide the symbol. */
|
146 |
|
|
#define iexport_data_proto(x) export_proto(x)
|
147 |
|
|
#define iexport_data(x) extern char swallow_semicolon
|
148 |
|
|
|
149 |
|
|
/* The only reliable way to get the offset of a field in a struct
|
150 |
|
|
in a system independent way is via this macro. */
|
151 |
|
|
#ifndef offsetof
|
152 |
|
|
#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
|
153 |
|
|
#endif
|
154 |
|
|
|
155 |
|
|
/* The isfinite macro is only available with C99, but some non-C99
|
156 |
|
|
systems still provide fpclassify, and there is a `finite' function
|
157 |
|
|
in BSD.
|
158 |
|
|
|
159 |
|
|
Also, isfinite is broken on Cygwin.
|
160 |
|
|
|
161 |
|
|
When isfinite is not available, try to use one of the
|
162 |
|
|
alternatives, or bail out. */
|
163 |
|
|
|
164 |
|
|
#if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
|
165 |
|
|
#undef isfinite
|
166 |
|
|
#endif
|
167 |
|
|
|
168 |
|
|
#if defined(HAVE_BROKEN_ISNAN)
|
169 |
|
|
#undef isnan
|
170 |
|
|
#endif
|
171 |
|
|
|
172 |
|
|
#if defined(HAVE_BROKEN_FPCLASSIFY)
|
173 |
|
|
#undef fpclassify
|
174 |
|
|
#endif
|
175 |
|
|
|
176 |
|
|
#if !defined(isfinite)
|
177 |
|
|
#if !defined(fpclassify)
|
178 |
|
|
#define isfinite(x) ((x) - (x) == 0)
|
179 |
|
|
#else
|
180 |
|
|
#define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
|
181 |
|
|
#endif /* !defined(fpclassify) */
|
182 |
|
|
#endif /* !defined(isfinite) */
|
183 |
|
|
|
184 |
|
|
#if !defined(isnan)
|
185 |
|
|
#if !defined(fpclassify)
|
186 |
|
|
#define isnan(x) ((x) != (x))
|
187 |
|
|
#else
|
188 |
|
|
#define isnan(x) (fpclassify(x) == FP_NAN)
|
189 |
|
|
#endif /* !defined(fpclassify) */
|
190 |
|
|
#endif /* !defined(isfinite) */
|
191 |
|
|
|
192 |
|
|
/* TODO: find the C99 version of these an move into above ifdef. */
|
193 |
|
|
#define REALPART(z) (__real__(z))
|
194 |
|
|
#define IMAGPART(z) (__imag__(z))
|
195 |
|
|
#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
|
196 |
|
|
|
197 |
|
|
#include "kinds.h"
|
198 |
|
|
|
199 |
|
|
/* The following two definitions must be consistent with the types used
|
200 |
|
|
by the compiler. */
|
201 |
|
|
/* The type used of array indices, amongst other things. */
|
202 |
|
|
typedef ssize_t index_type;
|
203 |
|
|
/* The type used for the lengths of character variables. */
|
204 |
|
|
typedef GFC_INTEGER_4 gfc_charlen_type;
|
205 |
|
|
|
206 |
|
|
/* This will be 0 on little-endian machines and one on big-endian machines. */
|
207 |
|
|
extern int l8_to_l4_offset;
|
208 |
|
|
internal_proto(l8_to_l4_offset);
|
209 |
|
|
|
210 |
|
|
#define GFOR_POINTER_L8_TO_L4(p8) \
|
211 |
|
|
(l8_to_l4_offset + (GFC_LOGICAL_4 *)(p8))
|
212 |
|
|
|
213 |
|
|
#define GFC_INTEGER_4_HUGE \
|
214 |
|
|
(GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
|
215 |
|
|
#define GFC_INTEGER_8_HUGE \
|
216 |
|
|
(GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
|
217 |
|
|
#ifdef HAVE_GFC_INTEGER_16
|
218 |
|
|
#define GFC_INTEGER_16_HUGE \
|
219 |
|
|
(GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
|
220 |
|
|
#endif
|
221 |
|
|
|
222 |
|
|
#define GFC_REAL_4_HUGE FLT_MAX
|
223 |
|
|
#define GFC_REAL_8_HUGE DBL_MAX
|
224 |
|
|
#ifdef HAVE_GFC_REAL_10
|
225 |
|
|
#define GFC_REAL_10_HUGE LDBL_MAX
|
226 |
|
|
#endif
|
227 |
|
|
#ifdef HAVE_GFC_REAL_16
|
228 |
|
|
#define GFC_REAL_16_HUGE LDBL_MAX
|
229 |
|
|
#endif
|
230 |
|
|
|
231 |
|
|
#ifndef GFC_MAX_DIMENSIONS
|
232 |
|
|
#define GFC_MAX_DIMENSIONS 7
|
233 |
|
|
#endif
|
234 |
|
|
|
235 |
|
|
typedef struct descriptor_dimension
|
236 |
|
|
{
|
237 |
|
|
index_type stride;
|
238 |
|
|
index_type lbound;
|
239 |
|
|
index_type ubound;
|
240 |
|
|
}
|
241 |
|
|
descriptor_dimension;
|
242 |
|
|
|
243 |
|
|
#define GFC_ARRAY_DESCRIPTOR(r, type) \
|
244 |
|
|
struct {\
|
245 |
|
|
type *data;\
|
246 |
|
|
size_t offset;\
|
247 |
|
|
index_type dtype;\
|
248 |
|
|
descriptor_dimension dim[r];\
|
249 |
|
|
}
|
250 |
|
|
|
251 |
|
|
/* Commonly used array descriptor types. */
|
252 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
|
253 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
|
254 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
|
255 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
|
256 |
|
|
#ifdef HAVE_GFC_INTEGER_16
|
257 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
|
258 |
|
|
#endif
|
259 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
|
260 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
|
261 |
|
|
#ifdef HAVE_GFC_REAL_10
|
262 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
|
263 |
|
|
#endif
|
264 |
|
|
#ifdef HAVE_GFC_REAL_16
|
265 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
|
266 |
|
|
#endif
|
267 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
|
268 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
|
269 |
|
|
#ifdef HAVE_GFC_COMPLEX_10
|
270 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
|
271 |
|
|
#endif
|
272 |
|
|
#ifdef HAVE_GFC_COMPLEX_16
|
273 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
|
274 |
|
|
#endif
|
275 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
|
276 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
|
277 |
|
|
#ifdef HAVE_GFC_LOGICAL_16
|
278 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
|
279 |
|
|
#endif
|
280 |
|
|
|
281 |
|
|
#define GFC_DTYPE_RANK_MASK 0x07
|
282 |
|
|
#define GFC_DTYPE_TYPE_SHIFT 3
|
283 |
|
|
#define GFC_DTYPE_TYPE_MASK 0x38
|
284 |
|
|
#define GFC_DTYPE_SIZE_SHIFT 6
|
285 |
|
|
|
286 |
|
|
enum
|
287 |
|
|
{
|
288 |
|
|
GFC_DTYPE_UNKNOWN = 0,
|
289 |
|
|
GFC_DTYPE_INTEGER,
|
290 |
|
|
/* TODO: recognize logical types. */
|
291 |
|
|
GFC_DTYPE_LOGICAL,
|
292 |
|
|
GFC_DTYPE_REAL,
|
293 |
|
|
GFC_DTYPE_COMPLEX,
|
294 |
|
|
GFC_DTYPE_DERIVED,
|
295 |
|
|
GFC_DTYPE_CHARACTER
|
296 |
|
|
};
|
297 |
|
|
|
298 |
|
|
#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
|
299 |
|
|
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
|
300 |
|
|
>> GFC_DTYPE_TYPE_SHIFT)
|
301 |
|
|
#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
|
302 |
|
|
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
|
303 |
|
|
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
|
304 |
|
|
|
305 |
|
|
/* Runtime library include. */
|
306 |
|
|
#define stringize(x) expand_macro(x)
|
307 |
|
|
#define expand_macro(x) # x
|
308 |
|
|
|
309 |
|
|
/* Runtime options structure. */
|
310 |
|
|
|
311 |
|
|
typedef struct
|
312 |
|
|
{
|
313 |
|
|
int stdin_unit, stdout_unit, stderr_unit, optional_plus;
|
314 |
|
|
int allocate_init_flag, allocate_init_value;
|
315 |
|
|
int locus;
|
316 |
|
|
|
317 |
|
|
int separator_len;
|
318 |
|
|
const char *separator;
|
319 |
|
|
|
320 |
|
|
int mem_check;
|
321 |
|
|
int use_stderr, all_unbuffered, default_recl;
|
322 |
|
|
|
323 |
|
|
int fpu_round, fpu_precision, fpe;
|
324 |
|
|
|
325 |
|
|
int sighup, sigint;
|
326 |
|
|
}
|
327 |
|
|
options_t;
|
328 |
|
|
|
329 |
|
|
extern options_t options;
|
330 |
|
|
internal_proto(options);
|
331 |
|
|
|
332 |
|
|
|
333 |
|
|
/* Compile-time options that will influence the library. */
|
334 |
|
|
|
335 |
|
|
typedef struct
|
336 |
|
|
{
|
337 |
|
|
int warn_std;
|
338 |
|
|
int allow_std;
|
339 |
|
|
int pedantic;
|
340 |
|
|
int convert;
|
341 |
|
|
size_t record_marker;
|
342 |
|
|
}
|
343 |
|
|
compile_options_t;
|
344 |
|
|
|
345 |
|
|
extern compile_options_t compile_options;
|
346 |
|
|
internal_proto(compile_options);
|
347 |
|
|
|
348 |
|
|
extern void init_compile_options (void);
|
349 |
|
|
internal_proto(init_compile_options);
|
350 |
|
|
|
351 |
|
|
|
352 |
|
|
/* Structure for statement options. */
|
353 |
|
|
|
354 |
|
|
typedef struct
|
355 |
|
|
{
|
356 |
|
|
const char *name;
|
357 |
|
|
int value;
|
358 |
|
|
}
|
359 |
|
|
st_option;
|
360 |
|
|
|
361 |
|
|
/* Runtime errors. The EOR and EOF errors are required to be negative. */
|
362 |
|
|
|
363 |
|
|
typedef enum
|
364 |
|
|
{
|
365 |
|
|
ERROR_FIRST = -3, /* Marker for the first error. */
|
366 |
|
|
ERROR_EOR = -2,
|
367 |
|
|
ERROR_END = -1,
|
368 |
|
|
ERROR_OK = 0, /* Indicates success, must be zero. */
|
369 |
|
|
ERROR_OS, /* Operating system error, more info in errno. */
|
370 |
|
|
ERROR_OPTION_CONFLICT,
|
371 |
|
|
ERROR_BAD_OPTION,
|
372 |
|
|
ERROR_MISSING_OPTION,
|
373 |
|
|
ERROR_ALREADY_OPEN,
|
374 |
|
|
ERROR_BAD_UNIT,
|
375 |
|
|
ERROR_FORMAT,
|
376 |
|
|
ERROR_BAD_ACTION,
|
377 |
|
|
ERROR_ENDFILE,
|
378 |
|
|
ERROR_BAD_US,
|
379 |
|
|
ERROR_READ_VALUE,
|
380 |
|
|
ERROR_READ_OVERFLOW,
|
381 |
|
|
ERROR_INTERNAL,
|
382 |
|
|
ERROR_INTERNAL_UNIT,
|
383 |
|
|
ERROR_ALLOCATION,
|
384 |
|
|
ERROR_DIRECT_EOR,
|
385 |
|
|
ERROR_LAST /* Not a real error, the last error # + 1. */
|
386 |
|
|
}
|
387 |
|
|
error_codes;
|
388 |
|
|
|
389 |
|
|
|
390 |
|
|
/* Flags to specify which standard/extension contains a feature.
|
391 |
|
|
Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */
|
392 |
|
|
#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */
|
393 |
|
|
#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */
|
394 |
|
|
#define GFC_STD_F2003 (1<<4) /* New in F2003. */
|
395 |
|
|
/* Note that no features were obsoleted nor deleted in F2003. */
|
396 |
|
|
#define GFC_STD_F95 (1<<3) /* New in F95. */
|
397 |
|
|
#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */
|
398 |
|
|
#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */
|
399 |
|
|
#define GFC_STD_F77 (1<<0) /* Up to and including F77. */
|
400 |
|
|
|
401 |
|
|
/* Bitmasks for the various FPE that can be enabled.
|
402 |
|
|
Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */
|
403 |
|
|
#define GFC_FPE_INVALID (1<<0)
|
404 |
|
|
#define GFC_FPE_DENORMAL (1<<1)
|
405 |
|
|
#define GFC_FPE_ZERO (1<<2)
|
406 |
|
|
#define GFC_FPE_OVERFLOW (1<<3)
|
407 |
|
|
#define GFC_FPE_UNDERFLOW (1<<4)
|
408 |
|
|
#define GFC_FPE_PRECISION (1<<5)
|
409 |
|
|
|
410 |
|
|
/* This is returned by notification_std to know if, given the flags
|
411 |
|
|
that were given (-std=, -pedantic) we should issue an error, a warning
|
412 |
|
|
or nothing. */
|
413 |
|
|
typedef enum
|
414 |
|
|
{ SILENT, WARNING, ERROR }
|
415 |
|
|
notification;
|
416 |
|
|
|
417 |
|
|
/* The filename and line number don't go inside the globals structure.
|
418 |
|
|
They are set by the rest of the program and must be linked to. */
|
419 |
|
|
|
420 |
|
|
/* Location of the current library call (optional). */
|
421 |
|
|
extern unsigned line;
|
422 |
|
|
iexport_data_proto(line);
|
423 |
|
|
|
424 |
|
|
extern char *filename;
|
425 |
|
|
iexport_data_proto(filename);
|
426 |
|
|
|
427 |
|
|
/* Avoid conflicting prototypes of alloca() in system headers by using
|
428 |
|
|
GCC's builtin alloca(). */
|
429 |
|
|
#define gfc_alloca(x) __builtin_alloca(x)
|
430 |
|
|
|
431 |
|
|
|
432 |
|
|
/* main.c */
|
433 |
|
|
|
434 |
|
|
extern void stupid_function_name_for_static_linking (void);
|
435 |
|
|
internal_proto(stupid_function_name_for_static_linking);
|
436 |
|
|
|
437 |
|
|
struct st_parameter_common;
|
438 |
|
|
extern void library_start (struct st_parameter_common *);
|
439 |
|
|
internal_proto(library_start);
|
440 |
|
|
|
441 |
|
|
#define library_end()
|
442 |
|
|
|
443 |
|
|
extern void set_args (int, char **);
|
444 |
|
|
export_proto(set_args);
|
445 |
|
|
|
446 |
|
|
extern void get_args (int *, char ***);
|
447 |
|
|
internal_proto(get_args);
|
448 |
|
|
|
449 |
|
|
/* error.c */
|
450 |
|
|
|
451 |
|
|
#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
|
452 |
|
|
#define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1)
|
453 |
|
|
#define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
|
454 |
|
|
#define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1)
|
455 |
|
|
|
456 |
|
|
extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t);
|
457 |
|
|
internal_proto(gfc_itoa);
|
458 |
|
|
|
459 |
|
|
extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
|
460 |
|
|
internal_proto(xtoa);
|
461 |
|
|
|
462 |
|
|
extern void os_error (const char *) __attribute__ ((noreturn));
|
463 |
|
|
internal_proto(os_error);
|
464 |
|
|
|
465 |
|
|
extern void show_locus (struct st_parameter_common *);
|
466 |
|
|
internal_proto(show_locus);
|
467 |
|
|
|
468 |
|
|
extern void runtime_error (const char *) __attribute__ ((noreturn));
|
469 |
|
|
iexport_proto(runtime_error);
|
470 |
|
|
|
471 |
|
|
extern void internal_error (struct st_parameter_common *, const char *)
|
472 |
|
|
__attribute__ ((noreturn));
|
473 |
|
|
internal_proto(internal_error);
|
474 |
|
|
|
475 |
|
|
extern const char *get_oserror (void);
|
476 |
|
|
internal_proto(get_oserror);
|
477 |
|
|
|
478 |
|
|
extern void sys_exit (int) __attribute__ ((noreturn));
|
479 |
|
|
internal_proto(sys_exit);
|
480 |
|
|
|
481 |
|
|
extern int st_printf (const char *, ...)
|
482 |
|
|
__attribute__ ((format (printf, 1, 2)));
|
483 |
|
|
internal_proto(st_printf);
|
484 |
|
|
|
485 |
|
|
extern void st_sprintf (char *, const char *, ...)
|
486 |
|
|
__attribute__ ((format (printf, 2, 3)));
|
487 |
|
|
internal_proto(st_sprintf);
|
488 |
|
|
|
489 |
|
|
extern const char *translate_error (int);
|
490 |
|
|
internal_proto(translate_error);
|
491 |
|
|
|
492 |
|
|
extern void generate_error (struct st_parameter_common *, int, const char *);
|
493 |
|
|
internal_proto(generate_error);
|
494 |
|
|
|
495 |
|
|
/* fpu.c */
|
496 |
|
|
|
497 |
|
|
extern void set_fpu (void);
|
498 |
|
|
internal_proto(set_fpu);
|
499 |
|
|
|
500 |
|
|
/* memory.c */
|
501 |
|
|
|
502 |
|
|
extern void *get_mem (size_t) __attribute__ ((malloc));
|
503 |
|
|
internal_proto(get_mem);
|
504 |
|
|
|
505 |
|
|
extern void free_mem (void *);
|
506 |
|
|
internal_proto(free_mem);
|
507 |
|
|
|
508 |
|
|
extern void *internal_malloc_size (size_t);
|
509 |
|
|
internal_proto(internal_malloc_size);
|
510 |
|
|
|
511 |
|
|
extern void internal_free (void *);
|
512 |
|
|
iexport_proto(internal_free);
|
513 |
|
|
|
514 |
|
|
/* environ.c */
|
515 |
|
|
|
516 |
|
|
extern int check_buffered (int);
|
517 |
|
|
internal_proto(check_buffered);
|
518 |
|
|
|
519 |
|
|
extern void init_variables (void);
|
520 |
|
|
internal_proto(init_variables);
|
521 |
|
|
|
522 |
|
|
extern void show_variables (void);
|
523 |
|
|
internal_proto(show_variables);
|
524 |
|
|
|
525 |
|
|
/* string.c */
|
526 |
|
|
|
527 |
|
|
extern int find_option (struct st_parameter_common *, const char *, int,
|
528 |
|
|
const st_option *, const char *);
|
529 |
|
|
internal_proto(find_option);
|
530 |
|
|
|
531 |
|
|
extern int fstrlen (const char *, int);
|
532 |
|
|
internal_proto(fstrlen);
|
533 |
|
|
|
534 |
|
|
extern void fstrcpy (char *, int, const char *, int);
|
535 |
|
|
internal_proto(fstrcpy);
|
536 |
|
|
|
537 |
|
|
extern void cf_strcpy (char *, int, const char *);
|
538 |
|
|
internal_proto(cf_strcpy);
|
539 |
|
|
|
540 |
|
|
/* io.c */
|
541 |
|
|
|
542 |
|
|
extern void init_units (void);
|
543 |
|
|
internal_proto(init_units);
|
544 |
|
|
|
545 |
|
|
extern void close_units (void);
|
546 |
|
|
internal_proto(close_units);
|
547 |
|
|
|
548 |
|
|
/* stop.c */
|
549 |
|
|
|
550 |
|
|
extern void stop_numeric (GFC_INTEGER_4);
|
551 |
|
|
iexport_proto(stop_numeric);
|
552 |
|
|
|
553 |
|
|
/* reshape_packed.c */
|
554 |
|
|
|
555 |
|
|
extern void reshape_packed (char *, index_type, const char *, index_type,
|
556 |
|
|
const char *, index_type);
|
557 |
|
|
internal_proto(reshape_packed);
|
558 |
|
|
|
559 |
|
|
/* Repacking functions. */
|
560 |
|
|
|
561 |
|
|
/* ??? These aren't currently used by the compiler, though we
|
562 |
|
|
certainly could do so. */
|
563 |
|
|
GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
|
564 |
|
|
internal_proto(internal_pack_4);
|
565 |
|
|
|
566 |
|
|
GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
|
567 |
|
|
internal_proto(internal_pack_8);
|
568 |
|
|
|
569 |
|
|
#if defined HAVE_GFC_INTEGER_16
|
570 |
|
|
GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
|
571 |
|
|
internal_proto(internal_pack_16);
|
572 |
|
|
#endif
|
573 |
|
|
|
574 |
|
|
GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
|
575 |
|
|
internal_proto(internal_pack_c4);
|
576 |
|
|
|
577 |
|
|
GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
|
578 |
|
|
internal_proto(internal_pack_c8);
|
579 |
|
|
|
580 |
|
|
#if defined HAVE_GFC_COMPLEX_10
|
581 |
|
|
GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
|
582 |
|
|
internal_proto(internal_pack_c10);
|
583 |
|
|
#endif
|
584 |
|
|
|
585 |
|
|
extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
|
586 |
|
|
internal_proto(internal_unpack_4);
|
587 |
|
|
|
588 |
|
|
extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
|
589 |
|
|
internal_proto(internal_unpack_8);
|
590 |
|
|
|
591 |
|
|
#if defined HAVE_GFC_INTEGER_16
|
592 |
|
|
extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
|
593 |
|
|
internal_proto(internal_unpack_16);
|
594 |
|
|
#endif
|
595 |
|
|
|
596 |
|
|
extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
|
597 |
|
|
internal_proto(internal_unpack_c4);
|
598 |
|
|
|
599 |
|
|
extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
|
600 |
|
|
internal_proto(internal_unpack_c8);
|
601 |
|
|
|
602 |
|
|
#if defined HAVE_GFC_COMPLEX_10
|
603 |
|
|
extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
|
604 |
|
|
internal_proto(internal_unpack_c10);
|
605 |
|
|
#endif
|
606 |
|
|
|
607 |
|
|
/* string_intrinsics.c */
|
608 |
|
|
|
609 |
|
|
extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *,
|
610 |
|
|
GFC_INTEGER_4, const char *);
|
611 |
|
|
iexport_proto(compare_string);
|
612 |
|
|
|
613 |
|
|
/* random.c */
|
614 |
|
|
|
615 |
|
|
extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put,
|
616 |
|
|
gfc_array_i4 * get);
|
617 |
|
|
iexport_proto(random_seed);
|
618 |
|
|
|
619 |
|
|
/* normalize.c */
|
620 |
|
|
|
621 |
|
|
extern GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4);
|
622 |
|
|
internal_proto(normalize_r4_i4);
|
623 |
|
|
|
624 |
|
|
extern GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8);
|
625 |
|
|
internal_proto(normalize_r8_i8);
|
626 |
|
|
|
627 |
|
|
/* size.c */
|
628 |
|
|
|
629 |
|
|
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
|
630 |
|
|
|
631 |
|
|
extern index_type size0 (const array_t * array);
|
632 |
|
|
iexport_proto(size0);
|
633 |
|
|
|
634 |
|
|
#endif /* LIBGFOR_H */
|