Fix for PR39548
[official-gcc.git] / libgfortran / libgfortran.h
blobaaa466713eae6c4de4d7d073d4a9742db040e923
1 /* Common declarations for all of libgfortran.
2 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
3 Free Software Foundation, Inc.
4 Contributed by Paul Brook <paul@nowt.org>, and
5 Andy Vaught <andy@xena.eas.asu.edu>
7 This file is part of the GNU Fortran 95 runtime library (libgfortran).
9 Libgfortran is free software; you can redistribute it and/or
10 modify it under the terms of the GNU Lesser General Public
11 License as published by the Free Software Foundation; either
12 version 2.1 of the License, or (at your option) any later version.
14 Libgfortran is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU Lesser General Public License for more details.
19 You should have received a copy of the GNU Lesser General Public
20 License along with libgfor; see the file COPYING.LIB. If not,
21 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 Boston, MA 02110-1301, USA. */
24 /* As a special exception, if you link this library with other files,
25 some of which are compiled with GCC, to produce an executable,
26 this library does not by itself cause the resulting executable
27 to be covered by the GNU General Public License.
28 This exception does not however invalidate any other reasons why
29 the executable file might be covered by the GNU General Public License. */
32 #ifndef LIBGFOR_H
33 #define LIBGFOR_H
35 /* config.h MUST be first because it can affect system headers. */
36 #include "config.h"
38 #include <stdio.h>
39 #include <math.h>
40 #include <stddef.h>
41 #include <float.h>
42 #include <stdarg.h>
44 #if HAVE_COMPLEX_H
45 # include <complex.h>
46 #else
47 #define complex __complex__
48 #endif
50 #include "../gcc/fortran/libgfortran.h"
52 #include "c99_protos.h"
54 #if HAVE_IEEEFP_H
55 #include <ieeefp.h>
56 #endif
58 #include "gstdint.h"
60 #if HAVE_SYS_TYPES_H
61 #include <sys/types.h>
62 #endif
63 typedef off_t gfc_offset;
65 #ifndef NULL
66 #define NULL (void *) 0
67 #endif
69 #ifndef __GNUC__
70 #define __attribute__(x)
71 #define likely(x) (x)
72 #define unlikely(x) (x)
73 #else
74 #define likely(x) __builtin_expect(!!(x), 1)
75 #define unlikely(x) __builtin_expect(!!(x), 0)
76 #endif
79 /* We use intptr_t and uintptr_t, which may not be always defined in
80 system headers. */
82 #ifndef HAVE_INTPTR_T
83 #if __SIZEOF_POINTER__ == __SIZEOF_LONG__
84 #define intptr_t long
85 #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__
86 #define intptr_t long long
87 #elif __SIZEOF_POINTER__ == __SIZEOF_INT__
88 #define intptr_t int
89 #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__
90 #define intptr_t short
91 #else
92 #error "Pointer type with unexpected size"
93 #endif
94 #endif
96 #ifndef HAVE_UINTPTR_T
97 #if __SIZEOF_POINTER__ == __SIZEOF_LONG__
98 #define uintptr_t unsigned long
99 #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__
100 #define uintptr_t unsigned long long
101 #elif __SIZEOF_POINTER__ == __SIZEOF_INT__
102 #define uintptr_t unsigned int
103 #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__
104 #define uintptr_t unsigned short
105 #else
106 #error "Pointer type with unexpected size"
107 #endif
108 #endif
111 /* On mingw, work around the buggy Windows snprintf() by using the one
112 mingw provides, __mingw_snprintf(). We also provide a prototype for
113 __mingw_snprintf(), because the mingw headers currently don't have one. */
114 #if HAVE_MINGW_SNPRINTF
115 extern int __mingw_snprintf (char *, size_t, const char *, ...)
116 __attribute__ ((format (gnu_printf, 3, 4)));
117 #undef snprintf
118 #define snprintf __mingw_snprintf
119 #endif
122 /* For a library, a standard prefix is a requirement in order to partition
123 the namespace. IPREFIX is for symbols intended to be internal to the
124 library. */
125 #define PREFIX(x) _gfortran_ ## x
126 #define IPREFIX(x) _gfortrani_ ## x
128 /* Magic to rename a symbol at the compiler level. You continue to refer
129 to the symbol as OLD in the source, but it'll be named NEW in the asm. */
130 #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
131 #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
132 #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
134 /* There are several classifications of routines:
136 (1) Symbols used only within the library,
137 (2) Symbols to be exported from the library,
138 (3) Symbols to be exported from the library, but
139 also used inside the library.
141 By telling the compiler about these different classifications we can
142 tightly control the interface seen by the user, and get better code
143 from the compiler at the same time.
145 One of the following should be used immediately after the declaration
146 of each symbol:
148 internal_proto Marks a symbol used only within the library,
149 and adds IPREFIX to the assembly-level symbol
150 name. The later is important for maintaining
151 the namespace partition for the static library.
153 export_proto Marks a symbol to be exported, and adds PREFIX
154 to the assembly-level symbol name.
156 export_proto_np Marks a symbol to be exported without adding PREFIX.
158 iexport_proto Marks a function to be exported, but with the
159 understanding that it can be used inside as well.
161 iexport_data_proto Similarly, marks a data symbol to be exported.
162 Unfortunately, some systems can't play the hidden
163 symbol renaming trick on data symbols, thanks to
164 the horribleness of COPY relocations.
166 If iexport_proto or iexport_data_proto is used, you must also use
167 iexport or iexport_data after the *definition* of the symbol. */
169 #if defined(HAVE_ATTRIBUTE_VISIBILITY)
170 # define internal_proto(x) \
171 sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
172 #else
173 # define internal_proto(x) sym_rename(x, IPREFIX(x))
174 #endif
176 #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
177 # define export_proto(x) sym_rename(x, PREFIX(x))
178 # define export_proto_np(x) extern char swallow_semicolon
179 # define iexport_proto(x) internal_proto(x)
180 # define iexport(x) iexport1(x, IPREFIX(x))
181 # define iexport1(x,y) iexport2(x,y)
182 # define iexport2(x,y) \
183 extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y)))
184 /* ??? We're not currently building a dll, and it's wrong to add dllexport
185 to objects going into a static library archive. */
186 #elif 0 && defined(HAVE_ATTRIBUTE_DLLEXPORT)
187 # define export_proto_np(x) extern __typeof(x) x __attribute__((dllexport))
188 # define export_proto(x) sym_rename(x, PREFIX(x)) __attribute__((dllexport))
189 # define iexport_proto(x) export_proto(x)
190 # define iexport(x) extern char swallow_semicolon
191 #else
192 # define export_proto(x) sym_rename(x, PREFIX(x))
193 # define export_proto_np(x) extern char swallow_semicolon
194 # define iexport_proto(x) export_proto(x)
195 # define iexport(x) extern char swallow_semicolon
196 #endif
198 /* TODO: detect the case when we *can* hide the symbol. */
199 #define iexport_data_proto(x) export_proto(x)
200 #define iexport_data(x) extern char swallow_semicolon
202 /* The only reliable way to get the offset of a field in a struct
203 in a system independent way is via this macro. */
204 #ifndef offsetof
205 #define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
206 #endif
208 /* The isfinite macro is only available with C99, but some non-C99
209 systems still provide fpclassify, and there is a `finite' function
210 in BSD.
212 Also, isfinite is broken on Cygwin.
214 When isfinite is not available, try to use one of the
215 alternatives, or bail out. */
217 #if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__)
218 #undef isfinite
219 #endif
221 #if defined(HAVE_BROKEN_ISNAN)
222 #undef isnan
223 #endif
225 #if defined(HAVE_BROKEN_FPCLASSIFY)
226 #undef fpclassify
227 #endif
229 #if !defined(isfinite)
230 #if !defined(fpclassify)
231 #define isfinite(x) ((x) - (x) == 0)
232 #else
233 #define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
234 #endif /* !defined(fpclassify) */
235 #endif /* !defined(isfinite) */
237 #if !defined(isnan)
238 #if !defined(fpclassify)
239 #define isnan(x) ((x) != (x))
240 #else
241 #define isnan(x) (fpclassify(x) == FP_NAN)
242 #endif /* !defined(fpclassify) */
243 #endif /* !defined(isfinite) */
245 /* TODO: find the C99 version of these an move into above ifdef. */
246 #define REALPART(z) (__real__(z))
247 #define IMAGPART(z) (__imag__(z))
248 #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
250 #include "kinds.h"
252 /* Define the type used for the current record number for large file I/O.
253 The size must be consistent with the size defined on the compiler side. */
254 #ifdef HAVE_GFC_INTEGER_8
255 typedef GFC_INTEGER_8 GFC_IO_INT;
256 #else
257 #ifdef HAVE_GFC_INTEGER_4
258 typedef GFC_INTEGER_4 GFC_IO_INT;
259 #else
260 #error "GFC_INTEGER_4 should be available for the library to compile".
261 #endif
262 #endif
264 /* The following two definitions must be consistent with the types used
265 by the compiler. */
266 /* The type used of array indices, amongst other things. */
267 typedef ssize_t index_type;
269 /* The type used for the lengths of character variables. */
270 typedef GFC_INTEGER_4 gfc_charlen_type;
272 /* Definitions of CHARACTER data types:
273 - CHARACTER(KIND=1) corresponds to the C char type,
274 - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */
275 typedef GFC_UINTEGER_4 gfc_char4_t;
277 /* Byte size of character kinds. For the kinds currently supported, it's
278 simply equal to the kind parameter itself. */
279 #define GFC_SIZE_OF_CHAR_KIND(kind) (kind)
281 /* This will be 0 on little-endian machines and one on big-endian machines. */
282 extern int big_endian;
283 internal_proto(big_endian);
285 #define GFOR_POINTER_TO_L1(p, kind) \
286 (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p))
288 #define GFC_INTEGER_1_HUGE \
289 (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1)
290 #define GFC_INTEGER_2_HUGE \
291 (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1)
292 #define GFC_INTEGER_4_HUGE \
293 (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
294 #define GFC_INTEGER_8_HUGE \
295 (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
296 #ifdef HAVE_GFC_INTEGER_16
297 #define GFC_INTEGER_16_HUGE \
298 (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
299 #endif
302 typedef struct descriptor_dimension
304 index_type stride;
305 index_type lbound;
306 index_type ubound;
308 descriptor_dimension;
310 #define GFC_ARRAY_DESCRIPTOR(r, type) \
311 struct {\
312 type *data;\
313 size_t offset;\
314 index_type dtype;\
315 descriptor_dimension dim[r];\
318 /* Commonly used array descriptor types. */
319 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void;
320 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;
321 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_1) gfc_array_i1;
322 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_2) gfc_array_i2;
323 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4;
324 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8;
325 #ifdef HAVE_GFC_INTEGER_16
326 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16;
327 #endif
328 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4;
329 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8;
330 #ifdef HAVE_GFC_REAL_10
331 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10;
332 #endif
333 #ifdef HAVE_GFC_REAL_16
334 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
335 #endif
336 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4;
337 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8;
338 #ifdef HAVE_GFC_COMPLEX_10
339 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10;
340 #endif
341 #ifdef HAVE_GFC_COMPLEX_16
342 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
343 #endif
344 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_1) gfc_array_l1;
345 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_2) gfc_array_l2;
346 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4;
347 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8;
348 #ifdef HAVE_GFC_LOGICAL_16
349 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
350 #endif
353 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
354 #define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
355 >> GFC_DTYPE_TYPE_SHIFT)
356 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
357 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
358 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
360 /* Macros to get both the size and the type with a single masking operation */
362 #define GFC_DTYPE_SIZE_MASK \
363 ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT)
364 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
366 #define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
368 #define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
369 | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
370 #define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
371 | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
372 #define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
373 | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
374 #define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
375 | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
376 #ifdef HAVE_GFC_INTEGER_16
377 #define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
378 | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
379 #endif
381 #define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
382 | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
383 #define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
384 | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
385 #define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
386 | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
387 #define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
388 | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
389 #ifdef HAVE_GFC_LOGICAL_16
390 #define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
391 | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
392 #endif
394 #define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
395 | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
396 #define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
397 | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
398 #ifdef HAVE_GFC_REAL_10
399 #define GFC_DTYPE_REAL_10 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
400 | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
401 #endif
402 #ifdef HAVE_GFC_REAL_16
403 #define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \
404 | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
405 #endif
407 #define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
408 | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
409 #define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
410 | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
411 #ifdef HAVE_GFC_COMPLEX_10
412 #define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
413 | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
414 #endif
415 #ifdef HAVE_GFC_COMPLEX_16
416 #define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
417 | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
418 #endif
420 #define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
421 | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
422 #define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
423 | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
424 #define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
425 | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
426 #define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
427 | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
428 #ifdef HAVE_GFC_INTEGER_16
429 #define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
430 | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
431 #endif
433 /* Macros to determine the alignment of pointers. */
435 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \
436 (__alignof__(GFC_INTEGER_2) - 1))
437 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \
438 (__alignof__(GFC_INTEGER_4) - 1))
439 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \
440 (__alignof__(GFC_INTEGER_8) - 1))
441 #ifdef HAVE_GFC_INTEGER_16
442 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \
443 (__alignof__(GFC_INTEGER_16) - 1))
444 #endif
446 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
447 (__alignof__(GFC_COMPLEX_4) - 1))
449 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
450 (__alignof__(GFC_COMPLEX_8) - 1))
452 /* Runtime library include. */
453 #define stringize(x) expand_macro(x)
454 #define expand_macro(x) # x
456 /* Runtime options structure. */
458 typedef struct
460 int stdin_unit, stdout_unit, stderr_unit, optional_plus;
461 int locus;
463 int separator_len;
464 const char *separator;
466 int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl;
467 int fpe, dump_core, backtrace;
469 options_t;
471 extern options_t options;
472 internal_proto(options);
474 extern void handler (int);
475 internal_proto(handler);
478 /* Compile-time options that will influence the library. */
480 typedef struct
482 int warn_std;
483 int allow_std;
484 int pedantic;
485 int convert;
486 int dump_core;
487 int backtrace;
488 int sign_zero;
489 size_t record_marker;
490 int max_subrecord_length;
491 int bounds_check;
492 int range_check;
494 compile_options_t;
496 extern compile_options_t compile_options;
497 internal_proto(compile_options);
499 extern void init_compile_options (void);
500 internal_proto(init_compile_options);
502 #define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */
504 /* Structure for statement options. */
506 typedef struct
508 const char *name;
509 int value;
511 st_option;
514 /* This is returned by notification_std to know if, given the flags
515 that were given (-std=, -pedantic) we should issue an error, a warning
516 or nothing. */
517 typedef enum
518 { SILENT, WARNING, ERROR }
519 notification;
521 /* This is returned by notify_std and several io functions. */
522 typedef enum
523 { SUCCESS = 1, FAILURE }
524 try;
526 /* The filename and line number don't go inside the globals structure.
527 They are set by the rest of the program and must be linked to. */
529 /* Location of the current library call (optional). */
530 extern unsigned line;
531 iexport_data_proto(line);
533 extern char *filename;
534 iexport_data_proto(filename);
536 /* Avoid conflicting prototypes of alloca() in system headers by using
537 GCC's builtin alloca(). */
538 #define gfc_alloca(x) __builtin_alloca(x)
541 /* Directory for creating temporary files. Only used when none of the
542 following environment variables exist: GFORTRAN_TMPDIR, TMP and TEMP. */
543 #define DEFAULT_TEMPDIR "/tmp"
545 /* The default value of record length for preconnected units is defined
546 here. This value can be overriden by an environment variable.
547 Default value is 1 Gb. */
548 #define DEFAULT_RECL 1073741824
551 #define CHARACTER2(name) \
552 gfc_charlen_type name ## _len; \
553 char * name
555 typedef struct st_parameter_common
557 GFC_INTEGER_4 flags;
558 GFC_INTEGER_4 unit;
559 const char *filename;
560 GFC_INTEGER_4 line;
561 CHARACTER2 (iomsg);
562 GFC_INTEGER_4 *iostat;
564 st_parameter_common;
566 #undef CHARACTER2
568 #define IOPARM_LIBRETURN_MASK (3 << 0)
569 #define IOPARM_LIBRETURN_OK (0 << 0)
570 #define IOPARM_LIBRETURN_ERROR (1 << 0)
571 #define IOPARM_LIBRETURN_END (2 << 0)
572 #define IOPARM_LIBRETURN_EOR (3 << 0)
573 #define IOPARM_ERR (1 << 2)
574 #define IOPARM_END (1 << 3)
575 #define IOPARM_EOR (1 << 4)
576 #define IOPARM_HAS_IOSTAT (1 << 5)
577 #define IOPARM_HAS_IOMSG (1 << 6)
579 #define IOPARM_COMMON_MASK ((1 << 7) - 1)
581 #define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
582 #define IOPARM_OPEN_HAS_FILE (1 << 8)
583 #define IOPARM_OPEN_HAS_STATUS (1 << 9)
584 #define IOPARM_OPEN_HAS_ACCESS (1 << 10)
585 #define IOPARM_OPEN_HAS_FORM (1 << 11)
586 #define IOPARM_OPEN_HAS_BLANK (1 << 12)
587 #define IOPARM_OPEN_HAS_POSITION (1 << 13)
588 #define IOPARM_OPEN_HAS_ACTION (1 << 14)
589 #define IOPARM_OPEN_HAS_DELIM (1 << 15)
590 #define IOPARM_OPEN_HAS_PAD (1 << 16)
591 #define IOPARM_OPEN_HAS_CONVERT (1 << 17)
592 #define IOPARM_OPEN_HAS_DECIMAL (1 << 18)
593 #define IOPARM_OPEN_HAS_ENCODING (1 << 19)
594 #define IOPARM_OPEN_HAS_ROUND (1 << 20)
595 #define IOPARM_OPEN_HAS_SIGN (1 << 21)
596 #define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22)
598 /* library start function and end macro. These can be expanded if needed
599 in the future. cmp is st_parameter_common *cmp */
601 extern void library_start (st_parameter_common *);
602 internal_proto(library_start);
604 #define library_end()
606 /* main.c */
608 extern void stupid_function_name_for_static_linking (void);
609 internal_proto(stupid_function_name_for_static_linking);
611 extern void set_args (int, char **);
612 export_proto(set_args);
614 extern void get_args (int *, char ***);
615 internal_proto(get_args);
617 extern void store_exe_path (const char *);
618 export_proto(store_exe_path);
620 extern char * full_exe_path (void);
621 internal_proto(full_exe_path);
623 /* backtrace.c */
625 extern void show_backtrace (void);
626 internal_proto(show_backtrace);
628 /* error.c */
630 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
631 #define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1)
632 #define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1)
633 #define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1)
635 extern void sys_exit (int) __attribute__ ((noreturn));
636 internal_proto(sys_exit);
638 extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t);
639 internal_proto(gfc_itoa);
641 extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
642 internal_proto(xtoa);
644 extern void os_error (const char *) __attribute__ ((noreturn));
645 iexport_proto(os_error);
647 extern void show_locus (st_parameter_common *);
648 internal_proto(show_locus);
650 extern void runtime_error (const char *, ...)
651 __attribute__ ((noreturn, format (printf, 1, 2)));
652 iexport_proto(runtime_error);
654 extern void runtime_error_at (const char *, const char *, ...)
655 __attribute__ ((noreturn, format (printf, 2, 3)));
656 iexport_proto(runtime_error_at);
658 extern void runtime_warning_at (const char *, const char *, ...)
659 __attribute__ ((format (printf, 2, 3)));
660 iexport_proto(runtime_warning_at);
662 extern void internal_error (st_parameter_common *, const char *)
663 __attribute__ ((noreturn));
664 internal_proto(internal_error);
666 extern const char *get_oserror (void);
667 internal_proto(get_oserror);
669 extern const char *translate_error (int);
670 internal_proto(translate_error);
672 extern void generate_error (st_parameter_common *, int, const char *);
673 iexport_proto(generate_error);
675 extern try notify_std (st_parameter_common *, int, const char *);
676 internal_proto(notify_std);
678 extern notification notification_std(int);
679 internal_proto(notification_std);
681 /* fpu.c */
683 extern void set_fpu (void);
684 internal_proto(set_fpu);
686 /* memory.c */
688 extern void *get_mem (size_t) __attribute__ ((malloc));
689 internal_proto(get_mem);
691 extern void free_mem (void *);
692 internal_proto(free_mem);
694 extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
695 internal_proto(internal_malloc_size);
697 /* environ.c */
699 extern int check_buffered (int);
700 internal_proto(check_buffered);
702 extern void init_variables (void);
703 internal_proto(init_variables);
705 extern void show_variables (void);
706 internal_proto(show_variables);
708 unit_convert get_unformatted_convert (int);
709 internal_proto(get_unformatted_convert);
711 /* string.c */
713 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
714 const st_option *, const char *);
715 internal_proto(find_option);
717 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
718 internal_proto(fstrlen);
720 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
721 internal_proto(fstrcpy);
723 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
724 internal_proto(cf_strcpy);
726 /* io/intrinsics.c */
728 extern void flush_all_units (void);
729 internal_proto(flush_all_units);
731 /* io.c */
733 extern void init_units (void);
734 internal_proto(init_units);
736 extern void close_units (void);
737 internal_proto(close_units);
739 extern int unit_to_fd (int);
740 internal_proto(unit_to_fd);
742 extern int st_printf (const char *, ...)
743 __attribute__ ((format (printf, 1, 2)));
744 internal_proto(st_printf);
746 extern int st_vprintf (const char *, va_list);
747 internal_proto(st_vprintf);
749 extern char * filename_from_unit (int);
750 internal_proto(filename_from_unit);
752 /* stop.c */
754 extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
755 iexport_proto(stop_numeric);
757 /* reshape_packed.c */
759 extern void reshape_packed (char *, index_type, const char *, index_type,
760 const char *, index_type);
761 internal_proto(reshape_packed);
763 /* Repacking functions. These are called internally by internal_pack
764 and internal_unpack. */
766 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
767 internal_proto(internal_pack_1);
769 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
770 internal_proto(internal_pack_2);
772 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
773 internal_proto(internal_pack_4);
775 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
776 internal_proto(internal_pack_8);
778 #if defined HAVE_GFC_INTEGER_16
779 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
780 internal_proto(internal_pack_16);
781 #endif
783 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
784 internal_proto(internal_pack_r4);
786 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
787 internal_proto(internal_pack_r8);
789 #if defined HAVE_GFC_REAL_10
790 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
791 internal_proto(internal_pack_r10);
792 #endif
794 #if defined HAVE_GFC_REAL_16
795 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
796 internal_proto(internal_pack_r16);
797 #endif
799 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
800 internal_proto(internal_pack_c4);
802 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
803 internal_proto(internal_pack_c8);
805 #if defined HAVE_GFC_COMPLEX_10
806 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
807 internal_proto(internal_pack_c10);
808 #endif
810 #if defined HAVE_GFC_COMPLEX_16
811 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
812 internal_proto(internal_pack_c16);
813 #endif
815 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
816 internal_proto(internal_unpack_1);
818 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
819 internal_proto(internal_unpack_2);
821 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
822 internal_proto(internal_unpack_4);
824 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
825 internal_proto(internal_unpack_8);
827 #if defined HAVE_GFC_INTEGER_16
828 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
829 internal_proto(internal_unpack_16);
830 #endif
832 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
833 internal_proto(internal_unpack_r4);
835 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
836 internal_proto(internal_unpack_r8);
838 #if defined HAVE_GFC_REAL_10
839 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
840 internal_proto(internal_unpack_r10);
841 #endif
843 #if defined HAVE_GFC_REAL_16
844 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
845 internal_proto(internal_unpack_r16);
846 #endif
848 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
849 internal_proto(internal_unpack_c4);
851 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
852 internal_proto(internal_unpack_c8);
854 #if defined HAVE_GFC_COMPLEX_10
855 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
856 internal_proto(internal_unpack_c10);
857 #endif
859 #if defined HAVE_GFC_COMPLEX_16
860 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
861 internal_proto(internal_unpack_c16);
862 #endif
864 /* Internal auxiliary functions for the pack intrinsic. */
866 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
867 const gfc_array_l1 *, const gfc_array_i1 *);
868 internal_proto(pack_i1);
870 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
871 const gfc_array_l1 *, const gfc_array_i2 *);
872 internal_proto(pack_i2);
874 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
875 const gfc_array_l1 *, const gfc_array_i4 *);
876 internal_proto(pack_i4);
878 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
879 const gfc_array_l1 *, const gfc_array_i8 *);
880 internal_proto(pack_i8);
882 #ifdef HAVE_GFC_INTEGER_16
883 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
884 const gfc_array_l1 *, const gfc_array_i16 *);
885 internal_proto(pack_i16);
886 #endif
888 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
889 const gfc_array_l1 *, const gfc_array_r4 *);
890 internal_proto(pack_r4);
892 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
893 const gfc_array_l1 *, const gfc_array_r8 *);
894 internal_proto(pack_r8);
896 #ifdef HAVE_GFC_REAL_10
897 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
898 const gfc_array_l1 *, const gfc_array_r10 *);
899 internal_proto(pack_r10);
900 #endif
902 #ifdef HAVE_GFC_REAL_16
903 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
904 const gfc_array_l1 *, const gfc_array_r16 *);
905 internal_proto(pack_r16);
906 #endif
908 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
909 const gfc_array_l1 *, const gfc_array_c4 *);
910 internal_proto(pack_c4);
912 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
913 const gfc_array_l1 *, const gfc_array_c8 *);
914 internal_proto(pack_c8);
916 #ifdef HAVE_GFC_REAL_10
917 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
918 const gfc_array_l1 *, const gfc_array_c10 *);
919 internal_proto(pack_c10);
920 #endif
922 #ifdef HAVE_GFC_REAL_16
923 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
924 const gfc_array_l1 *, const gfc_array_c16 *);
925 internal_proto(pack_c16);
926 #endif
928 /* Internal auxiliary functions for the unpack intrinsic. */
930 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
931 const gfc_array_l1 *, const GFC_INTEGER_1 *);
932 internal_proto(unpack0_i1);
934 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
935 const gfc_array_l1 *, const GFC_INTEGER_2 *);
936 internal_proto(unpack0_i2);
938 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
939 const gfc_array_l1 *, const GFC_INTEGER_4 *);
940 internal_proto(unpack0_i4);
942 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
943 const gfc_array_l1 *, const GFC_INTEGER_8 *);
944 internal_proto(unpack0_i8);
946 #ifdef HAVE_GFC_INTEGER_16
948 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
949 const gfc_array_l1 *, const GFC_INTEGER_16 *);
950 internal_proto(unpack0_i16);
952 #endif
954 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
955 const gfc_array_l1 *, const GFC_REAL_4 *);
956 internal_proto(unpack0_r4);
958 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
959 const gfc_array_l1 *, const GFC_REAL_8 *);
960 internal_proto(unpack0_r8);
962 #ifdef HAVE_GFC_REAL_10
964 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
965 const gfc_array_l1 *, const GFC_REAL_10 *);
966 internal_proto(unpack0_r10);
968 #endif
970 #ifdef HAVE_GFC_REAL_16
972 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
973 const gfc_array_l1 *, const GFC_REAL_16 *);
974 internal_proto(unpack0_r16);
976 #endif
978 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
979 const gfc_array_l1 *, const GFC_COMPLEX_4 *);
980 internal_proto(unpack0_c4);
982 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
983 const gfc_array_l1 *, const GFC_COMPLEX_8 *);
984 internal_proto(unpack0_c8);
986 #ifdef HAVE_GFC_COMPLEX_10
988 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
989 const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
990 internal_proto(unpack0_c10);
992 #endif
994 #ifdef HAVE_GFC_COMPLEX_16
996 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
997 const gfc_array_l1 *, const GFC_COMPLEX_16 *);
998 internal_proto(unpack0_c16);
1000 #endif
1002 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1003 const gfc_array_l1 *, const gfc_array_i1 *);
1004 internal_proto(unpack1_i1);
1006 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1007 const gfc_array_l1 *, const gfc_array_i2 *);
1008 internal_proto(unpack1_i2);
1010 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1011 const gfc_array_l1 *, const gfc_array_i4 *);
1012 internal_proto(unpack1_i4);
1014 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1015 const gfc_array_l1 *, const gfc_array_i8 *);
1016 internal_proto(unpack1_i8);
1018 #ifdef HAVE_GFC_INTEGER_16
1019 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1020 const gfc_array_l1 *, const gfc_array_i16 *);
1021 internal_proto(unpack1_i16);
1022 #endif
1024 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1025 const gfc_array_l1 *, const gfc_array_r4 *);
1026 internal_proto(unpack1_r4);
1028 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1029 const gfc_array_l1 *, const gfc_array_r8 *);
1030 internal_proto(unpack1_r8);
1032 #ifdef HAVE_GFC_REAL_10
1033 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1034 const gfc_array_l1 *, const gfc_array_r10 *);
1035 internal_proto(unpack1_r10);
1036 #endif
1038 #ifdef HAVE_GFC_REAL_16
1039 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1040 const gfc_array_l1 *, const gfc_array_r16 *);
1041 internal_proto(unpack1_r16);
1042 #endif
1044 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1045 const gfc_array_l1 *, const gfc_array_c4 *);
1046 internal_proto(unpack1_c4);
1048 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1049 const gfc_array_l1 *, const gfc_array_c8 *);
1050 internal_proto(unpack1_c8);
1052 #ifdef HAVE_GFC_COMPLEX_10
1053 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1054 const gfc_array_l1 *, const gfc_array_c10 *);
1055 internal_proto(unpack1_c10);
1056 #endif
1058 #ifdef HAVE_GFC_COMPLEX_16
1059 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1060 const gfc_array_l1 *, const gfc_array_c16 *);
1061 internal_proto(unpack1_c16);
1062 #endif
1064 /* Helper functions for spread. */
1066 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1067 const index_type, const index_type);
1068 internal_proto(spread_i1);
1070 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1071 const index_type, const index_type);
1072 internal_proto(spread_i2);
1074 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1075 const index_type, const index_type);
1076 internal_proto(spread_i4);
1078 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1079 const index_type, const index_type);
1080 internal_proto(spread_i8);
1082 #ifdef HAVE_GFC_INTEGER_16
1083 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1084 const index_type, const index_type);
1085 internal_proto(spread_i16);
1087 #endif
1089 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1090 const index_type, const index_type);
1091 internal_proto(spread_r4);
1093 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1094 const index_type, const index_type);
1095 internal_proto(spread_r8);
1097 #ifdef HAVE_GFC_REAL_10
1098 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1099 const index_type, const index_type);
1100 internal_proto(spread_r10);
1102 #endif
1104 #ifdef HAVE_GFC_REAL_16
1105 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1106 const index_type, const index_type);
1107 internal_proto(spread_r16);
1109 #endif
1111 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1112 const index_type, const index_type);
1113 internal_proto(spread_c4);
1115 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1116 const index_type, const index_type);
1117 internal_proto(spread_c8);
1119 #ifdef HAVE_GFC_COMPLEX_10
1120 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1121 const index_type, const index_type);
1122 internal_proto(spread_c10);
1124 #endif
1126 #ifdef HAVE_GFC_COMPLEX_16
1127 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1128 const index_type, const index_type);
1129 internal_proto(spread_c16);
1131 #endif
1133 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1134 const index_type, const index_type);
1135 internal_proto(spread_scalar_i1);
1137 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1138 const index_type, const index_type);
1139 internal_proto(spread_scalar_i2);
1141 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1142 const index_type, const index_type);
1143 internal_proto(spread_scalar_i4);
1145 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1146 const index_type, const index_type);
1147 internal_proto(spread_scalar_i8);
1149 #ifdef HAVE_GFC_INTEGER_16
1150 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1151 const index_type, const index_type);
1152 internal_proto(spread_scalar_i16);
1154 #endif
1156 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1157 const index_type, const index_type);
1158 internal_proto(spread_scalar_r4);
1160 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1161 const index_type, const index_type);
1162 internal_proto(spread_scalar_r8);
1164 #ifdef HAVE_GFC_REAL_10
1165 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1166 const index_type, const index_type);
1167 internal_proto(spread_scalar_r10);
1169 #endif
1171 #ifdef HAVE_GFC_REAL_16
1172 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1173 const index_type, const index_type);
1174 internal_proto(spread_scalar_r16);
1176 #endif
1178 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1179 const index_type, const index_type);
1180 internal_proto(spread_scalar_c4);
1182 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1183 const index_type, const index_type);
1184 internal_proto(spread_scalar_c8);
1186 #ifdef HAVE_GFC_COMPLEX_10
1187 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1188 const index_type, const index_type);
1189 internal_proto(spread_scalar_c10);
1191 #endif
1193 #ifdef HAVE_GFC_COMPLEX_16
1194 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1195 const index_type, const index_type);
1196 internal_proto(spread_scalar_c16);
1198 #endif
1200 /* string_intrinsics.c */
1202 extern int compare_string (gfc_charlen_type, const char *,
1203 gfc_charlen_type, const char *);
1204 iexport_proto(compare_string);
1206 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1207 gfc_charlen_type, const gfc_char4_t *);
1208 iexport_proto(compare_string_char4);
1210 /* random.c */
1212 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1213 gfc_array_i4 * get);
1214 iexport_proto(random_seed_i4);
1215 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1216 gfc_array_i8 * get);
1217 iexport_proto(random_seed_i8);
1219 /* size.c */
1221 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
1223 extern index_type size0 (const array_t * array);
1224 iexport_proto(size0);
1226 /* Internal auxiliary functions for cshift */
1228 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
1229 internal_proto(cshift0_i1);
1231 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
1232 internal_proto(cshift0_i2);
1234 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
1235 internal_proto(cshift0_i4);
1237 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
1238 internal_proto(cshift0_i8);
1240 #ifdef HAVE_GFC_INTEGER_16
1241 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
1242 internal_proto(cshift0_i16);
1243 #endif
1245 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
1246 internal_proto(cshift0_r4);
1248 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
1249 internal_proto(cshift0_r8);
1251 #ifdef HAVE_GFC_REAL_10
1252 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
1253 internal_proto(cshift0_r10);
1254 #endif
1256 #ifdef HAVE_GFC_REAL_16
1257 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
1258 internal_proto(cshift0_r16);
1259 #endif
1261 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
1262 internal_proto(cshift0_c4);
1264 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
1265 internal_proto(cshift0_c8);
1267 #ifdef HAVE_GFC_COMPLEX_10
1268 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
1269 internal_proto(cshift0_c10);
1270 #endif
1272 #ifdef HAVE_GFC_COMPLEX_16
1273 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
1274 internal_proto(cshift0_c16);
1275 #endif
1277 #endif /* LIBGFOR_H */