1 /* Common declarations for all of libgfortran.
2 Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
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. */
35 /* config.h MUST be first because it can affect system headers. */
47 #define complex __complex__
50 #include "../gcc/fortran/libgfortran.h"
52 #include "c99_protos.h"
61 #include <sys/types.h>
63 typedef off_t gfc_offset;
66 #define NULL (void *) 0
70 #define __attribute__(x)
72 #define unlikely(x) (x)
74 #define likely(x) __builtin_expect(!!(x), 1)
75 #define unlikely(x) __builtin_expect(!!(x), 0)
79 /* We use intptr_t and uintptr_t, which may not be always defined in
83 #if __SIZEOF_POINTER__ == __SIZEOF_LONG__
85 #elif __SIZEOF_POINTER__ == __SIZEOF_LONG_LONG__
86 #define intptr_t long long
87 #elif __SIZEOF_POINTER__ == __SIZEOF_INT__
89 #elif __SIZEOF_POINTER__ == __SIZEOF_SHORT__
90 #define intptr_t short
92 #error "Pointer type with unexpected size"
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
106 #error "Pointer type with unexpected size"
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)));
118 #define snprintf __mingw_snprintf
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
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
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")))
173 # define internal_proto(x) sym_rename(x, IPREFIX(x))
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
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
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. */
205 #define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER)
208 /* The isfinite macro is only available with C99, but some non-C99
209 systems still provide fpclassify, and there is a `finite' function
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__)
221 #if defined(HAVE_BROKEN_ISNAN)
225 #if defined(HAVE_BROKEN_FPCLASSIFY)
229 #if !defined(isfinite)
230 #if !defined(fpclassify)
231 #define isfinite(x) ((x) - (x) == 0)
233 #define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE)
234 #endif /* !defined(fpclassify) */
235 #endif /* !defined(isfinite) */
238 #if !defined(fpclassify)
239 #define isnan(x) ((x) != (x))
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_);}
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;
257 #ifdef HAVE_GFC_INTEGER_4
258 typedef GFC_INTEGER_4 GFC_IO_INT;
260 #error "GFC_INTEGER_4 should be available for the library to compile".
264 /* The following two definitions must be consistent with the types used
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)
302 typedef struct descriptor_dimension
308 descriptor_dimension;
310 #define GFC_ARRAY_DESCRIPTOR(r, type) \
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;
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;
333 #ifdef HAVE_GFC_REAL_16
334 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16;
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;
341 #ifdef HAVE_GFC_COMPLEX_16
342 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16;
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;
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))
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))
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))
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))
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))
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))
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))
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))
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. */
460 int stdin_unit, stdout_unit, stderr_unit, optional_plus;
464 const char *separator;
466 int use_stderr, all_unbuffered, unbuffered_preconnected, default_recl;
467 int fpe, dump_core, backtrace;
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. */
489 size_t record_marker;
490 int max_subrecord_length;
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. */
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
518 { SILENT, WARNING, ERROR }
521 /* This is returned by notify_std and several io functions. */
523 { SUCCESS = 1, FAILURE }
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; \
555 typedef struct st_parameter_common
559 const char *filename;
562 GFC_INTEGER_4 *iostat;
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()
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);
625 extern void show_backtrace (void);
626 internal_proto(show_backtrace);
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_xtoa (GFC_UINTEGER_LARGEST, char *, size_t);
639 internal_proto(gfc_xtoa);
641 extern void os_error (const char *) __attribute__ ((noreturn));
642 iexport_proto(os_error);
644 extern void show_locus (st_parameter_common *);
645 internal_proto(show_locus);
647 extern void runtime_error (const char *, ...)
648 __attribute__ ((noreturn, format (printf, 1, 2)));
649 iexport_proto(runtime_error);
651 extern void runtime_error_at (const char *, const char *, ...)
652 __attribute__ ((noreturn, format (printf, 2, 3)));
653 iexport_proto(runtime_error_at);
655 extern void runtime_warning_at (const char *, const char *, ...)
656 __attribute__ ((format (printf, 2, 3)));
657 iexport_proto(runtime_warning_at);
659 extern void internal_error (st_parameter_common *, const char *)
660 __attribute__ ((noreturn));
661 internal_proto(internal_error);
663 extern const char *get_oserror (void);
664 internal_proto(get_oserror);
666 extern const char *translate_error (int);
667 internal_proto(translate_error);
669 extern void generate_error (st_parameter_common *, int, const char *);
670 iexport_proto(generate_error);
672 extern try notify_std (st_parameter_common *, int, const char *);
673 internal_proto(notify_std);
675 extern notification notification_std(int);
676 internal_proto(notification_std);
680 extern void set_fpu (void);
681 internal_proto(set_fpu);
685 extern void *get_mem (size_t) __attribute__ ((malloc));
686 internal_proto(get_mem);
688 extern void free_mem (void *);
689 internal_proto(free_mem);
691 extern void *internal_malloc_size (size_t) __attribute__ ((malloc));
692 internal_proto(internal_malloc_size);
696 extern int check_buffered (int);
697 internal_proto(check_buffered);
699 extern void init_variables (void);
700 internal_proto(init_variables);
702 extern void show_variables (void);
703 internal_proto(show_variables);
705 unit_convert get_unformatted_convert (int);
706 internal_proto(get_unformatted_convert);
710 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type,
711 const st_option *, const char *);
712 internal_proto(find_option);
714 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type);
715 internal_proto(fstrlen);
717 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type);
718 internal_proto(fstrcpy);
720 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *);
721 internal_proto(cf_strcpy);
723 /* io/intrinsics.c */
725 extern void flush_all_units (void);
726 internal_proto(flush_all_units);
730 extern void init_units (void);
731 internal_proto(init_units);
733 extern void close_units (void);
734 internal_proto(close_units);
736 extern int unit_to_fd (int);
737 internal_proto(unit_to_fd);
739 extern int st_printf (const char *, ...)
740 __attribute__ ((format (printf, 1, 2)));
741 internal_proto(st_printf);
743 extern int st_vprintf (const char *, va_list);
744 internal_proto(st_vprintf);
746 extern char * filename_from_unit (int);
747 internal_proto(filename_from_unit);
751 extern void stop_numeric (GFC_INTEGER_4) __attribute__ ((noreturn));
752 iexport_proto(stop_numeric);
754 /* reshape_packed.c */
756 extern void reshape_packed (char *, index_type, const char *, index_type,
757 const char *, index_type);
758 internal_proto(reshape_packed);
760 /* Repacking functions. These are called internally by internal_pack
761 and internal_unpack. */
763 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *);
764 internal_proto(internal_pack_1);
766 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *);
767 internal_proto(internal_pack_2);
769 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *);
770 internal_proto(internal_pack_4);
772 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *);
773 internal_proto(internal_pack_8);
775 #if defined HAVE_GFC_INTEGER_16
776 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *);
777 internal_proto(internal_pack_16);
780 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *);
781 internal_proto(internal_pack_r4);
783 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *);
784 internal_proto(internal_pack_r8);
786 #if defined HAVE_GFC_REAL_10
787 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *);
788 internal_proto(internal_pack_r10);
791 #if defined HAVE_GFC_REAL_16
792 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *);
793 internal_proto(internal_pack_r16);
796 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *);
797 internal_proto(internal_pack_c4);
799 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *);
800 internal_proto(internal_pack_c8);
802 #if defined HAVE_GFC_COMPLEX_10
803 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *);
804 internal_proto(internal_pack_c10);
807 #if defined HAVE_GFC_COMPLEX_16
808 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *);
809 internal_proto(internal_pack_c16);
812 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *);
813 internal_proto(internal_unpack_1);
815 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *);
816 internal_proto(internal_unpack_2);
818 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *);
819 internal_proto(internal_unpack_4);
821 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *);
822 internal_proto(internal_unpack_8);
824 #if defined HAVE_GFC_INTEGER_16
825 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *);
826 internal_proto(internal_unpack_16);
829 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *);
830 internal_proto(internal_unpack_r4);
832 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *);
833 internal_proto(internal_unpack_r8);
835 #if defined HAVE_GFC_REAL_10
836 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *);
837 internal_proto(internal_unpack_r10);
840 #if defined HAVE_GFC_REAL_16
841 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *);
842 internal_proto(internal_unpack_r16);
845 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *);
846 internal_proto(internal_unpack_c4);
848 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *);
849 internal_proto(internal_unpack_c8);
851 #if defined HAVE_GFC_COMPLEX_10
852 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *);
853 internal_proto(internal_unpack_c10);
856 #if defined HAVE_GFC_COMPLEX_16
857 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *);
858 internal_proto(internal_unpack_c16);
861 /* Internal auxiliary functions for the pack intrinsic. */
863 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *,
864 const gfc_array_l1 *, const gfc_array_i1 *);
865 internal_proto(pack_i1);
867 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *,
868 const gfc_array_l1 *, const gfc_array_i2 *);
869 internal_proto(pack_i2);
871 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *,
872 const gfc_array_l1 *, const gfc_array_i4 *);
873 internal_proto(pack_i4);
875 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *,
876 const gfc_array_l1 *, const gfc_array_i8 *);
877 internal_proto(pack_i8);
879 #ifdef HAVE_GFC_INTEGER_16
880 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *,
881 const gfc_array_l1 *, const gfc_array_i16 *);
882 internal_proto(pack_i16);
885 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *,
886 const gfc_array_l1 *, const gfc_array_r4 *);
887 internal_proto(pack_r4);
889 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *,
890 const gfc_array_l1 *, const gfc_array_r8 *);
891 internal_proto(pack_r8);
893 #ifdef HAVE_GFC_REAL_10
894 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *,
895 const gfc_array_l1 *, const gfc_array_r10 *);
896 internal_proto(pack_r10);
899 #ifdef HAVE_GFC_REAL_16
900 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *,
901 const gfc_array_l1 *, const gfc_array_r16 *);
902 internal_proto(pack_r16);
905 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *,
906 const gfc_array_l1 *, const gfc_array_c4 *);
907 internal_proto(pack_c4);
909 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *,
910 const gfc_array_l1 *, const gfc_array_c8 *);
911 internal_proto(pack_c8);
913 #ifdef HAVE_GFC_REAL_10
914 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *,
915 const gfc_array_l1 *, const gfc_array_c10 *);
916 internal_proto(pack_c10);
919 #ifdef HAVE_GFC_REAL_16
920 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *,
921 const gfc_array_l1 *, const gfc_array_c16 *);
922 internal_proto(pack_c16);
925 /* Internal auxiliary functions for the unpack intrinsic. */
927 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *,
928 const gfc_array_l1 *, const GFC_INTEGER_1 *);
929 internal_proto(unpack0_i1);
931 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *,
932 const gfc_array_l1 *, const GFC_INTEGER_2 *);
933 internal_proto(unpack0_i2);
935 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *,
936 const gfc_array_l1 *, const GFC_INTEGER_4 *);
937 internal_proto(unpack0_i4);
939 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *,
940 const gfc_array_l1 *, const GFC_INTEGER_8 *);
941 internal_proto(unpack0_i8);
943 #ifdef HAVE_GFC_INTEGER_16
945 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *,
946 const gfc_array_l1 *, const GFC_INTEGER_16 *);
947 internal_proto(unpack0_i16);
951 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *,
952 const gfc_array_l1 *, const GFC_REAL_4 *);
953 internal_proto(unpack0_r4);
955 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *,
956 const gfc_array_l1 *, const GFC_REAL_8 *);
957 internal_proto(unpack0_r8);
959 #ifdef HAVE_GFC_REAL_10
961 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *,
962 const gfc_array_l1 *, const GFC_REAL_10 *);
963 internal_proto(unpack0_r10);
967 #ifdef HAVE_GFC_REAL_16
969 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *,
970 const gfc_array_l1 *, const GFC_REAL_16 *);
971 internal_proto(unpack0_r16);
975 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *,
976 const gfc_array_l1 *, const GFC_COMPLEX_4 *);
977 internal_proto(unpack0_c4);
979 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *,
980 const gfc_array_l1 *, const GFC_COMPLEX_8 *);
981 internal_proto(unpack0_c8);
983 #ifdef HAVE_GFC_COMPLEX_10
985 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *,
986 const gfc_array_l1 *mask, const GFC_COMPLEX_10 *);
987 internal_proto(unpack0_c10);
991 #ifdef HAVE_GFC_COMPLEX_16
993 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *,
994 const gfc_array_l1 *, const GFC_COMPLEX_16 *);
995 internal_proto(unpack0_c16);
999 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1000 const gfc_array_l1 *, const gfc_array_i1 *);
1001 internal_proto(unpack1_i1);
1003 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1004 const gfc_array_l1 *, const gfc_array_i2 *);
1005 internal_proto(unpack1_i2);
1007 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1008 const gfc_array_l1 *, const gfc_array_i4 *);
1009 internal_proto(unpack1_i4);
1011 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1012 const gfc_array_l1 *, const gfc_array_i8 *);
1013 internal_proto(unpack1_i8);
1015 #ifdef HAVE_GFC_INTEGER_16
1016 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1017 const gfc_array_l1 *, const gfc_array_i16 *);
1018 internal_proto(unpack1_i16);
1021 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1022 const gfc_array_l1 *, const gfc_array_r4 *);
1023 internal_proto(unpack1_r4);
1025 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1026 const gfc_array_l1 *, const gfc_array_r8 *);
1027 internal_proto(unpack1_r8);
1029 #ifdef HAVE_GFC_REAL_10
1030 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1031 const gfc_array_l1 *, const gfc_array_r10 *);
1032 internal_proto(unpack1_r10);
1035 #ifdef HAVE_GFC_REAL_16
1036 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1037 const gfc_array_l1 *, const gfc_array_r16 *);
1038 internal_proto(unpack1_r16);
1041 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1042 const gfc_array_l1 *, const gfc_array_c4 *);
1043 internal_proto(unpack1_c4);
1045 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1046 const gfc_array_l1 *, const gfc_array_c8 *);
1047 internal_proto(unpack1_c8);
1049 #ifdef HAVE_GFC_COMPLEX_10
1050 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1051 const gfc_array_l1 *, const gfc_array_c10 *);
1052 internal_proto(unpack1_c10);
1055 #ifdef HAVE_GFC_COMPLEX_16
1056 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1057 const gfc_array_l1 *, const gfc_array_c16 *);
1058 internal_proto(unpack1_c16);
1061 /* Helper functions for spread. */
1063 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *,
1064 const index_type, const index_type);
1065 internal_proto(spread_i1);
1067 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *,
1068 const index_type, const index_type);
1069 internal_proto(spread_i2);
1071 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *,
1072 const index_type, const index_type);
1073 internal_proto(spread_i4);
1075 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *,
1076 const index_type, const index_type);
1077 internal_proto(spread_i8);
1079 #ifdef HAVE_GFC_INTEGER_16
1080 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *,
1081 const index_type, const index_type);
1082 internal_proto(spread_i16);
1086 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *,
1087 const index_type, const index_type);
1088 internal_proto(spread_r4);
1090 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *,
1091 const index_type, const index_type);
1092 internal_proto(spread_r8);
1094 #ifdef HAVE_GFC_REAL_10
1095 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *,
1096 const index_type, const index_type);
1097 internal_proto(spread_r10);
1101 #ifdef HAVE_GFC_REAL_16
1102 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *,
1103 const index_type, const index_type);
1104 internal_proto(spread_r16);
1108 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *,
1109 const index_type, const index_type);
1110 internal_proto(spread_c4);
1112 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *,
1113 const index_type, const index_type);
1114 internal_proto(spread_c8);
1116 #ifdef HAVE_GFC_COMPLEX_10
1117 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *,
1118 const index_type, const index_type);
1119 internal_proto(spread_c10);
1123 #ifdef HAVE_GFC_COMPLEX_16
1124 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *,
1125 const index_type, const index_type);
1126 internal_proto(spread_c16);
1130 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *,
1131 const index_type, const index_type);
1132 internal_proto(spread_scalar_i1);
1134 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *,
1135 const index_type, const index_type);
1136 internal_proto(spread_scalar_i2);
1138 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *,
1139 const index_type, const index_type);
1140 internal_proto(spread_scalar_i4);
1142 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *,
1143 const index_type, const index_type);
1144 internal_proto(spread_scalar_i8);
1146 #ifdef HAVE_GFC_INTEGER_16
1147 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *,
1148 const index_type, const index_type);
1149 internal_proto(spread_scalar_i16);
1153 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *,
1154 const index_type, const index_type);
1155 internal_proto(spread_scalar_r4);
1157 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *,
1158 const index_type, const index_type);
1159 internal_proto(spread_scalar_r8);
1161 #ifdef HAVE_GFC_REAL_10
1162 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *,
1163 const index_type, const index_type);
1164 internal_proto(spread_scalar_r10);
1168 #ifdef HAVE_GFC_REAL_16
1169 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *,
1170 const index_type, const index_type);
1171 internal_proto(spread_scalar_r16);
1175 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *,
1176 const index_type, const index_type);
1177 internal_proto(spread_scalar_c4);
1179 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *,
1180 const index_type, const index_type);
1181 internal_proto(spread_scalar_c8);
1183 #ifdef HAVE_GFC_COMPLEX_10
1184 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *,
1185 const index_type, const index_type);
1186 internal_proto(spread_scalar_c10);
1190 #ifdef HAVE_GFC_COMPLEX_16
1191 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *,
1192 const index_type, const index_type);
1193 internal_proto(spread_scalar_c16);
1197 /* string_intrinsics.c */
1199 extern int compare_string (gfc_charlen_type, const char *,
1200 gfc_charlen_type, const char *);
1201 iexport_proto(compare_string);
1203 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *,
1204 gfc_charlen_type, const gfc_char4_t *);
1205 iexport_proto(compare_string_char4);
1209 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put,
1210 gfc_array_i4 * get);
1211 iexport_proto(random_seed_i4);
1212 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put,
1213 gfc_array_i8 * get);
1214 iexport_proto(random_seed_i8);
1218 typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t;
1220 extern index_type size0 (const array_t * array);
1221 iexport_proto(size0);
1223 /* Internal auxiliary functions for cshift */
1225 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
1226 internal_proto(cshift0_i1);
1228 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ssize_t, int);
1229 internal_proto(cshift0_i2);
1231 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ssize_t, int);
1232 internal_proto(cshift0_i4);
1234 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ssize_t, int);
1235 internal_proto(cshift0_i8);
1237 #ifdef HAVE_GFC_INTEGER_16
1238 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ssize_t, int);
1239 internal_proto(cshift0_i16);
1242 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ssize_t, int);
1243 internal_proto(cshift0_r4);
1245 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ssize_t, int);
1246 internal_proto(cshift0_r8);
1248 #ifdef HAVE_GFC_REAL_10
1249 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ssize_t, int);
1250 internal_proto(cshift0_r10);
1253 #ifdef HAVE_GFC_REAL_16
1254 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ssize_t, int);
1255 internal_proto(cshift0_r16);
1258 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ssize_t, int);
1259 internal_proto(cshift0_c4);
1261 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ssize_t, int);
1262 internal_proto(cshift0_c8);
1264 #ifdef HAVE_GFC_COMPLEX_10
1265 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ssize_t, int);
1266 internal_proto(cshift0_c10);
1269 #ifdef HAVE_GFC_COMPLEX_16
1270 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ssize_t, int);
1271 internal_proto(cshift0_c16);
1274 #endif /* LIBGFOR_H */