1 /* Common declarations for all of libgfortran.
2 Copyright (C) 2002-2014 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>, and
4 Andy Vaught <andy@xena.eas.asu.edu>
6 This file is part of the GNU Fortran runtime library (libgfortran).
8 Libgfortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
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 General Public License for more details.
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25 <http://www.gnu.org/licenses/>. */
30 /* Ensure that ANSI conform stdio is used. This needs to be set before
31 any system header file is included. */
32 #if defined __MINGW32__
34 # define gfc_printf gnu_printf
36 # define gfc_printf __printf__
39 /* config.h MUST be first because it can affect system headers. */
49 /* Must appear before math.h on VMS systems. */
52 #define complex __complex__
57 /* If we're support quad-precision floating-point type, include the
58 header to our support library. */
60 # include "quadmath_weak.h"
64 extern float __strtof (const char *, char **);
65 #define gfc_strtof __strtof
66 extern double __strtod (const char *, char **);
67 #define gfc_strtod __strtod
68 extern long double __strtold (const char *, char **);
69 #define gfc_strtold __strtold
71 #define gfc_strtof strtof
72 #define gfc_strtod strtod
73 #define gfc_strtold strtold
76 #include "../gcc/fortran/libgfortran.h"
78 #include "c99_protos.h"
87 #include <sys/types.h>
91 typedef off64_t gfc_offset
;
93 typedef off_t gfc_offset
;
97 #define NULL (void *) 0
101 /* The following macros can be used to annotate conditions which are likely or
102 unlikely to be true. Avoid using them when a condition is only slightly
103 more likely/less unlikely than average to avoid the performance penalties of
104 branch misprediction. In addition, as __builtin_expect overrides the compiler
105 heuristic, do not use in conditions where one of the branches ends with a
106 call to a function with __attribute__((noreturn)): the compiler internal
107 heuristic will mark this branch as much less likely as unlikely() would
111 #define __attribute__(x)
112 #define likely(x) (x)
113 #define unlikely(x) (x)
115 #define likely(x) __builtin_expect(!!(x), 1)
116 #define unlikely(x) __builtin_expect(!!(x), 0)
120 /* Make sure we have ptrdiff_t. */
121 #ifndef HAVE_PTRDIFF_T
122 typedef intptr_t ptrdiff_t;
125 /* On mingw, work around the buggy Windows snprintf() by using the one
126 mingw provides, __mingw_snprintf(). We also provide a prototype for
127 __mingw_snprintf(), because the mingw headers currently don't have one. */
128 #if HAVE_MINGW_SNPRINTF
129 extern int __mingw_snprintf (char *, size_t, const char *, ...)
130 __attribute__ ((format (gnu_printf
, 3, 4)));
132 #define snprintf __mingw_snprintf
133 /* Fallback to sprintf if target does not have snprintf. */
134 #elif !defined(HAVE_SNPRINTF)
136 #define snprintf(str, size, ...) sprintf (str, __VA_ARGS__)
140 /* For a library, a standard prefix is a requirement in order to partition
141 the namespace. IPREFIX is for symbols intended to be internal to the
143 #define PREFIX(x) _gfortran_ ## x
144 #define IPREFIX(x) _gfortrani_ ## x
146 /* Magic to rename a symbol at the compiler level. You continue to refer
147 to the symbol as OLD in the source, but it'll be named NEW in the asm. */
148 #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new)
149 #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new)
150 #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new)
152 /* There are several classifications of routines:
154 (1) Symbols used only within the library,
155 (2) Symbols to be exported from the library,
156 (3) Symbols to be exported from the library, but
157 also used inside the library.
159 By telling the compiler about these different classifications we can
160 tightly control the interface seen by the user, and get better code
161 from the compiler at the same time.
163 One of the following should be used immediately after the declaration
166 internal_proto Marks a symbol used only within the library,
167 and adds IPREFIX to the assembly-level symbol
168 name. The later is important for maintaining
169 the namespace partition for the static library.
171 export_proto Marks a symbol to be exported, and adds PREFIX
172 to the assembly-level symbol name.
174 export_proto_np Marks a symbol to be exported without adding PREFIX.
176 iexport_proto Marks a function to be exported, but with the
177 understanding that it can be used inside as well.
179 iexport_data_proto Similarly, marks a data symbol to be exported.
180 Unfortunately, some systems can't play the hidden
181 symbol renaming trick on data symbols, thanks to
182 the horribleness of COPY relocations.
184 If iexport_proto or iexport_data_proto is used, you must also use
185 iexport or iexport_data after the *definition* of the symbol. */
187 #if defined(HAVE_ATTRIBUTE_VISIBILITY)
188 # define internal_proto(x) \
189 sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden")))
191 # define internal_proto(x) sym_rename(x, IPREFIX(x))
194 #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS)
195 # define export_proto(x) sym_rename(x, PREFIX(x))
196 # define export_proto_np(x) extern char swallow_semicolon
197 # define iexport_proto(x) internal_proto(x)
198 # define iexport(x) iexport1(x, IPREFIX(x))
199 # define iexport1(x,y) iexport2(x,y)
200 # define iexport2(x,y) \
201 extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y)))
203 # define export_proto(x) sym_rename(x, PREFIX(x))
204 # define export_proto_np(x) extern char swallow_semicolon
205 # define iexport_proto(x) export_proto(x)
206 # define iexport(x) extern char swallow_semicolon
209 /* TODO: detect the case when we *can* hide the symbol. */
210 #define iexport_data_proto(x) export_proto(x)
211 #define iexport_data(x) extern char swallow_semicolon
213 /* The only reliable way to get the offset of a field in a struct
214 in a system independent way is via this macro. */
216 #define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
219 /* The C99 classification macros isfinite, isinf, isnan, isnormal
220 and signbit are broken or inconsistent on quite a few targets.
221 So, we use GCC's builtins instead.
223 Another advantage for GCC's builtins for these type-generic macros
224 is that it handles floating-point types that the system headers
225 may not support (like __float128). */
228 #define isnan(x) __builtin_isnan(x)
230 #define isfinite(x) __builtin_isfinite(x)
232 #define isinf(x) __builtin_isinf(x)
234 #define isnormal(x) __builtin_isnormal(x)
236 #define signbit(x) __builtin_signbit(x)
238 /* TODO: find the C99 version of these an move into above ifdef. */
239 #define REALPART(z) (__real__(z))
240 #define IMAGPART(z) (__imag__(z))
241 #define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
245 /* Define the type used for the current record number for large file I/O.
246 The size must be consistent with the size defined on the compiler side. */
247 #ifdef HAVE_GFC_INTEGER_8
248 typedef GFC_INTEGER_8 GFC_IO_INT
;
250 #ifdef HAVE_GFC_INTEGER_4
251 typedef GFC_INTEGER_4 GFC_IO_INT
;
253 #error "GFC_INTEGER_4 should be available for the library to compile".
257 /* The following two definitions must be consistent with the types used
259 /* The type used of array indices, amongst other things. */
260 typedef ptrdiff_t index_type
;
262 /* The type used for the lengths of character variables. */
263 typedef GFC_INTEGER_4 gfc_charlen_type
;
265 /* Definitions of CHARACTER data types:
266 - CHARACTER(KIND=1) corresponds to the C char type,
267 - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */
268 typedef GFC_UINTEGER_4 gfc_char4_t
;
270 /* Byte size of character kinds. For the kinds currently supported, it's
271 simply equal to the kind parameter itself. */
272 #define GFC_SIZE_OF_CHAR_KIND(kind) (kind)
274 /* This will be 0 on little-endian machines and one on big-endian machines. */
275 extern int big_endian
;
276 internal_proto(big_endian
);
278 #define GFOR_POINTER_TO_L1(p, kind) \
279 (big_endian * (kind - 1) + (GFC_LOGICAL_1 *)(p))
281 #define GFC_INTEGER_1_HUGE \
282 (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1)
283 #define GFC_INTEGER_2_HUGE \
284 (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1)
285 #define GFC_INTEGER_4_HUGE \
286 (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1)
287 #define GFC_INTEGER_8_HUGE \
288 (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1)
289 #ifdef HAVE_GFC_INTEGER_16
290 #define GFC_INTEGER_16_HUGE \
291 (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1)
294 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported. */
296 #ifdef __FLT_HAS_INFINITY__
297 # define GFC_REAL_4_INFINITY __builtin_inff ()
299 #ifdef __DBL_HAS_INFINITY__
300 # define GFC_REAL_8_INFINITY __builtin_inf ()
302 #ifdef __LDBL_HAS_INFINITY__
303 # ifdef HAVE_GFC_REAL_10
304 # define GFC_REAL_10_INFINITY __builtin_infl ()
306 # ifdef HAVE_GFC_REAL_16
307 # ifdef GFC_REAL_16_IS_LONG_DOUBLE
308 # define GFC_REAL_16_INFINITY __builtin_infl ()
310 # define GFC_REAL_16_INFINITY __builtin_infq ()
314 #ifdef __FLT_HAS_QUIET_NAN__
315 # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("")
317 #ifdef __DBL_HAS_QUIET_NAN__
318 # define GFC_REAL_8_QUIET_NAN __builtin_nan ("")
320 #ifdef __LDBL_HAS_QUIET_NAN__
321 # ifdef HAVE_GFC_REAL_10
322 # define GFC_REAL_10_QUIET_NAN __builtin_nanl ("")
324 # ifdef HAVE_GFC_REAL_16
325 # ifdef GFC_REAL_16_IS_LONG_DOUBLE
326 # define GFC_REAL_16_QUIET_NAN __builtin_nanl ("")
328 # define GFC_REAL_16_QUIET_NAN nanq ("")
333 typedef struct descriptor_dimension
336 index_type lower_bound
;
340 descriptor_dimension
;
342 #define GFC_ARRAY_DESCRIPTOR(r, type) \
347 descriptor_dimension dim[r];\
350 /* Commonly used array descriptor types. */
351 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, void) gfc_array_void
;
352 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, char) gfc_array_char
;
353 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_INTEGER_1
) gfc_array_i1
;
354 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_INTEGER_2
) gfc_array_i2
;
355 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_INTEGER_4
) gfc_array_i4
;
356 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_INTEGER_8
) gfc_array_i8
;
357 #ifdef HAVE_GFC_INTEGER_16
358 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_INTEGER_16
) gfc_array_i16
;
360 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_REAL_4
) gfc_array_r4
;
361 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_REAL_8
) gfc_array_r8
;
362 #ifdef HAVE_GFC_REAL_10
363 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_REAL_10
) gfc_array_r10
;
365 #ifdef HAVE_GFC_REAL_16
366 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_REAL_16
) gfc_array_r16
;
368 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_COMPLEX_4
) gfc_array_c4
;
369 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_COMPLEX_8
) gfc_array_c8
;
370 #ifdef HAVE_GFC_COMPLEX_10
371 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_COMPLEX_10
) gfc_array_c10
;
373 #ifdef HAVE_GFC_COMPLEX_16
374 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_COMPLEX_16
) gfc_array_c16
;
376 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_LOGICAL_1
) gfc_array_l1
;
377 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_LOGICAL_2
) gfc_array_l2
;
378 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_LOGICAL_4
) gfc_array_l4
;
379 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_LOGICAL_8
) gfc_array_l8
;
380 #ifdef HAVE_GFC_LOGICAL_16
381 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, GFC_LOGICAL_16
) gfc_array_l16
;
385 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
386 #define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
387 >> GFC_DTYPE_TYPE_SHIFT)
388 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
389 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
390 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
392 #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound)
393 #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
394 #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
395 #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound)
396 #define GFC_DIMENSION_SET(dim,lb,ub,str) \
399 (dim).lower_bound = lb; \
400 (dim)._ubound = ub; \
401 (dim)._stride = str; \
405 #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound)
406 #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
407 #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
408 - (desc)->dim[i].lower_bound)
409 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
410 (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
412 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
413 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
414 (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
416 /* Macros to get both the size and the type with a single masking operation */
418 #define GFC_DTYPE_SIZE_MASK \
419 ((~((index_type) 0) >> GFC_DTYPE_SIZE_SHIFT) << GFC_DTYPE_SIZE_SHIFT)
420 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
422 #define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
424 #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
425 | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
426 #define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
427 | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
428 #define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
429 | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
430 #define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
431 | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
432 #ifdef HAVE_GFC_INTEGER_16
433 #define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
434 | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
437 #define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
438 | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT))
439 #define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
440 | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT))
441 #define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
442 | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT))
443 #define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
444 | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT))
445 #ifdef HAVE_GFC_LOGICAL_16
446 #define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \
447 | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT))
450 #define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
451 | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT))
452 #define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
453 | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT))
454 #ifdef HAVE_GFC_REAL_10
455 #define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
456 | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT))
458 #ifdef HAVE_GFC_REAL_16
459 #define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \
460 | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT))
463 #define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
464 | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT))
465 #define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
466 | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT))
467 #ifdef HAVE_GFC_COMPLEX_10
468 #define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
469 | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT))
471 #ifdef HAVE_GFC_COMPLEX_16
472 #define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \
473 | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT))
476 #define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
477 | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
478 #define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
479 | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT))
480 #define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
481 | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT))
482 #define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
483 | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT))
484 #ifdef HAVE_GFC_INTEGER_16
485 #define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \
486 | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT))
489 /* Macros to determine the alignment of pointers. */
491 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \
492 (__alignof__(GFC_INTEGER_2) - 1))
493 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \
494 (__alignof__(GFC_INTEGER_4) - 1))
495 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \
496 (__alignof__(GFC_INTEGER_8) - 1))
497 #ifdef HAVE_GFC_INTEGER_16
498 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \
499 (__alignof__(GFC_INTEGER_16) - 1))
502 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \
503 (__alignof__(GFC_COMPLEX_4) - 1))
505 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \
506 (__alignof__(GFC_COMPLEX_8) - 1))
508 /* Runtime library include. */
509 #define stringize(x) expand_macro(x)
510 #define expand_macro(x) # x
512 /* Runtime options structure. */
516 int stdin_unit
, stdout_unit
, stderr_unit
, optional_plus
;
520 const char *separator
;
522 int all_unbuffered
, unbuffered_preconnected
, default_recl
;
527 extern options_t options
;
528 internal_proto(options
);
530 extern void backtrace_handler (int);
531 internal_proto(backtrace_handler
);
534 /* Compile-time options that will influence the library. */
544 size_t record_marker
;
545 int max_subrecord_length
;
551 extern compile_options_t compile_options
;
552 internal_proto(compile_options
);
554 extern void init_compile_options (void);
555 internal_proto(init_compile_options
);
557 #define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */
559 /* Structure for statement options. */
569 /* This is returned by notification_std to know if, given the flags
570 that were given (-std=, -pedantic) we should issue an error, a warning
573 { NOTIFICATION_SILENT
, NOTIFICATION_WARNING
, NOTIFICATION_ERROR
}
577 /* The filename and line number don't go inside the globals structure.
578 They are set by the rest of the program and must be linked to. */
580 /* Location of the current library call (optional). */
581 extern unsigned line
;
582 iexport_data_proto(line
);
584 extern char *filename
;
585 iexport_data_proto(filename
);
587 /* Avoid conflicting prototypes of alloca() in system headers by using
588 GCC's builtin alloca(). */
589 #define gfc_alloca(x) __builtin_alloca(x)
592 /* The default value of record length for preconnected units is defined
593 here. This value can be overriden by an environment variable.
594 Default value is 1 Gb. */
595 #define DEFAULT_RECL 1073741824
598 #define CHARACTER2(name) \
599 gfc_charlen_type name ## _len; \
602 typedef struct st_parameter_common
606 const char *filename
;
609 GFC_INTEGER_4
*iostat
;
615 #define IOPARM_LIBRETURN_MASK (3 << 0)
616 #define IOPARM_LIBRETURN_OK (0 << 0)
617 #define IOPARM_LIBRETURN_ERROR (1 << 0)
618 #define IOPARM_LIBRETURN_END (2 << 0)
619 #define IOPARM_LIBRETURN_EOR (3 << 0)
620 #define IOPARM_ERR (1 << 2)
621 #define IOPARM_END (1 << 3)
622 #define IOPARM_EOR (1 << 4)
623 #define IOPARM_HAS_IOSTAT (1 << 5)
624 #define IOPARM_HAS_IOMSG (1 << 6)
626 #define IOPARM_COMMON_MASK ((1 << 7) - 1)
628 #define IOPARM_OPEN_HAS_RECL_IN (1 << 7)
629 #define IOPARM_OPEN_HAS_FILE (1 << 8)
630 #define IOPARM_OPEN_HAS_STATUS (1 << 9)
631 #define IOPARM_OPEN_HAS_ACCESS (1 << 10)
632 #define IOPARM_OPEN_HAS_FORM (1 << 11)
633 #define IOPARM_OPEN_HAS_BLANK (1 << 12)
634 #define IOPARM_OPEN_HAS_POSITION (1 << 13)
635 #define IOPARM_OPEN_HAS_ACTION (1 << 14)
636 #define IOPARM_OPEN_HAS_DELIM (1 << 15)
637 #define IOPARM_OPEN_HAS_PAD (1 << 16)
638 #define IOPARM_OPEN_HAS_CONVERT (1 << 17)
639 #define IOPARM_OPEN_HAS_DECIMAL (1 << 18)
640 #define IOPARM_OPEN_HAS_ENCODING (1 << 19)
641 #define IOPARM_OPEN_HAS_ROUND (1 << 20)
642 #define IOPARM_OPEN_HAS_SIGN (1 << 21)
643 #define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22)
644 #define IOPARM_OPEN_HAS_NEWUNIT (1 << 23)
646 /* library start function and end macro. These can be expanded if needed
647 in the future. cmp is st_parameter_common *cmp */
649 extern void library_start (st_parameter_common
*);
650 internal_proto(library_start
);
652 #define library_end()
656 extern void stupid_function_name_for_static_linking (void);
657 internal_proto(stupid_function_name_for_static_linking
);
659 extern void set_args (int, char **);
660 iexport_proto(set_args
);
662 extern void get_args (int *, char ***);
663 internal_proto(get_args
);
665 extern void store_exe_path (const char *);
666 export_proto(store_exe_path
);
668 extern char * full_exe_path (void);
669 internal_proto(full_exe_path
);
671 extern void find_addr2line (void);
672 internal_proto(find_addr2line
);
676 extern void backtrace (void);
677 iexport_proto(backtrace
);
681 #if defined(HAVE_GFC_REAL_16)
682 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16))
683 #elif defined(HAVE_GFC_INTEGER_16)
684 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
685 #elif defined(HAVE_GFC_REAL_10)
686 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10))
688 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST))
691 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
692 #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1)
693 #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1)
694 #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1)
696 extern void sys_abort (void) __attribute__ ((noreturn
));
697 internal_proto(sys_abort
);
699 extern ssize_t
estr_write (const char *);
700 internal_proto(estr_write
);
702 extern int st_vprintf (const char *, va_list);
703 internal_proto(st_vprintf
);
705 extern int st_printf (const char *, ...)
706 __attribute__((format (gfc_printf
, 1, 2)));
707 internal_proto(st_printf
);
709 extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST
, char *, size_t);
710 internal_proto(gfc_xtoa
);
712 extern void os_error (const char *) __attribute__ ((noreturn
));
713 iexport_proto(os_error
);
715 extern void show_locus (st_parameter_common
*);
716 internal_proto(show_locus
);
718 extern void runtime_error (const char *, ...)
719 __attribute__ ((noreturn
, format (gfc_printf
, 1, 2)));
720 iexport_proto(runtime_error
);
722 extern void runtime_error_at (const char *, const char *, ...)
723 __attribute__ ((noreturn
, format (gfc_printf
, 2, 3)));
724 iexport_proto(runtime_error_at
);
726 extern void runtime_warning_at (const char *, const char *, ...)
727 __attribute__ ((format (gfc_printf
, 2, 3)));
728 iexport_proto(runtime_warning_at
);
730 extern void internal_error (st_parameter_common
*, const char *)
731 __attribute__ ((noreturn
));
732 internal_proto(internal_error
);
734 extern const char *translate_error (int);
735 internal_proto(translate_error
);
737 extern void generate_error (st_parameter_common
*, int, const char *);
738 iexport_proto(generate_error
);
740 extern void generate_warning (st_parameter_common
*, const char *);
741 internal_proto(generate_warning
);
743 extern bool notify_std (st_parameter_common
*, int, const char *);
744 internal_proto(notify_std
);
746 extern notification
notification_std(int);
747 internal_proto(notification_std
);
749 extern char *gf_strerror (int, char *, size_t);
750 internal_proto(gf_strerror
);
754 extern void set_fpu (void);
755 internal_proto(set_fpu
);
757 extern int get_fpu_except_flags (void);
758 internal_proto(get_fpu_except_flags
);
760 extern void set_fpu_rounding_mode (int round
);
761 internal_proto(set_fpu_rounding_mode
);
763 extern int get_fpu_rounding_mode (void);
764 internal_proto(get_fpu_rounding_mode
);
768 extern void *xmalloc (size_t) __attribute__ ((malloc
));
769 internal_proto(xmalloc
);
771 extern void *xmallocarray (size_t, size_t) __attribute__ ((malloc
));
772 internal_proto(xmallocarray
);
774 extern void *xcalloc (size_t, size_t) __attribute__ ((malloc
));
775 internal_proto(xcalloc
);
777 extern void *xrealloc (void *, size_t);
778 internal_proto(xrealloc
);
782 extern int check_buffered (int);
783 internal_proto(check_buffered
);
785 extern void init_variables (void);
786 internal_proto(init_variables
);
788 extern void show_variables (void);
789 internal_proto(show_variables
);
791 unit_convert
get_unformatted_convert (int);
792 internal_proto(get_unformatted_convert
);
794 /* Secure getenv() which returns NULL if running as SUID/SGID. */
795 #ifndef HAVE_SECURE_GETENV
796 #ifdef HAVE___SECURE_GETENV
797 #define secure_getenv __secure_getenv
798 #elif defined(HAVE_GETUID) && defined(HAVE_GETEUID) \
799 && defined(HAVE_GETGID) && defined(HAVE_GETEGID)
800 #define FALLBACK_SECURE_GETENV
801 extern char *secure_getenv (const char *);
802 internal_proto(secure_getenv
);
804 #define secure_getenv getenv
810 extern int find_option (st_parameter_common
*, const char *, gfc_charlen_type
,
811 const st_option
*, const char *);
812 internal_proto(find_option
);
814 extern gfc_charlen_type
fstrlen (const char *, gfc_charlen_type
);
815 internal_proto(fstrlen
);
817 extern gfc_charlen_type
fstrcpy (char *, gfc_charlen_type
, const char *, gfc_charlen_type
);
818 internal_proto(fstrcpy
);
820 extern gfc_charlen_type
cf_strcpy (char *, gfc_charlen_type
, const char *);
821 internal_proto(cf_strcpy
);
823 extern gfc_charlen_type
string_len_trim (gfc_charlen_type
, const char *);
824 export_proto(string_len_trim
);
826 extern gfc_charlen_type
string_len_trim_char4 (gfc_charlen_type
,
827 const gfc_char4_t
*);
828 export_proto(string_len_trim_char4
);
830 extern char *fc_strdup(const char *, gfc_charlen_type
);
831 internal_proto(fc_strdup
);
833 /* io/intrinsics.c */
835 extern void flush_all_units (void);
836 internal_proto(flush_all_units
);
840 extern void init_units (void);
841 internal_proto(init_units
);
843 extern void close_units (void);
844 internal_proto(close_units
);
846 extern int unit_to_fd (int);
847 internal_proto(unit_to_fd
);
849 extern char * filename_from_unit (int);
850 internal_proto(filename_from_unit
);
854 extern void stop_string (const char *, GFC_INTEGER_4
)
855 __attribute__ ((noreturn
));
856 export_proto(stop_string
);
858 /* reshape_packed.c */
860 extern void reshape_packed (char *, index_type
, const char *, index_type
,
861 const char *, index_type
);
862 internal_proto(reshape_packed
);
864 /* Repacking functions. These are called internally by internal_pack
865 and internal_unpack. */
867 GFC_INTEGER_1
*internal_pack_1 (gfc_array_i1
*);
868 internal_proto(internal_pack_1
);
870 GFC_INTEGER_2
*internal_pack_2 (gfc_array_i2
*);
871 internal_proto(internal_pack_2
);
873 GFC_INTEGER_4
*internal_pack_4 (gfc_array_i4
*);
874 internal_proto(internal_pack_4
);
876 GFC_INTEGER_8
*internal_pack_8 (gfc_array_i8
*);
877 internal_proto(internal_pack_8
);
879 #if defined HAVE_GFC_INTEGER_16
880 GFC_INTEGER_16
*internal_pack_16 (gfc_array_i16
*);
881 internal_proto(internal_pack_16
);
884 GFC_REAL_4
*internal_pack_r4 (gfc_array_r4
*);
885 internal_proto(internal_pack_r4
);
887 GFC_REAL_8
*internal_pack_r8 (gfc_array_r8
*);
888 internal_proto(internal_pack_r8
);
890 #if defined HAVE_GFC_REAL_10
891 GFC_REAL_10
*internal_pack_r10 (gfc_array_r10
*);
892 internal_proto(internal_pack_r10
);
895 #if defined HAVE_GFC_REAL_16
896 GFC_REAL_16
*internal_pack_r16 (gfc_array_r16
*);
897 internal_proto(internal_pack_r16
);
900 GFC_COMPLEX_4
*internal_pack_c4 (gfc_array_c4
*);
901 internal_proto(internal_pack_c4
);
903 GFC_COMPLEX_8
*internal_pack_c8 (gfc_array_c8
*);
904 internal_proto(internal_pack_c8
);
906 #if defined HAVE_GFC_COMPLEX_10
907 GFC_COMPLEX_10
*internal_pack_c10 (gfc_array_c10
*);
908 internal_proto(internal_pack_c10
);
911 #if defined HAVE_GFC_COMPLEX_16
912 GFC_COMPLEX_16
*internal_pack_c16 (gfc_array_c16
*);
913 internal_proto(internal_pack_c16
);
916 extern void internal_unpack_1 (gfc_array_i1
*, const GFC_INTEGER_1
*);
917 internal_proto(internal_unpack_1
);
919 extern void internal_unpack_2 (gfc_array_i2
*, const GFC_INTEGER_2
*);
920 internal_proto(internal_unpack_2
);
922 extern void internal_unpack_4 (gfc_array_i4
*, const GFC_INTEGER_4
*);
923 internal_proto(internal_unpack_4
);
925 extern void internal_unpack_8 (gfc_array_i8
*, const GFC_INTEGER_8
*);
926 internal_proto(internal_unpack_8
);
928 #if defined HAVE_GFC_INTEGER_16
929 extern void internal_unpack_16 (gfc_array_i16
*, const GFC_INTEGER_16
*);
930 internal_proto(internal_unpack_16
);
933 extern void internal_unpack_r4 (gfc_array_r4
*, const GFC_REAL_4
*);
934 internal_proto(internal_unpack_r4
);
936 extern void internal_unpack_r8 (gfc_array_r8
*, const GFC_REAL_8
*);
937 internal_proto(internal_unpack_r8
);
939 #if defined HAVE_GFC_REAL_10
940 extern void internal_unpack_r10 (gfc_array_r10
*, const GFC_REAL_10
*);
941 internal_proto(internal_unpack_r10
);
944 #if defined HAVE_GFC_REAL_16
945 extern void internal_unpack_r16 (gfc_array_r16
*, const GFC_REAL_16
*);
946 internal_proto(internal_unpack_r16
);
949 extern void internal_unpack_c4 (gfc_array_c4
*, const GFC_COMPLEX_4
*);
950 internal_proto(internal_unpack_c4
);
952 extern void internal_unpack_c8 (gfc_array_c8
*, const GFC_COMPLEX_8
*);
953 internal_proto(internal_unpack_c8
);
955 #if defined HAVE_GFC_COMPLEX_10
956 extern void internal_unpack_c10 (gfc_array_c10
*, const GFC_COMPLEX_10
*);
957 internal_proto(internal_unpack_c10
);
960 #if defined HAVE_GFC_COMPLEX_16
961 extern void internal_unpack_c16 (gfc_array_c16
*, const GFC_COMPLEX_16
*);
962 internal_proto(internal_unpack_c16
);
965 /* Internal auxiliary functions for the pack intrinsic. */
967 extern void pack_i1 (gfc_array_i1
*, const gfc_array_i1
*,
968 const gfc_array_l1
*, const gfc_array_i1
*);
969 internal_proto(pack_i1
);
971 extern void pack_i2 (gfc_array_i2
*, const gfc_array_i2
*,
972 const gfc_array_l1
*, const gfc_array_i2
*);
973 internal_proto(pack_i2
);
975 extern void pack_i4 (gfc_array_i4
*, const gfc_array_i4
*,
976 const gfc_array_l1
*, const gfc_array_i4
*);
977 internal_proto(pack_i4
);
979 extern void pack_i8 (gfc_array_i8
*, const gfc_array_i8
*,
980 const gfc_array_l1
*, const gfc_array_i8
*);
981 internal_proto(pack_i8
);
983 #ifdef HAVE_GFC_INTEGER_16
984 extern void pack_i16 (gfc_array_i16
*, const gfc_array_i16
*,
985 const gfc_array_l1
*, const gfc_array_i16
*);
986 internal_proto(pack_i16
);
989 extern void pack_r4 (gfc_array_r4
*, const gfc_array_r4
*,
990 const gfc_array_l1
*, const gfc_array_r4
*);
991 internal_proto(pack_r4
);
993 extern void pack_r8 (gfc_array_r8
*, const gfc_array_r8
*,
994 const gfc_array_l1
*, const gfc_array_r8
*);
995 internal_proto(pack_r8
);
997 #ifdef HAVE_GFC_REAL_10
998 extern void pack_r10 (gfc_array_r10
*, const gfc_array_r10
*,
999 const gfc_array_l1
*, const gfc_array_r10
*);
1000 internal_proto(pack_r10
);
1003 #ifdef HAVE_GFC_REAL_16
1004 extern void pack_r16 (gfc_array_r16
*, const gfc_array_r16
*,
1005 const gfc_array_l1
*, const gfc_array_r16
*);
1006 internal_proto(pack_r16
);
1009 extern void pack_c4 (gfc_array_c4
*, const gfc_array_c4
*,
1010 const gfc_array_l1
*, const gfc_array_c4
*);
1011 internal_proto(pack_c4
);
1013 extern void pack_c8 (gfc_array_c8
*, const gfc_array_c8
*,
1014 const gfc_array_l1
*, const gfc_array_c8
*);
1015 internal_proto(pack_c8
);
1017 #ifdef HAVE_GFC_REAL_10
1018 extern void pack_c10 (gfc_array_c10
*, const gfc_array_c10
*,
1019 const gfc_array_l1
*, const gfc_array_c10
*);
1020 internal_proto(pack_c10
);
1023 #ifdef HAVE_GFC_REAL_16
1024 extern void pack_c16 (gfc_array_c16
*, const gfc_array_c16
*,
1025 const gfc_array_l1
*, const gfc_array_c16
*);
1026 internal_proto(pack_c16
);
1029 /* Internal auxiliary functions for the unpack intrinsic. */
1031 extern void unpack0_i1 (gfc_array_i1
*, const gfc_array_i1
*,
1032 const gfc_array_l1
*, const GFC_INTEGER_1
*);
1033 internal_proto(unpack0_i1
);
1035 extern void unpack0_i2 (gfc_array_i2
*, const gfc_array_i2
*,
1036 const gfc_array_l1
*, const GFC_INTEGER_2
*);
1037 internal_proto(unpack0_i2
);
1039 extern void unpack0_i4 (gfc_array_i4
*, const gfc_array_i4
*,
1040 const gfc_array_l1
*, const GFC_INTEGER_4
*);
1041 internal_proto(unpack0_i4
);
1043 extern void unpack0_i8 (gfc_array_i8
*, const gfc_array_i8
*,
1044 const gfc_array_l1
*, const GFC_INTEGER_8
*);
1045 internal_proto(unpack0_i8
);
1047 #ifdef HAVE_GFC_INTEGER_16
1049 extern void unpack0_i16 (gfc_array_i16
*, const gfc_array_i16
*,
1050 const gfc_array_l1
*, const GFC_INTEGER_16
*);
1051 internal_proto(unpack0_i16
);
1055 extern void unpack0_r4 (gfc_array_r4
*, const gfc_array_r4
*,
1056 const gfc_array_l1
*, const GFC_REAL_4
*);
1057 internal_proto(unpack0_r4
);
1059 extern void unpack0_r8 (gfc_array_r8
*, const gfc_array_r8
*,
1060 const gfc_array_l1
*, const GFC_REAL_8
*);
1061 internal_proto(unpack0_r8
);
1063 #ifdef HAVE_GFC_REAL_10
1065 extern void unpack0_r10 (gfc_array_r10
*, const gfc_array_r10
*,
1066 const gfc_array_l1
*, const GFC_REAL_10
*);
1067 internal_proto(unpack0_r10
);
1071 #ifdef HAVE_GFC_REAL_16
1073 extern void unpack0_r16 (gfc_array_r16
*, const gfc_array_r16
*,
1074 const gfc_array_l1
*, const GFC_REAL_16
*);
1075 internal_proto(unpack0_r16
);
1079 extern void unpack0_c4 (gfc_array_c4
*, const gfc_array_c4
*,
1080 const gfc_array_l1
*, const GFC_COMPLEX_4
*);
1081 internal_proto(unpack0_c4
);
1083 extern void unpack0_c8 (gfc_array_c8
*, const gfc_array_c8
*,
1084 const gfc_array_l1
*, const GFC_COMPLEX_8
*);
1085 internal_proto(unpack0_c8
);
1087 #ifdef HAVE_GFC_COMPLEX_10
1089 extern void unpack0_c10 (gfc_array_c10
*, const gfc_array_c10
*,
1090 const gfc_array_l1
*mask
, const GFC_COMPLEX_10
*);
1091 internal_proto(unpack0_c10
);
1095 #ifdef HAVE_GFC_COMPLEX_16
1097 extern void unpack0_c16 (gfc_array_c16
*, const gfc_array_c16
*,
1098 const gfc_array_l1
*, const GFC_COMPLEX_16
*);
1099 internal_proto(unpack0_c16
);
1103 extern void unpack1_i1 (gfc_array_i1
*, const gfc_array_i1
*,
1104 const gfc_array_l1
*, const gfc_array_i1
*);
1105 internal_proto(unpack1_i1
);
1107 extern void unpack1_i2 (gfc_array_i2
*, const gfc_array_i2
*,
1108 const gfc_array_l1
*, const gfc_array_i2
*);
1109 internal_proto(unpack1_i2
);
1111 extern void unpack1_i4 (gfc_array_i4
*, const gfc_array_i4
*,
1112 const gfc_array_l1
*, const gfc_array_i4
*);
1113 internal_proto(unpack1_i4
);
1115 extern void unpack1_i8 (gfc_array_i8
*, const gfc_array_i8
*,
1116 const gfc_array_l1
*, const gfc_array_i8
*);
1117 internal_proto(unpack1_i8
);
1119 #ifdef HAVE_GFC_INTEGER_16
1120 extern void unpack1_i16 (gfc_array_i16
*, const gfc_array_i16
*,
1121 const gfc_array_l1
*, const gfc_array_i16
*);
1122 internal_proto(unpack1_i16
);
1125 extern void unpack1_r4 (gfc_array_r4
*, const gfc_array_r4
*,
1126 const gfc_array_l1
*, const gfc_array_r4
*);
1127 internal_proto(unpack1_r4
);
1129 extern void unpack1_r8 (gfc_array_r8
*, const gfc_array_r8
*,
1130 const gfc_array_l1
*, const gfc_array_r8
*);
1131 internal_proto(unpack1_r8
);
1133 #ifdef HAVE_GFC_REAL_10
1134 extern void unpack1_r10 (gfc_array_r10
*, const gfc_array_r10
*,
1135 const gfc_array_l1
*, const gfc_array_r10
*);
1136 internal_proto(unpack1_r10
);
1139 #ifdef HAVE_GFC_REAL_16
1140 extern void unpack1_r16 (gfc_array_r16
*, const gfc_array_r16
*,
1141 const gfc_array_l1
*, const gfc_array_r16
*);
1142 internal_proto(unpack1_r16
);
1145 extern void unpack1_c4 (gfc_array_c4
*, const gfc_array_c4
*,
1146 const gfc_array_l1
*, const gfc_array_c4
*);
1147 internal_proto(unpack1_c4
);
1149 extern void unpack1_c8 (gfc_array_c8
*, const gfc_array_c8
*,
1150 const gfc_array_l1
*, const gfc_array_c8
*);
1151 internal_proto(unpack1_c8
);
1153 #ifdef HAVE_GFC_COMPLEX_10
1154 extern void unpack1_c10 (gfc_array_c10
*, const gfc_array_c10
*,
1155 const gfc_array_l1
*, const gfc_array_c10
*);
1156 internal_proto(unpack1_c10
);
1159 #ifdef HAVE_GFC_COMPLEX_16
1160 extern void unpack1_c16 (gfc_array_c16
*, const gfc_array_c16
*,
1161 const gfc_array_l1
*, const gfc_array_c16
*);
1162 internal_proto(unpack1_c16
);
1165 /* Helper functions for spread. */
1167 extern void spread_i1 (gfc_array_i1
*, const gfc_array_i1
*,
1168 const index_type
, const index_type
);
1169 internal_proto(spread_i1
);
1171 extern void spread_i2 (gfc_array_i2
*, const gfc_array_i2
*,
1172 const index_type
, const index_type
);
1173 internal_proto(spread_i2
);
1175 extern void spread_i4 (gfc_array_i4
*, const gfc_array_i4
*,
1176 const index_type
, const index_type
);
1177 internal_proto(spread_i4
);
1179 extern void spread_i8 (gfc_array_i8
*, const gfc_array_i8
*,
1180 const index_type
, const index_type
);
1181 internal_proto(spread_i8
);
1183 #ifdef HAVE_GFC_INTEGER_16
1184 extern void spread_i16 (gfc_array_i16
*, const gfc_array_i16
*,
1185 const index_type
, const index_type
);
1186 internal_proto(spread_i16
);
1190 extern void spread_r4 (gfc_array_r4
*, const gfc_array_r4
*,
1191 const index_type
, const index_type
);
1192 internal_proto(spread_r4
);
1194 extern void spread_r8 (gfc_array_r8
*, const gfc_array_r8
*,
1195 const index_type
, const index_type
);
1196 internal_proto(spread_r8
);
1198 #ifdef HAVE_GFC_REAL_10
1199 extern void spread_r10 (gfc_array_r10
*, const gfc_array_r10
*,
1200 const index_type
, const index_type
);
1201 internal_proto(spread_r10
);
1205 #ifdef HAVE_GFC_REAL_16
1206 extern void spread_r16 (gfc_array_r16
*, const gfc_array_r16
*,
1207 const index_type
, const index_type
);
1208 internal_proto(spread_r16
);
1212 extern void spread_c4 (gfc_array_c4
*, const gfc_array_c4
*,
1213 const index_type
, const index_type
);
1214 internal_proto(spread_c4
);
1216 extern void spread_c8 (gfc_array_c8
*, const gfc_array_c8
*,
1217 const index_type
, const index_type
);
1218 internal_proto(spread_c8
);
1220 #ifdef HAVE_GFC_COMPLEX_10
1221 extern void spread_c10 (gfc_array_c10
*, const gfc_array_c10
*,
1222 const index_type
, const index_type
);
1223 internal_proto(spread_c10
);
1227 #ifdef HAVE_GFC_COMPLEX_16
1228 extern void spread_c16 (gfc_array_c16
*, const gfc_array_c16
*,
1229 const index_type
, const index_type
);
1230 internal_proto(spread_c16
);
1234 extern void spread_scalar_i1 (gfc_array_i1
*, const GFC_INTEGER_1
*,
1235 const index_type
, const index_type
);
1236 internal_proto(spread_scalar_i1
);
1238 extern void spread_scalar_i2 (gfc_array_i2
*, const GFC_INTEGER_2
*,
1239 const index_type
, const index_type
);
1240 internal_proto(spread_scalar_i2
);
1242 extern void spread_scalar_i4 (gfc_array_i4
*, const GFC_INTEGER_4
*,
1243 const index_type
, const index_type
);
1244 internal_proto(spread_scalar_i4
);
1246 extern void spread_scalar_i8 (gfc_array_i8
*, const GFC_INTEGER_8
*,
1247 const index_type
, const index_type
);
1248 internal_proto(spread_scalar_i8
);
1250 #ifdef HAVE_GFC_INTEGER_16
1251 extern void spread_scalar_i16 (gfc_array_i16
*, const GFC_INTEGER_16
*,
1252 const index_type
, const index_type
);
1253 internal_proto(spread_scalar_i16
);
1257 extern void spread_scalar_r4 (gfc_array_r4
*, const GFC_REAL_4
*,
1258 const index_type
, const index_type
);
1259 internal_proto(spread_scalar_r4
);
1261 extern void spread_scalar_r8 (gfc_array_r8
*, const GFC_REAL_8
*,
1262 const index_type
, const index_type
);
1263 internal_proto(spread_scalar_r8
);
1265 #ifdef HAVE_GFC_REAL_10
1266 extern void spread_scalar_r10 (gfc_array_r10
*, const GFC_REAL_10
*,
1267 const index_type
, const index_type
);
1268 internal_proto(spread_scalar_r10
);
1272 #ifdef HAVE_GFC_REAL_16
1273 extern void spread_scalar_r16 (gfc_array_r16
*, const GFC_REAL_16
*,
1274 const index_type
, const index_type
);
1275 internal_proto(spread_scalar_r16
);
1279 extern void spread_scalar_c4 (gfc_array_c4
*, const GFC_COMPLEX_4
*,
1280 const index_type
, const index_type
);
1281 internal_proto(spread_scalar_c4
);
1283 extern void spread_scalar_c8 (gfc_array_c8
*, const GFC_COMPLEX_8
*,
1284 const index_type
, const index_type
);
1285 internal_proto(spread_scalar_c8
);
1287 #ifdef HAVE_GFC_COMPLEX_10
1288 extern void spread_scalar_c10 (gfc_array_c10
*, const GFC_COMPLEX_10
*,
1289 const index_type
, const index_type
);
1290 internal_proto(spread_scalar_c10
);
1294 #ifdef HAVE_GFC_COMPLEX_16
1295 extern void spread_scalar_c16 (gfc_array_c16
*, const GFC_COMPLEX_16
*,
1296 const index_type
, const index_type
);
1297 internal_proto(spread_scalar_c16
);
1301 /* string_intrinsics.c */
1303 extern int compare_string (gfc_charlen_type
, const char *,
1304 gfc_charlen_type
, const char *);
1305 iexport_proto(compare_string
);
1307 extern int compare_string_char4 (gfc_charlen_type
, const gfc_char4_t
*,
1308 gfc_charlen_type
, const gfc_char4_t
*);
1309 iexport_proto(compare_string_char4
);
1311 extern int memcmp_char4 (const void *, const void *, size_t);
1312 internal_proto(memcmp_char4
);
1317 extern void random_seed_i4 (GFC_INTEGER_4
* size
, gfc_array_i4
* put
,
1318 gfc_array_i4
* get
);
1319 iexport_proto(random_seed_i4
);
1320 extern void random_seed_i8 (GFC_INTEGER_8
* size
, gfc_array_i8
* put
,
1321 gfc_array_i8
* get
);
1322 iexport_proto(random_seed_i8
);
1326 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS
, void) array_t
;
1328 extern index_type
size0 (const array_t
* array
);
1329 iexport_proto(size0
);
1333 extern void bounds_equal_extents (array_t
*, array_t
*, const char *,
1335 internal_proto(bounds_equal_extents
);
1337 extern void bounds_reduced_extents (array_t
*, array_t
*, int, const char *,
1338 const char *intrinsic
);
1339 internal_proto(bounds_reduced_extents
);
1341 extern void bounds_iforeach_return (array_t
*, array_t
*, const char *);
1342 internal_proto(bounds_iforeach_return
);
1344 extern void bounds_ifunction_return (array_t
*, const index_type
*,
1345 const char *, const char *);
1346 internal_proto(bounds_ifunction_return
);
1348 extern index_type
count_0 (const gfc_array_l1
*);
1350 internal_proto(count_0
);
1352 /* Internal auxiliary functions for cshift */
1354 void cshift0_i1 (gfc_array_i1
*, const gfc_array_i1
*, ptrdiff_t, int);
1355 internal_proto(cshift0_i1
);
1357 void cshift0_i2 (gfc_array_i2
*, const gfc_array_i2
*, ptrdiff_t, int);
1358 internal_proto(cshift0_i2
);
1360 void cshift0_i4 (gfc_array_i4
*, const gfc_array_i4
*, ptrdiff_t, int);
1361 internal_proto(cshift0_i4
);
1363 void cshift0_i8 (gfc_array_i8
*, const gfc_array_i8
*, ptrdiff_t, int);
1364 internal_proto(cshift0_i8
);
1366 #ifdef HAVE_GFC_INTEGER_16
1367 void cshift0_i16 (gfc_array_i16
*, const gfc_array_i16
*, ptrdiff_t, int);
1368 internal_proto(cshift0_i16
);
1371 void cshift0_r4 (gfc_array_r4
*, const gfc_array_r4
*, ptrdiff_t, int);
1372 internal_proto(cshift0_r4
);
1374 void cshift0_r8 (gfc_array_r8
*, const gfc_array_r8
*, ptrdiff_t, int);
1375 internal_proto(cshift0_r8
);
1377 #ifdef HAVE_GFC_REAL_10
1378 void cshift0_r10 (gfc_array_r10
*, const gfc_array_r10
*, ptrdiff_t, int);
1379 internal_proto(cshift0_r10
);
1382 #ifdef HAVE_GFC_REAL_16
1383 void cshift0_r16 (gfc_array_r16
*, const gfc_array_r16
*, ptrdiff_t, int);
1384 internal_proto(cshift0_r16
);
1387 void cshift0_c4 (gfc_array_c4
*, const gfc_array_c4
*, ptrdiff_t, int);
1388 internal_proto(cshift0_c4
);
1390 void cshift0_c8 (gfc_array_c8
*, const gfc_array_c8
*, ptrdiff_t, int);
1391 internal_proto(cshift0_c8
);
1393 #ifdef HAVE_GFC_COMPLEX_10
1394 void cshift0_c10 (gfc_array_c10
*, const gfc_array_c10
*, ptrdiff_t, int);
1395 internal_proto(cshift0_c10
);
1398 #ifdef HAVE_GFC_COMPLEX_16
1399 void cshift0_c16 (gfc_array_c16
*, const gfc_array_c16
*, ptrdiff_t, int);
1400 internal_proto(cshift0_c16
);
1403 #endif /* LIBGFOR_H */