1760c2415Smrg /* Common declarations for all of libgfortran. 2*0bfacb9bSmrg Copyright (C) 2002-2020 Free Software Foundation, Inc. 3760c2415Smrg Contributed by Paul Brook <paul@nowt.org>, and 4760c2415Smrg Andy Vaught <andy@xena.eas.asu.edu> 5760c2415Smrg 6760c2415Smrg This file is part of the GNU Fortran runtime library (libgfortran). 7760c2415Smrg 8760c2415Smrg Libgfortran is free software; you can redistribute it and/or modify 9760c2415Smrg it under the terms of the GNU General Public License as published by 10760c2415Smrg the Free Software Foundation; either version 3, or (at your option) 11760c2415Smrg any later version. 12760c2415Smrg 13760c2415Smrg Libgfortran is distributed in the hope that it will be useful, 14760c2415Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of 15760c2415Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16760c2415Smrg GNU General Public License for more details. 17760c2415Smrg 18760c2415Smrg Under Section 7 of GPL version 3, you are granted additional 19760c2415Smrg permissions described in the GCC Runtime Library Exception, version 20760c2415Smrg 3.1, as published by the Free Software Foundation. 21760c2415Smrg 22760c2415Smrg You should have received a copy of the GNU General Public License and 23760c2415Smrg a copy of the GCC Runtime Library Exception along with this program; 24760c2415Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 25760c2415Smrg <http://www.gnu.org/licenses/>. */ 26760c2415Smrg 27760c2415Smrg #ifndef LIBGFOR_H 28760c2415Smrg #define LIBGFOR_H 29760c2415Smrg 30760c2415Smrg /* Ensure that ANSI conform stdio is used. This needs to be set before 31760c2415Smrg any system header file is included. */ 32760c2415Smrg #if defined __MINGW32__ 33760c2415Smrg # define _POSIX 1 34760c2415Smrg # define gfc_printf gnu_printf 35760c2415Smrg #else 36760c2415Smrg # define gfc_printf __printf__ 37760c2415Smrg #endif 38760c2415Smrg 39760c2415Smrg /* config.h MUST be first because it can affect system headers. */ 40760c2415Smrg #include "config.h" 41760c2415Smrg 42760c2415Smrg #include <stdio.h> 43760c2415Smrg #include <stdlib.h> 44760c2415Smrg #include <stddef.h> 45760c2415Smrg #include <float.h> 46760c2415Smrg #include <stdarg.h> 47760c2415Smrg #include <stdbool.h> 48760c2415Smrg 49760c2415Smrg #if HAVE_COMPLEX_H 50760c2415Smrg /* Must appear before math.h on VMS systems. */ 51760c2415Smrg # include <complex.h> 52760c2415Smrg #else 53760c2415Smrg #define complex __complex__ 54760c2415Smrg #endif 55760c2415Smrg 56760c2415Smrg #include <math.h> 57760c2415Smrg 58760c2415Smrg /* If we're support quad-precision floating-point type, include the 59760c2415Smrg header to our support library. */ 60760c2415Smrg #ifdef HAVE_FLOAT128 61760c2415Smrg # include "quadmath_weak.h" 62760c2415Smrg #endif 63760c2415Smrg 64760c2415Smrg #ifdef __MINGW32__ 65760c2415Smrg extern float __strtof (const char *, char **); 66760c2415Smrg #define gfc_strtof __strtof 67760c2415Smrg extern double __strtod (const char *, char **); 68760c2415Smrg #define gfc_strtod __strtod 69760c2415Smrg extern long double __strtold (const char *, char **); 70760c2415Smrg #define gfc_strtold __strtold 71760c2415Smrg #else 72760c2415Smrg #define gfc_strtof strtof 73760c2415Smrg #define gfc_strtod strtod 74760c2415Smrg #define gfc_strtold strtold 75760c2415Smrg #endif 76760c2415Smrg 77760c2415Smrg #include "../gcc/fortran/libgfortran.h" 78760c2415Smrg 79760c2415Smrg #include "c99_protos.h" 80760c2415Smrg 81760c2415Smrg #if HAVE_IEEEFP_H 82760c2415Smrg #include <ieeefp.h> 83760c2415Smrg #endif 84760c2415Smrg 85760c2415Smrg #include "gstdint.h" 86760c2415Smrg 87760c2415Smrg #if HAVE_SYS_TYPES_H 88760c2415Smrg #include <sys/types.h> 89760c2415Smrg #endif 90760c2415Smrg 91760c2415Smrg #ifdef HAVE_SYS_UIO_H 92760c2415Smrg #include <sys/uio.h> 93760c2415Smrg #endif 94760c2415Smrg 95760c2415Smrg #ifdef __MINGW32__ 96760c2415Smrg typedef off64_t gfc_offset; 97760c2415Smrg #else 98760c2415Smrg typedef off_t gfc_offset; 99760c2415Smrg #endif 100760c2415Smrg 101760c2415Smrg #ifndef NULL 102760c2415Smrg #define NULL (void *) 0 103760c2415Smrg #endif 104760c2415Smrg 105760c2415Smrg 106760c2415Smrg /* The following macros can be used to annotate conditions which are likely or 107760c2415Smrg unlikely to be true. Avoid using them when a condition is only slightly 108760c2415Smrg more likely/less unlikely than average to avoid the performance penalties of 109760c2415Smrg branch misprediction. In addition, as __builtin_expect overrides the compiler 110760c2415Smrg heuristic, do not use in conditions where one of the branches ends with a 111760c2415Smrg call to a function with __attribute__((noreturn)): the compiler internal 112760c2415Smrg heuristic will mark this branch as much less likely as unlikely() would 113760c2415Smrg do. */ 114760c2415Smrg 115760c2415Smrg #define likely(x) __builtin_expect(!!(x), 1) 116760c2415Smrg #define unlikely(x) __builtin_expect(!!(x), 0) 117760c2415Smrg 118760c2415Smrg /* This macro can be used to annotate conditions which we know to 119760c2415Smrg be true, so that the compiler can optimize based on the condition. */ 120760c2415Smrg 121760c2415Smrg #define GFC_ASSERT(EXPR) \ 122760c2415Smrg ((void)(__builtin_expect (!(EXPR), 0) ? __builtin_unreachable (), 0 : 0)) 123760c2415Smrg 124760c2415Smrg /* Make sure we have ptrdiff_t. */ 125760c2415Smrg #ifndef HAVE_PTRDIFF_T 126760c2415Smrg typedef intptr_t ptrdiff_t; 127760c2415Smrg #endif 128760c2415Smrg 129760c2415Smrg /* On mingw, work around the buggy Windows snprintf() by using the one 130760c2415Smrg mingw provides, __mingw_snprintf(). We also provide a prototype for 131760c2415Smrg __mingw_snprintf(), because the mingw headers currently don't have one. */ 132760c2415Smrg #if HAVE_MINGW_SNPRINTF 133760c2415Smrg extern int __mingw_snprintf (char *, size_t, const char *, ...) 134760c2415Smrg __attribute__ ((format (gnu_printf, 3, 4))); 135760c2415Smrg #undef snprintf 136760c2415Smrg #define snprintf __mingw_snprintf 137760c2415Smrg /* Fallback to sprintf if target does not have snprintf. */ 138760c2415Smrg #elif !defined(HAVE_SNPRINTF) 139760c2415Smrg #undef snprintf 140760c2415Smrg #define snprintf(str, size, ...) sprintf (str, __VA_ARGS__) 141760c2415Smrg #endif 142760c2415Smrg 143760c2415Smrg 144760c2415Smrg /* For a library, a standard prefix is a requirement in order to partition 145760c2415Smrg the namespace. IPREFIX is for symbols intended to be internal to the 146760c2415Smrg library. */ 147760c2415Smrg #define PREFIX(x) _gfortran_ ## x 148760c2415Smrg #define IPREFIX(x) _gfortrani_ ## x 149760c2415Smrg 150760c2415Smrg /* Magic to rename a symbol at the compiler level. You continue to refer 151760c2415Smrg to the symbol as OLD in the source, but it'll be named NEW in the asm. */ 152760c2415Smrg #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new) 153760c2415Smrg #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new) 154760c2415Smrg #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new) 155760c2415Smrg 156760c2415Smrg /* There are several classifications of routines: 157760c2415Smrg 158760c2415Smrg (1) Symbols used only within the library, 159760c2415Smrg (2) Symbols to be exported from the library, 160760c2415Smrg (3) Symbols to be exported from the library, but 161760c2415Smrg also used inside the library. 162760c2415Smrg 163760c2415Smrg By telling the compiler about these different classifications we can 164760c2415Smrg tightly control the interface seen by the user, and get better code 165760c2415Smrg from the compiler at the same time. 166760c2415Smrg 167760c2415Smrg One of the following should be used immediately after the declaration 168760c2415Smrg of each symbol: 169760c2415Smrg 170760c2415Smrg internal_proto Marks a symbol used only within the library, 171760c2415Smrg and adds IPREFIX to the assembly-level symbol 172760c2415Smrg name. The later is important for maintaining 173760c2415Smrg the namespace partition for the static library. 174760c2415Smrg 175760c2415Smrg export_proto Marks a symbol to be exported, and adds PREFIX 176760c2415Smrg to the assembly-level symbol name. 177760c2415Smrg 178760c2415Smrg export_proto_np Marks a symbol to be exported without adding PREFIX. 179760c2415Smrg 180760c2415Smrg iexport_proto Marks a function to be exported, but with the 181760c2415Smrg understanding that it can be used inside as well. 182760c2415Smrg 183760c2415Smrg iexport_data_proto Similarly, marks a data symbol to be exported. 184760c2415Smrg Unfortunately, some systems can't play the hidden 185760c2415Smrg symbol renaming trick on data symbols, thanks to 186760c2415Smrg the horribleness of COPY relocations. 187760c2415Smrg 188760c2415Smrg If iexport_proto or iexport_data_proto is used, you must also use 189760c2415Smrg iexport or iexport_data after the *definition* of the symbol. */ 190760c2415Smrg 191760c2415Smrg #if defined(HAVE_ATTRIBUTE_VISIBILITY) 192760c2415Smrg # define internal_proto(x) \ 193760c2415Smrg sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden"))) 194760c2415Smrg #else 195760c2415Smrg # define internal_proto(x) sym_rename(x, IPREFIX(x)) 196760c2415Smrg #endif 197760c2415Smrg 198760c2415Smrg #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS) 199760c2415Smrg # define export_proto(x) sym_rename(x, PREFIX(x)) 200760c2415Smrg # define export_proto_np(x) extern char swallow_semicolon 201760c2415Smrg # define iexport_proto(x) internal_proto(x) 202760c2415Smrg # define iexport(x) iexport1(x, IPREFIX(x)) 203760c2415Smrg # define iexport1(x,y) iexport2(x,y) 204760c2415Smrg # define iexport2(x,y) \ 205760c2415Smrg extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y), __copy__ (x))) 206760c2415Smrg #else 207760c2415Smrg # define export_proto(x) sym_rename(x, PREFIX(x)) 208760c2415Smrg # define export_proto_np(x) extern char swallow_semicolon 209760c2415Smrg # define iexport_proto(x) export_proto(x) 210760c2415Smrg # define iexport(x) extern char swallow_semicolon 211760c2415Smrg #endif 212760c2415Smrg 213760c2415Smrg /* TODO: detect the case when we *can* hide the symbol. */ 214760c2415Smrg #define iexport_data_proto(x) export_proto(x) 215760c2415Smrg #define iexport_data(x) extern char swallow_semicolon 216760c2415Smrg 217760c2415Smrg /* The only reliable way to get the offset of a field in a struct 218760c2415Smrg in a system independent way is via this macro. */ 219760c2415Smrg #ifndef offsetof 220760c2415Smrg #define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER) 221760c2415Smrg #endif 222760c2415Smrg 223760c2415Smrg /* The C99 classification macros isfinite, isinf, isnan, isnormal 224760c2415Smrg and signbit are broken or inconsistent on quite a few targets. 225760c2415Smrg So, we use GCC's builtins instead. 226760c2415Smrg 227760c2415Smrg Another advantage for GCC's builtins for these type-generic macros 228760c2415Smrg is that it handles floating-point types that the system headers 229760c2415Smrg may not support (like __float128). */ 230760c2415Smrg 231760c2415Smrg #undef isnan 232760c2415Smrg #define isnan(x) __builtin_isnan(x) 233760c2415Smrg #undef isfinite 234760c2415Smrg #define isfinite(x) __builtin_isfinite(x) 235760c2415Smrg #undef isinf 236760c2415Smrg #define isinf(x) __builtin_isinf(x) 237760c2415Smrg #undef isnormal 238760c2415Smrg #define isnormal(x) __builtin_isnormal(x) 239760c2415Smrg #undef signbit 240760c2415Smrg #define signbit(x) __builtin_signbit(x) 241760c2415Smrg 242760c2415Smrg #include "kinds.h" 243760c2415Smrg 244760c2415Smrg /* Define the type used for the current record number for large file I/O. 245760c2415Smrg The size must be consistent with the size defined on the compiler side. */ 246760c2415Smrg #ifdef HAVE_GFC_INTEGER_8 247760c2415Smrg typedef GFC_INTEGER_8 GFC_IO_INT; 248760c2415Smrg #else 249760c2415Smrg #ifdef HAVE_GFC_INTEGER_4 250760c2415Smrg typedef GFC_INTEGER_4 GFC_IO_INT; 251760c2415Smrg #else 252760c2415Smrg #error "GFC_INTEGER_4 should be available for the library to compile". 253760c2415Smrg #endif 254760c2415Smrg #endif 255760c2415Smrg 256760c2415Smrg /* The following two definitions must be consistent with the types used 257760c2415Smrg by the compiler. */ 258760c2415Smrg /* The type used of array indices, amongst other things. */ 259760c2415Smrg typedef ptrdiff_t index_type; 260760c2415Smrg 261760c2415Smrg /* The type used for the lengths of character variables. */ 262760c2415Smrg typedef size_t gfc_charlen_type; 263760c2415Smrg 264760c2415Smrg /* Definitions of CHARACTER data types: 265760c2415Smrg - CHARACTER(KIND=1) corresponds to the C char type, 266760c2415Smrg - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */ 267760c2415Smrg typedef GFC_UINTEGER_4 gfc_char4_t; 268760c2415Smrg 269760c2415Smrg /* Byte size of character kinds. For the kinds currently supported, it's 270760c2415Smrg simply equal to the kind parameter itself. */ 271760c2415Smrg #define GFC_SIZE_OF_CHAR_KIND(kind) (kind) 272760c2415Smrg 273760c2415Smrg #define GFOR_POINTER_TO_L1(p, kind) \ 274760c2415Smrg ((__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? 1: 0) * (kind - 1) + (GFC_LOGICAL_1 *)(p)) 275760c2415Smrg 276760c2415Smrg #define GFC_INTEGER_1_HUGE \ 277760c2415Smrg (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1) 278760c2415Smrg #define GFC_INTEGER_2_HUGE \ 279760c2415Smrg (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1) 280760c2415Smrg #define GFC_INTEGER_4_HUGE \ 281760c2415Smrg (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1) 282760c2415Smrg #define GFC_INTEGER_8_HUGE \ 283760c2415Smrg (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1) 284760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 285760c2415Smrg #define GFC_INTEGER_16_HUGE \ 286760c2415Smrg (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1) 287760c2415Smrg #endif 288760c2415Smrg 289760c2415Smrg /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported. */ 290760c2415Smrg 291760c2415Smrg #ifdef __FLT_HAS_INFINITY__ 292760c2415Smrg # define GFC_REAL_4_INFINITY __builtin_inff () 293760c2415Smrg #endif 294760c2415Smrg #ifdef __DBL_HAS_INFINITY__ 295760c2415Smrg # define GFC_REAL_8_INFINITY __builtin_inf () 296760c2415Smrg #endif 297760c2415Smrg #ifdef __LDBL_HAS_INFINITY__ 298760c2415Smrg # ifdef HAVE_GFC_REAL_10 299760c2415Smrg # define GFC_REAL_10_INFINITY __builtin_infl () 300760c2415Smrg # endif 301760c2415Smrg # ifdef HAVE_GFC_REAL_16 302760c2415Smrg # ifdef GFC_REAL_16_IS_LONG_DOUBLE 303760c2415Smrg # define GFC_REAL_16_INFINITY __builtin_infl () 304760c2415Smrg # else 305760c2415Smrg # define GFC_REAL_16_INFINITY __builtin_infq () 306760c2415Smrg # endif 307760c2415Smrg # endif 308760c2415Smrg #endif 309760c2415Smrg #ifdef __FLT_HAS_QUIET_NAN__ 310760c2415Smrg # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("") 311760c2415Smrg #endif 312760c2415Smrg #ifdef __DBL_HAS_QUIET_NAN__ 313760c2415Smrg # define GFC_REAL_8_QUIET_NAN __builtin_nan ("") 314760c2415Smrg #endif 315760c2415Smrg #ifdef __LDBL_HAS_QUIET_NAN__ 316760c2415Smrg # ifdef HAVE_GFC_REAL_10 317760c2415Smrg # define GFC_REAL_10_QUIET_NAN __builtin_nanl ("") 318760c2415Smrg # endif 319760c2415Smrg # ifdef HAVE_GFC_REAL_16 320760c2415Smrg # ifdef GFC_REAL_16_IS_LONG_DOUBLE 321760c2415Smrg # define GFC_REAL_16_QUIET_NAN __builtin_nanl ("") 322760c2415Smrg # else 323760c2415Smrg # define GFC_REAL_16_QUIET_NAN nanq ("") 324760c2415Smrg # endif 325760c2415Smrg # endif 326760c2415Smrg #endif 327760c2415Smrg 328760c2415Smrg typedef struct descriptor_dimension 329760c2415Smrg { 330760c2415Smrg index_type _stride; 331760c2415Smrg index_type lower_bound; 332760c2415Smrg index_type _ubound; 333760c2415Smrg } 334760c2415Smrg descriptor_dimension; 335760c2415Smrg 336760c2415Smrg typedef struct dtype_type 337760c2415Smrg { 338760c2415Smrg size_t elem_len; 339760c2415Smrg int version; 340760c2415Smrg signed char rank; 341760c2415Smrg signed char type; 342760c2415Smrg signed short attribute; 343760c2415Smrg } 344760c2415Smrg dtype_type; 345760c2415Smrg 346760c2415Smrg #define GFC_ARRAY_DESCRIPTOR(type) \ 347760c2415Smrg struct {\ 348760c2415Smrg type *base_addr;\ 349760c2415Smrg size_t offset;\ 350760c2415Smrg dtype_type dtype;\ 351760c2415Smrg index_type span;\ 352760c2415Smrg descriptor_dimension dim[];\ 353760c2415Smrg } 354760c2415Smrg 355760c2415Smrg /* Commonly used array descriptor types. */ 356760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (void) gfc_array_void; 357760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (char) gfc_array_char; 358760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_1) gfc_array_i1; 359760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_2) gfc_array_i2; 360760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_4) gfc_array_i4; 361760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_8) gfc_array_i8; 362760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (index_type) gfc_array_index_type; 363760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 364760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_16) gfc_array_i16; 365760c2415Smrg #endif 366760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_4) gfc_array_r4; 367760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_8) gfc_array_r8; 368760c2415Smrg #ifdef HAVE_GFC_REAL_10 369760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_10) gfc_array_r10; 370760c2415Smrg #endif 371760c2415Smrg #ifdef HAVE_GFC_REAL_16 372760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_16) gfc_array_r16; 373760c2415Smrg #endif 374760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_4) gfc_array_c4; 375760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_8) gfc_array_c8; 376760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 377760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_10) gfc_array_c10; 378760c2415Smrg #endif 379760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 380760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_16) gfc_array_c16; 381760c2415Smrg #endif 382760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_1) gfc_array_l1; 383760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_2) gfc_array_l2; 384760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_4) gfc_array_l4; 385760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_8) gfc_array_l8; 386760c2415Smrg #ifdef HAVE_GFC_LOGICAL_16 387760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_16) gfc_array_l16; 388760c2415Smrg #endif 389760c2415Smrg 390760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_1) gfc_array_s1; 391760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_4) gfc_array_s4; 392760c2415Smrg 393760c2415Smrg /* These are for when you actually want to declare a descriptor, as 394760c2415Smrg opposed to a pointer to it. */ 395760c2415Smrg 396760c2415Smrg #define GFC_FULL_ARRAY_DESCRIPTOR(r, type) \ 397760c2415Smrg struct {\ 398760c2415Smrg type *base_addr;\ 399760c2415Smrg size_t offset;\ 400760c2415Smrg dtype_type dtype;\ 401760c2415Smrg index_type span;\ 402760c2415Smrg descriptor_dimension dim[r];\ 403760c2415Smrg } 404760c2415Smrg 405760c2415Smrg typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_array_i4; 406760c2415Smrg 407760c2415Smrg #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank) 408760c2415Smrg #define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type) 409760c2415Smrg #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len) 410760c2415Smrg #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr) 411760c2415Smrg #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) 412760c2415Smrg 413760c2415Smrg #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound) 414760c2415Smrg #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound) 415760c2415Smrg #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride) 416760c2415Smrg #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound) 417760c2415Smrg #define GFC_DIMENSION_SET(dim,lb,ub,str) \ 418760c2415Smrg do \ 419760c2415Smrg { \ 420760c2415Smrg (dim).lower_bound = lb; \ 421760c2415Smrg (dim)._ubound = ub; \ 422760c2415Smrg (dim)._stride = str; \ 423760c2415Smrg } while (0) 424760c2415Smrg 425760c2415Smrg 426760c2415Smrg #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound) 427760c2415Smrg #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound) 428760c2415Smrg #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \ 429760c2415Smrg - (desc)->dim[i].lower_bound) 430760c2415Smrg #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ 431760c2415Smrg (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) 432760c2415Smrg 433760c2415Smrg #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) 434760c2415Smrg #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ 435760c2415Smrg (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) 436760c2415Smrg 437760c2415Smrg /* Macros to get both the size and the type with a single masking operation */ 438760c2415Smrg 439760c2415Smrg #define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT)) 440760c2415Smrg #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK) 441760c2415Smrg 442760c2415Smrg #define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \ 443760c2415Smrg | ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK) 444760c2415Smrg 445760c2415Smrg /* Macros to set size and type information. */ 446760c2415Smrg 447760c2415Smrg #define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0) 448760c2415Smrg #define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0)) 449760c2415Smrg #define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \ 450760c2415Smrg (a)->dtype.version = 0; \ 451760c2415Smrg (a)->dtype.rank = 0; \ 452760c2415Smrg (a)->dtype.type = 0; \ 453760c2415Smrg (a)->dtype.attribute = 0; \ 454760c2415Smrg } while(0) 455760c2415Smrg 456760c2415Smrg #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 457760c2415Smrg | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) 458760c2415Smrg #define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 459760c2415Smrg | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) 460760c2415Smrg #define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 461760c2415Smrg | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) 462760c2415Smrg #define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 463760c2415Smrg | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) 464760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 465760c2415Smrg #define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 466760c2415Smrg | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) 467760c2415Smrg #endif 468760c2415Smrg 469760c2415Smrg #define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 470760c2415Smrg | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT)) 471760c2415Smrg #define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 472760c2415Smrg | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT)) 473760c2415Smrg #define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 474760c2415Smrg | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT)) 475760c2415Smrg #define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 476760c2415Smrg | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT)) 477760c2415Smrg #ifdef HAVE_GFC_LOGICAL_16 478760c2415Smrg #define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 479760c2415Smrg | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) 480760c2415Smrg #endif 481760c2415Smrg 482760c2415Smrg #define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 483760c2415Smrg | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT)) 484760c2415Smrg #define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 485760c2415Smrg | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT)) 486760c2415Smrg #ifdef HAVE_GFC_REAL_10 487760c2415Smrg #define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 488760c2415Smrg | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT)) 489760c2415Smrg #endif 490760c2415Smrg #ifdef HAVE_GFC_REAL_16 491760c2415Smrg #define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 492760c2415Smrg | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) 493760c2415Smrg #endif 494760c2415Smrg 495760c2415Smrg #define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 496760c2415Smrg | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT)) 497760c2415Smrg #define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 498760c2415Smrg | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT)) 499760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 500760c2415Smrg #define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 501760c2415Smrg | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT)) 502760c2415Smrg #endif 503760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 504760c2415Smrg #define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 505760c2415Smrg | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) 506760c2415Smrg #endif 507760c2415Smrg 508760c2415Smrg /* Macros to determine the alignment of pointers. */ 509760c2415Smrg 510760c2415Smrg #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \ 511760c2415Smrg (__alignof__(GFC_INTEGER_2) - 1)) 512760c2415Smrg #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \ 513760c2415Smrg (__alignof__(GFC_INTEGER_4) - 1)) 514760c2415Smrg #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \ 515760c2415Smrg (__alignof__(GFC_INTEGER_8) - 1)) 516760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 517760c2415Smrg #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \ 518760c2415Smrg (__alignof__(GFC_INTEGER_16) - 1)) 519760c2415Smrg #endif 520760c2415Smrg 521760c2415Smrg #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \ 522760c2415Smrg (__alignof__(GFC_COMPLEX_4) - 1)) 523760c2415Smrg 524760c2415Smrg #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \ 525760c2415Smrg (__alignof__(GFC_COMPLEX_8) - 1)) 526760c2415Smrg 527760c2415Smrg /* Runtime library include. */ 528760c2415Smrg #define stringize(x) expand_macro(x) 529760c2415Smrg #define expand_macro(x) # x 530760c2415Smrg 531760c2415Smrg /* Runtime options structure. */ 532760c2415Smrg 533760c2415Smrg typedef struct 534760c2415Smrg { 535760c2415Smrg int stdin_unit, stdout_unit, stderr_unit, optional_plus; 536760c2415Smrg int locus; 537760c2415Smrg 538760c2415Smrg int separator_len; 539760c2415Smrg const char *separator; 540760c2415Smrg 541760c2415Smrg int all_unbuffered, unbuffered_preconnected; 542760c2415Smrg int fpe, backtrace; 543760c2415Smrg int unformatted_buffer_size, formatted_buffer_size; 544760c2415Smrg } 545760c2415Smrg options_t; 546760c2415Smrg 547760c2415Smrg extern options_t options; 548760c2415Smrg internal_proto(options); 549760c2415Smrg 550760c2415Smrg extern void backtrace_handler (int); 551760c2415Smrg internal_proto(backtrace_handler); 552760c2415Smrg 553760c2415Smrg 554760c2415Smrg /* Compile-time options that will influence the library. */ 555760c2415Smrg 556760c2415Smrg typedef struct 557760c2415Smrg { 558760c2415Smrg int warn_std; 559760c2415Smrg int allow_std; 560760c2415Smrg int pedantic; 561760c2415Smrg int convert; 562760c2415Smrg int backtrace; 563760c2415Smrg int sign_zero; 564760c2415Smrg size_t record_marker; 565760c2415Smrg int max_subrecord_length; 566760c2415Smrg int bounds_check; 567760c2415Smrg int fpe_summary; 568760c2415Smrg } 569760c2415Smrg compile_options_t; 570760c2415Smrg 571760c2415Smrg extern compile_options_t compile_options; 572760c2415Smrg internal_proto(compile_options); 573760c2415Smrg 574760c2415Smrg extern void init_compile_options (void); 575760c2415Smrg internal_proto(init_compile_options); 576760c2415Smrg 577760c2415Smrg #define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */ 578760c2415Smrg 579760c2415Smrg /* Structure for statement options. */ 580760c2415Smrg 581760c2415Smrg typedef struct 582760c2415Smrg { 583760c2415Smrg const char *name; 584760c2415Smrg int value; 585760c2415Smrg } 586760c2415Smrg st_option; 587760c2415Smrg 588760c2415Smrg 589760c2415Smrg /* This is returned by notification_std to know if, given the flags 590760c2415Smrg that were given (-std=, -pedantic) we should issue an error, a warning 591760c2415Smrg or nothing. */ 592760c2415Smrg typedef enum 593760c2415Smrg { NOTIFICATION_SILENT, NOTIFICATION_WARNING, NOTIFICATION_ERROR } 594760c2415Smrg notification; 595760c2415Smrg 596760c2415Smrg 597760c2415Smrg /* The filename and line number don't go inside the globals structure. 598760c2415Smrg They are set by the rest of the program and must be linked to. */ 599760c2415Smrg 600760c2415Smrg /* Location of the current library call (optional). */ 601760c2415Smrg extern unsigned line; 602760c2415Smrg iexport_data_proto(line); 603760c2415Smrg 604760c2415Smrg extern char *filename; 605760c2415Smrg iexport_data_proto(filename); 606760c2415Smrg 607760c2415Smrg 608760c2415Smrg #define CHARACTER2(name) \ 609760c2415Smrg gfc_charlen_type name ## _len; \ 610760c2415Smrg char * name 611760c2415Smrg 612760c2415Smrg typedef struct st_parameter_common 613760c2415Smrg { 614760c2415Smrg GFC_INTEGER_4 flags; 615760c2415Smrg GFC_INTEGER_4 unit; 616760c2415Smrg const char *filename; 617760c2415Smrg GFC_INTEGER_4 line; 618760c2415Smrg CHARACTER2 (iomsg); 619760c2415Smrg GFC_INTEGER_4 *iostat; 620760c2415Smrg } 621760c2415Smrg st_parameter_common; 622760c2415Smrg 623760c2415Smrg #undef CHARACTER2 624760c2415Smrg 625760c2415Smrg #define IOPARM_LIBRETURN_MASK (3 << 0) 626760c2415Smrg #define IOPARM_LIBRETURN_OK (0 << 0) 627760c2415Smrg #define IOPARM_LIBRETURN_ERROR (1 << 0) 628760c2415Smrg #define IOPARM_LIBRETURN_END (2 << 0) 629760c2415Smrg #define IOPARM_LIBRETURN_EOR (3 << 0) 630760c2415Smrg #define IOPARM_ERR (1 << 2) 631760c2415Smrg #define IOPARM_END (1 << 3) 632760c2415Smrg #define IOPARM_EOR (1 << 4) 633760c2415Smrg #define IOPARM_HAS_IOSTAT (1 << 5) 634760c2415Smrg #define IOPARM_HAS_IOMSG (1 << 6) 635760c2415Smrg 636760c2415Smrg #define IOPARM_COMMON_MASK ((1 << 7) - 1) 637760c2415Smrg 638760c2415Smrg /* Make sure to keep in sync with io/io.h (st_parameter_open). */ 639760c2415Smrg #define IOPARM_OPEN_HAS_RECL_IN (1 << 7) 640760c2415Smrg #define IOPARM_OPEN_HAS_FILE (1 << 8) 641760c2415Smrg #define IOPARM_OPEN_HAS_STATUS (1 << 9) 642760c2415Smrg #define IOPARM_OPEN_HAS_ACCESS (1 << 10) 643760c2415Smrg #define IOPARM_OPEN_HAS_FORM (1 << 11) 644760c2415Smrg #define IOPARM_OPEN_HAS_BLANK (1 << 12) 645760c2415Smrg #define IOPARM_OPEN_HAS_POSITION (1 << 13) 646760c2415Smrg #define IOPARM_OPEN_HAS_ACTION (1 << 14) 647760c2415Smrg #define IOPARM_OPEN_HAS_DELIM (1 << 15) 648760c2415Smrg #define IOPARM_OPEN_HAS_PAD (1 << 16) 649760c2415Smrg #define IOPARM_OPEN_HAS_CONVERT (1 << 17) 650760c2415Smrg #define IOPARM_OPEN_HAS_DECIMAL (1 << 18) 651760c2415Smrg #define IOPARM_OPEN_HAS_ENCODING (1 << 19) 652760c2415Smrg #define IOPARM_OPEN_HAS_ROUND (1 << 20) 653760c2415Smrg #define IOPARM_OPEN_HAS_SIGN (1 << 21) 654760c2415Smrg #define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22) 655760c2415Smrg #define IOPARM_OPEN_HAS_NEWUNIT (1 << 23) 656760c2415Smrg #define IOPARM_OPEN_HAS_READONLY (1 << 24) 657760c2415Smrg #define IOPARM_OPEN_HAS_CC (1 << 25) 658760c2415Smrg #define IOPARM_OPEN_HAS_SHARE (1 << 26) 659760c2415Smrg 660760c2415Smrg /* library start function and end macro. These can be expanded if needed 661760c2415Smrg in the future. cmp is st_parameter_common *cmp */ 662760c2415Smrg 663760c2415Smrg extern void library_start (st_parameter_common *); 664760c2415Smrg internal_proto(library_start); 665760c2415Smrg 666760c2415Smrg #define library_end() 667760c2415Smrg 668760c2415Smrg /* main.c */ 669760c2415Smrg 670760c2415Smrg extern void stupid_function_name_for_static_linking (void); 671760c2415Smrg internal_proto(stupid_function_name_for_static_linking); 672760c2415Smrg 673760c2415Smrg extern void set_args (int, char **); 674760c2415Smrg iexport_proto(set_args); 675760c2415Smrg 676760c2415Smrg extern void get_args (int *, char ***); 677760c2415Smrg internal_proto(get_args); 678760c2415Smrg 679760c2415Smrg /* backtrace.c */ 680760c2415Smrg 681760c2415Smrg extern void show_backtrace (bool); 682760c2415Smrg internal_proto(show_backtrace); 683760c2415Smrg 684760c2415Smrg 685760c2415Smrg /* error.c */ 686760c2415Smrg 687760c2415Smrg #if defined(HAVE_GFC_REAL_16) 688760c2415Smrg #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16)) 689760c2415Smrg #elif defined(HAVE_GFC_INTEGER_16) 690760c2415Smrg #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) 691760c2415Smrg #elif defined(HAVE_GFC_REAL_10) 692760c2415Smrg #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10)) 693760c2415Smrg #else 694760c2415Smrg #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) 695760c2415Smrg #endif 696760c2415Smrg 697760c2415Smrg #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2) 698760c2415Smrg #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1) 699760c2415Smrg #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1) 700760c2415Smrg #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1) 701760c2415Smrg 702760c2415Smrg extern _Noreturn void sys_abort (void); 703760c2415Smrg internal_proto(sys_abort); 704760c2415Smrg 705760c2415Smrg extern _Noreturn void exit_error (int); 706760c2415Smrg internal_proto(exit_error); 707760c2415Smrg 708760c2415Smrg extern ssize_t estr_write (const char *); 709760c2415Smrg internal_proto(estr_write); 710760c2415Smrg 711760c2415Smrg #if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H) 712760c2415Smrg struct iovec { 713760c2415Smrg void *iov_base; /* Starting address */ 714760c2415Smrg size_t iov_len; /* Number of bytes to transfer */ 715760c2415Smrg }; 716760c2415Smrg #endif 717760c2415Smrg 718760c2415Smrg extern ssize_t estr_writev (const struct iovec *iov, int iovcnt); 719760c2415Smrg internal_proto(estr_writev); 720760c2415Smrg 721760c2415Smrg extern int st_printf (const char *, ...) 722760c2415Smrg __attribute__((format (gfc_printf, 1, 2))); 723760c2415Smrg internal_proto(st_printf); 724760c2415Smrg 725760c2415Smrg extern const char *gfc_xtoa (GFC_UINTEGER_LARGEST, char *, size_t); 726760c2415Smrg internal_proto(gfc_xtoa); 727760c2415Smrg 728760c2415Smrg extern _Noreturn void os_error (const char *); 729760c2415Smrg iexport_proto(os_error); 730760c2415Smrg 731*0bfacb9bSmrg extern _Noreturn void os_error_at (const char *, const char *, ...) 732*0bfacb9bSmrg __attribute__ ((format (gfc_printf, 2, 3))); 733*0bfacb9bSmrg iexport_proto(os_error_at); 734*0bfacb9bSmrg 735760c2415Smrg extern void show_locus (st_parameter_common *); 736760c2415Smrg internal_proto(show_locus); 737760c2415Smrg 738760c2415Smrg extern _Noreturn void runtime_error (const char *, ...) 739760c2415Smrg __attribute__ ((format (gfc_printf, 1, 2))); 740760c2415Smrg iexport_proto(runtime_error); 741760c2415Smrg 742760c2415Smrg extern _Noreturn void runtime_error_at (const char *, const char *, ...) 743760c2415Smrg __attribute__ ((format (gfc_printf, 2, 3))); 744760c2415Smrg iexport_proto(runtime_error_at); 745760c2415Smrg 746760c2415Smrg extern void runtime_warning_at (const char *, const char *, ...) 747760c2415Smrg __attribute__ ((format (gfc_printf, 2, 3))); 748760c2415Smrg iexport_proto(runtime_warning_at); 749760c2415Smrg 750760c2415Smrg extern _Noreturn void internal_error (st_parameter_common *, const char *); 751760c2415Smrg internal_proto(internal_error); 752760c2415Smrg 753760c2415Smrg extern const char *translate_error (int); 754760c2415Smrg internal_proto(translate_error); 755760c2415Smrg 756760c2415Smrg extern void generate_error (st_parameter_common *, int, const char *); 757760c2415Smrg iexport_proto(generate_error); 758760c2415Smrg 759760c2415Smrg extern bool generate_error_common (st_parameter_common *, int, const char *); 760760c2415Smrg iexport_proto(generate_error_common); 761760c2415Smrg 762760c2415Smrg extern void generate_warning (st_parameter_common *, const char *); 763760c2415Smrg internal_proto(generate_warning); 764760c2415Smrg 765760c2415Smrg extern bool notify_std (st_parameter_common *, int, const char *); 766760c2415Smrg internal_proto(notify_std); 767760c2415Smrg 768760c2415Smrg extern notification notification_std(int); 769760c2415Smrg internal_proto(notification_std); 770760c2415Smrg 771760c2415Smrg extern char *gf_strerror (int, char *, size_t); 772760c2415Smrg internal_proto(gf_strerror); 773760c2415Smrg 774760c2415Smrg /* fpu.c */ 775760c2415Smrg 776760c2415Smrg extern void set_fpu (void); 777760c2415Smrg internal_proto(set_fpu); 778760c2415Smrg 779760c2415Smrg extern int get_fpu_trap_exceptions (void); 780760c2415Smrg internal_proto(get_fpu_trap_exceptions); 781760c2415Smrg 782760c2415Smrg extern void set_fpu_trap_exceptions (int, int); 783760c2415Smrg internal_proto(set_fpu_trap_exceptions); 784760c2415Smrg 785760c2415Smrg extern int support_fpu_trap (int); 786760c2415Smrg internal_proto(support_fpu_trap); 787760c2415Smrg 788760c2415Smrg extern int get_fpu_except_flags (void); 789760c2415Smrg internal_proto(get_fpu_except_flags); 790760c2415Smrg 791760c2415Smrg extern void set_fpu_except_flags (int, int); 792760c2415Smrg internal_proto(set_fpu_except_flags); 793760c2415Smrg 794760c2415Smrg extern int support_fpu_flag (int); 795760c2415Smrg internal_proto(support_fpu_flag); 796760c2415Smrg 797760c2415Smrg extern void set_fpu_rounding_mode (int); 798760c2415Smrg internal_proto(set_fpu_rounding_mode); 799760c2415Smrg 800760c2415Smrg extern int get_fpu_rounding_mode (void); 801760c2415Smrg internal_proto(get_fpu_rounding_mode); 802760c2415Smrg 803760c2415Smrg extern int support_fpu_rounding_mode (int); 804760c2415Smrg internal_proto(support_fpu_rounding_mode); 805760c2415Smrg 806760c2415Smrg extern void get_fpu_state (void *); 807760c2415Smrg internal_proto(get_fpu_state); 808760c2415Smrg 809760c2415Smrg extern void set_fpu_state (void *); 810760c2415Smrg internal_proto(set_fpu_state); 811760c2415Smrg 812760c2415Smrg extern int get_fpu_underflow_mode (void); 813760c2415Smrg internal_proto(get_fpu_underflow_mode); 814760c2415Smrg 815760c2415Smrg extern void set_fpu_underflow_mode (int); 816760c2415Smrg internal_proto(set_fpu_underflow_mode); 817760c2415Smrg 818760c2415Smrg extern int support_fpu_underflow_control (int); 819760c2415Smrg internal_proto(support_fpu_underflow_control); 820760c2415Smrg 821760c2415Smrg /* memory.c */ 822760c2415Smrg 823760c2415Smrg extern void *xmalloc (size_t) __attribute__ ((malloc)); 824760c2415Smrg internal_proto(xmalloc); 825760c2415Smrg 826760c2415Smrg extern void *xmallocarray (size_t, size_t) __attribute__ ((malloc)); 827760c2415Smrg internal_proto(xmallocarray); 828760c2415Smrg 829760c2415Smrg extern void *xcalloc (size_t, size_t) __attribute__ ((malloc)); 830760c2415Smrg internal_proto(xcalloc); 831760c2415Smrg 832760c2415Smrg extern void *xrealloc (void *, size_t); 833760c2415Smrg internal_proto(xrealloc); 834760c2415Smrg 835760c2415Smrg /* environ.c */ 836760c2415Smrg 837760c2415Smrg extern void init_variables (void); 838760c2415Smrg internal_proto(init_variables); 839760c2415Smrg 840760c2415Smrg unit_convert get_unformatted_convert (int); 841760c2415Smrg internal_proto(get_unformatted_convert); 842760c2415Smrg 843760c2415Smrg /* Secure getenv() which returns NULL if running as SUID/SGID. */ 844760c2415Smrg #ifndef HAVE_SECURE_GETENV 845760c2415Smrg #if defined(HAVE_GETUID) && defined(HAVE_GETEUID) \ 846760c2415Smrg && defined(HAVE_GETGID) && defined(HAVE_GETEGID) 847760c2415Smrg #define FALLBACK_SECURE_GETENV 848760c2415Smrg extern char *secure_getenv (const char *); 849760c2415Smrg internal_proto(secure_getenv); 850760c2415Smrg #else 851760c2415Smrg #define secure_getenv getenv 852760c2415Smrg #endif 853760c2415Smrg #endif 854760c2415Smrg 855760c2415Smrg /* string.c */ 856760c2415Smrg 857760c2415Smrg extern int find_option (st_parameter_common *, const char *, gfc_charlen_type, 858760c2415Smrg const st_option *, const char *); 859760c2415Smrg internal_proto(find_option); 860760c2415Smrg 861760c2415Smrg extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type); 862760c2415Smrg internal_proto(fstrlen); 863760c2415Smrg 864760c2415Smrg extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type); 865760c2415Smrg internal_proto(fstrcpy); 866760c2415Smrg 867760c2415Smrg extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *); 868760c2415Smrg internal_proto(cf_strcpy); 869760c2415Smrg 870760c2415Smrg extern gfc_charlen_type string_len_trim (gfc_charlen_type, const char *); 871760c2415Smrg export_proto(string_len_trim); 872760c2415Smrg 873760c2415Smrg extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type, 874760c2415Smrg const gfc_char4_t *); 875760c2415Smrg export_proto(string_len_trim_char4); 876760c2415Smrg 877760c2415Smrg extern char *fc_strdup(const char *, gfc_charlen_type); 878760c2415Smrg internal_proto(fc_strdup); 879760c2415Smrg 880760c2415Smrg extern char *fc_strdup_notrim(const char *, gfc_charlen_type); 881760c2415Smrg internal_proto(fc_strdup_notrim); 882760c2415Smrg 883760c2415Smrg extern const char *gfc_itoa(GFC_INTEGER_LARGEST, char *, size_t); 884760c2415Smrg internal_proto(gfc_itoa); 885760c2415Smrg 886760c2415Smrg /* io/intrinsics.c */ 887760c2415Smrg 888760c2415Smrg extern void flush_all_units (void); 889760c2415Smrg internal_proto(flush_all_units); 890760c2415Smrg 891760c2415Smrg /* io.c */ 892760c2415Smrg 893760c2415Smrg extern void init_units (void); 894760c2415Smrg internal_proto(init_units); 895760c2415Smrg 896760c2415Smrg extern void close_units (void); 897760c2415Smrg internal_proto(close_units); 898760c2415Smrg 899760c2415Smrg extern int unit_to_fd (int); 900760c2415Smrg internal_proto(unit_to_fd); 901760c2415Smrg 902760c2415Smrg extern char * filename_from_unit (int); 903760c2415Smrg internal_proto(filename_from_unit); 904760c2415Smrg 905760c2415Smrg /* stop.c */ 906760c2415Smrg 907760c2415Smrg extern _Noreturn void stop_string (const char *, size_t, bool); 908760c2415Smrg export_proto(stop_string); 909760c2415Smrg 910760c2415Smrg /* reshape_packed.c */ 911760c2415Smrg 912760c2415Smrg extern void reshape_packed (char *, index_type, const char *, index_type, 913760c2415Smrg const char *, index_type); 914760c2415Smrg internal_proto(reshape_packed); 915760c2415Smrg 916760c2415Smrg /* Repacking functions. These are called internally by internal_pack 917760c2415Smrg and internal_unpack. */ 918760c2415Smrg 919760c2415Smrg GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *); 920760c2415Smrg internal_proto(internal_pack_1); 921760c2415Smrg 922760c2415Smrg GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *); 923760c2415Smrg internal_proto(internal_pack_2); 924760c2415Smrg 925760c2415Smrg GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); 926760c2415Smrg internal_proto(internal_pack_4); 927760c2415Smrg 928760c2415Smrg GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *); 929760c2415Smrg internal_proto(internal_pack_8); 930760c2415Smrg 931760c2415Smrg #if defined HAVE_GFC_INTEGER_16 932760c2415Smrg GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *); 933760c2415Smrg internal_proto(internal_pack_16); 934760c2415Smrg #endif 935760c2415Smrg 936760c2415Smrg GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *); 937760c2415Smrg internal_proto(internal_pack_r4); 938760c2415Smrg 939760c2415Smrg GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *); 940760c2415Smrg internal_proto(internal_pack_r8); 941760c2415Smrg 942760c2415Smrg #if defined HAVE_GFC_REAL_10 943760c2415Smrg GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *); 944760c2415Smrg internal_proto(internal_pack_r10); 945760c2415Smrg #endif 946760c2415Smrg 947760c2415Smrg #if defined HAVE_GFC_REAL_16 948760c2415Smrg GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *); 949760c2415Smrg internal_proto(internal_pack_r16); 950760c2415Smrg #endif 951760c2415Smrg 952760c2415Smrg GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); 953760c2415Smrg internal_proto(internal_pack_c4); 954760c2415Smrg 955760c2415Smrg GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *); 956760c2415Smrg internal_proto(internal_pack_c8); 957760c2415Smrg 958760c2415Smrg #if defined HAVE_GFC_COMPLEX_10 959760c2415Smrg GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *); 960760c2415Smrg internal_proto(internal_pack_c10); 961760c2415Smrg #endif 962760c2415Smrg 963760c2415Smrg #if defined HAVE_GFC_COMPLEX_16 964760c2415Smrg GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *); 965760c2415Smrg internal_proto(internal_pack_c16); 966760c2415Smrg #endif 967760c2415Smrg 968760c2415Smrg extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *); 969760c2415Smrg internal_proto(internal_unpack_1); 970760c2415Smrg 971760c2415Smrg extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *); 972760c2415Smrg internal_proto(internal_unpack_2); 973760c2415Smrg 974760c2415Smrg extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); 975760c2415Smrg internal_proto(internal_unpack_4); 976760c2415Smrg 977760c2415Smrg extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *); 978760c2415Smrg internal_proto(internal_unpack_8); 979760c2415Smrg 980760c2415Smrg #if defined HAVE_GFC_INTEGER_16 981760c2415Smrg extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *); 982760c2415Smrg internal_proto(internal_unpack_16); 983760c2415Smrg #endif 984760c2415Smrg 985760c2415Smrg extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *); 986760c2415Smrg internal_proto(internal_unpack_r4); 987760c2415Smrg 988760c2415Smrg extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *); 989760c2415Smrg internal_proto(internal_unpack_r8); 990760c2415Smrg 991760c2415Smrg #if defined HAVE_GFC_REAL_10 992760c2415Smrg extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *); 993760c2415Smrg internal_proto(internal_unpack_r10); 994760c2415Smrg #endif 995760c2415Smrg 996760c2415Smrg #if defined HAVE_GFC_REAL_16 997760c2415Smrg extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *); 998760c2415Smrg internal_proto(internal_unpack_r16); 999760c2415Smrg #endif 1000760c2415Smrg 1001760c2415Smrg extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); 1002760c2415Smrg internal_proto(internal_unpack_c4); 1003760c2415Smrg 1004760c2415Smrg extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *); 1005760c2415Smrg internal_proto(internal_unpack_c8); 1006760c2415Smrg 1007760c2415Smrg #if defined HAVE_GFC_COMPLEX_10 1008760c2415Smrg extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *); 1009760c2415Smrg internal_proto(internal_unpack_c10); 1010760c2415Smrg #endif 1011760c2415Smrg 1012760c2415Smrg #if defined HAVE_GFC_COMPLEX_16 1013760c2415Smrg extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *); 1014760c2415Smrg internal_proto(internal_unpack_c16); 1015760c2415Smrg #endif 1016760c2415Smrg 1017760c2415Smrg /* Internal auxiliary functions for the pack intrinsic. */ 1018760c2415Smrg 1019760c2415Smrg extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1020760c2415Smrg const gfc_array_l1 *, const gfc_array_i1 *); 1021760c2415Smrg internal_proto(pack_i1); 1022760c2415Smrg 1023760c2415Smrg extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1024760c2415Smrg const gfc_array_l1 *, const gfc_array_i2 *); 1025760c2415Smrg internal_proto(pack_i2); 1026760c2415Smrg 1027760c2415Smrg extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1028760c2415Smrg const gfc_array_l1 *, const gfc_array_i4 *); 1029760c2415Smrg internal_proto(pack_i4); 1030760c2415Smrg 1031760c2415Smrg extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1032760c2415Smrg const gfc_array_l1 *, const gfc_array_i8 *); 1033760c2415Smrg internal_proto(pack_i8); 1034760c2415Smrg 1035760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1036760c2415Smrg extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1037760c2415Smrg const gfc_array_l1 *, const gfc_array_i16 *); 1038760c2415Smrg internal_proto(pack_i16); 1039760c2415Smrg #endif 1040760c2415Smrg 1041760c2415Smrg extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1042760c2415Smrg const gfc_array_l1 *, const gfc_array_r4 *); 1043760c2415Smrg internal_proto(pack_r4); 1044760c2415Smrg 1045760c2415Smrg extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1046760c2415Smrg const gfc_array_l1 *, const gfc_array_r8 *); 1047760c2415Smrg internal_proto(pack_r8); 1048760c2415Smrg 1049760c2415Smrg #ifdef HAVE_GFC_REAL_10 1050760c2415Smrg extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1051760c2415Smrg const gfc_array_l1 *, const gfc_array_r10 *); 1052760c2415Smrg internal_proto(pack_r10); 1053760c2415Smrg #endif 1054760c2415Smrg 1055760c2415Smrg #ifdef HAVE_GFC_REAL_16 1056760c2415Smrg extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1057760c2415Smrg const gfc_array_l1 *, const gfc_array_r16 *); 1058760c2415Smrg internal_proto(pack_r16); 1059760c2415Smrg #endif 1060760c2415Smrg 1061760c2415Smrg extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1062760c2415Smrg const gfc_array_l1 *, const gfc_array_c4 *); 1063760c2415Smrg internal_proto(pack_c4); 1064760c2415Smrg 1065760c2415Smrg extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1066760c2415Smrg const gfc_array_l1 *, const gfc_array_c8 *); 1067760c2415Smrg internal_proto(pack_c8); 1068760c2415Smrg 1069760c2415Smrg #ifdef HAVE_GFC_REAL_10 1070760c2415Smrg extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1071760c2415Smrg const gfc_array_l1 *, const gfc_array_c10 *); 1072760c2415Smrg internal_proto(pack_c10); 1073760c2415Smrg #endif 1074760c2415Smrg 1075760c2415Smrg #ifdef HAVE_GFC_REAL_16 1076760c2415Smrg extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1077760c2415Smrg const gfc_array_l1 *, const gfc_array_c16 *); 1078760c2415Smrg internal_proto(pack_c16); 1079760c2415Smrg #endif 1080760c2415Smrg 1081760c2415Smrg /* Internal auxiliary functions for the unpack intrinsic. */ 1082760c2415Smrg 1083760c2415Smrg extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1084760c2415Smrg const gfc_array_l1 *, const GFC_INTEGER_1 *); 1085760c2415Smrg internal_proto(unpack0_i1); 1086760c2415Smrg 1087760c2415Smrg extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1088760c2415Smrg const gfc_array_l1 *, const GFC_INTEGER_2 *); 1089760c2415Smrg internal_proto(unpack0_i2); 1090760c2415Smrg 1091760c2415Smrg extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1092760c2415Smrg const gfc_array_l1 *, const GFC_INTEGER_4 *); 1093760c2415Smrg internal_proto(unpack0_i4); 1094760c2415Smrg 1095760c2415Smrg extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1096760c2415Smrg const gfc_array_l1 *, const GFC_INTEGER_8 *); 1097760c2415Smrg internal_proto(unpack0_i8); 1098760c2415Smrg 1099760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1100760c2415Smrg 1101760c2415Smrg extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1102760c2415Smrg const gfc_array_l1 *, const GFC_INTEGER_16 *); 1103760c2415Smrg internal_proto(unpack0_i16); 1104760c2415Smrg 1105760c2415Smrg #endif 1106760c2415Smrg 1107760c2415Smrg extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1108760c2415Smrg const gfc_array_l1 *, const GFC_REAL_4 *); 1109760c2415Smrg internal_proto(unpack0_r4); 1110760c2415Smrg 1111760c2415Smrg extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1112760c2415Smrg const gfc_array_l1 *, const GFC_REAL_8 *); 1113760c2415Smrg internal_proto(unpack0_r8); 1114760c2415Smrg 1115760c2415Smrg #ifdef HAVE_GFC_REAL_10 1116760c2415Smrg 1117760c2415Smrg extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1118760c2415Smrg const gfc_array_l1 *, const GFC_REAL_10 *); 1119760c2415Smrg internal_proto(unpack0_r10); 1120760c2415Smrg 1121760c2415Smrg #endif 1122760c2415Smrg 1123760c2415Smrg #ifdef HAVE_GFC_REAL_16 1124760c2415Smrg 1125760c2415Smrg extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1126760c2415Smrg const gfc_array_l1 *, const GFC_REAL_16 *); 1127760c2415Smrg internal_proto(unpack0_r16); 1128760c2415Smrg 1129760c2415Smrg #endif 1130760c2415Smrg 1131760c2415Smrg extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1132760c2415Smrg const gfc_array_l1 *, const GFC_COMPLEX_4 *); 1133760c2415Smrg internal_proto(unpack0_c4); 1134760c2415Smrg 1135760c2415Smrg extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1136760c2415Smrg const gfc_array_l1 *, const GFC_COMPLEX_8 *); 1137760c2415Smrg internal_proto(unpack0_c8); 1138760c2415Smrg 1139760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 1140760c2415Smrg 1141760c2415Smrg extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1142760c2415Smrg const gfc_array_l1 *mask, const GFC_COMPLEX_10 *); 1143760c2415Smrg internal_proto(unpack0_c10); 1144760c2415Smrg 1145760c2415Smrg #endif 1146760c2415Smrg 1147760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 1148760c2415Smrg 1149760c2415Smrg extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1150760c2415Smrg const gfc_array_l1 *, const GFC_COMPLEX_16 *); 1151760c2415Smrg internal_proto(unpack0_c16); 1152760c2415Smrg 1153760c2415Smrg #endif 1154760c2415Smrg 1155760c2415Smrg extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1156760c2415Smrg const gfc_array_l1 *, const gfc_array_i1 *); 1157760c2415Smrg internal_proto(unpack1_i1); 1158760c2415Smrg 1159760c2415Smrg extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1160760c2415Smrg const gfc_array_l1 *, const gfc_array_i2 *); 1161760c2415Smrg internal_proto(unpack1_i2); 1162760c2415Smrg 1163760c2415Smrg extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1164760c2415Smrg const gfc_array_l1 *, const gfc_array_i4 *); 1165760c2415Smrg internal_proto(unpack1_i4); 1166760c2415Smrg 1167760c2415Smrg extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1168760c2415Smrg const gfc_array_l1 *, const gfc_array_i8 *); 1169760c2415Smrg internal_proto(unpack1_i8); 1170760c2415Smrg 1171760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1172760c2415Smrg extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1173760c2415Smrg const gfc_array_l1 *, const gfc_array_i16 *); 1174760c2415Smrg internal_proto(unpack1_i16); 1175760c2415Smrg #endif 1176760c2415Smrg 1177760c2415Smrg extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1178760c2415Smrg const gfc_array_l1 *, const gfc_array_r4 *); 1179760c2415Smrg internal_proto(unpack1_r4); 1180760c2415Smrg 1181760c2415Smrg extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1182760c2415Smrg const gfc_array_l1 *, const gfc_array_r8 *); 1183760c2415Smrg internal_proto(unpack1_r8); 1184760c2415Smrg 1185760c2415Smrg #ifdef HAVE_GFC_REAL_10 1186760c2415Smrg extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1187760c2415Smrg const gfc_array_l1 *, const gfc_array_r10 *); 1188760c2415Smrg internal_proto(unpack1_r10); 1189760c2415Smrg #endif 1190760c2415Smrg 1191760c2415Smrg #ifdef HAVE_GFC_REAL_16 1192760c2415Smrg extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1193760c2415Smrg const gfc_array_l1 *, const gfc_array_r16 *); 1194760c2415Smrg internal_proto(unpack1_r16); 1195760c2415Smrg #endif 1196760c2415Smrg 1197760c2415Smrg extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1198760c2415Smrg const gfc_array_l1 *, const gfc_array_c4 *); 1199760c2415Smrg internal_proto(unpack1_c4); 1200760c2415Smrg 1201760c2415Smrg extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1202760c2415Smrg const gfc_array_l1 *, const gfc_array_c8 *); 1203760c2415Smrg internal_proto(unpack1_c8); 1204760c2415Smrg 1205760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 1206760c2415Smrg extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1207760c2415Smrg const gfc_array_l1 *, const gfc_array_c10 *); 1208760c2415Smrg internal_proto(unpack1_c10); 1209760c2415Smrg #endif 1210760c2415Smrg 1211760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 1212760c2415Smrg extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1213760c2415Smrg const gfc_array_l1 *, const gfc_array_c16 *); 1214760c2415Smrg internal_proto(unpack1_c16); 1215760c2415Smrg #endif 1216760c2415Smrg 1217760c2415Smrg /* Helper functions for spread. */ 1218760c2415Smrg 1219760c2415Smrg extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1220760c2415Smrg const index_type, const index_type); 1221760c2415Smrg internal_proto(spread_i1); 1222760c2415Smrg 1223760c2415Smrg extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1224760c2415Smrg const index_type, const index_type); 1225760c2415Smrg internal_proto(spread_i2); 1226760c2415Smrg 1227760c2415Smrg extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1228760c2415Smrg const index_type, const index_type); 1229760c2415Smrg internal_proto(spread_i4); 1230760c2415Smrg 1231760c2415Smrg extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1232760c2415Smrg const index_type, const index_type); 1233760c2415Smrg internal_proto(spread_i8); 1234760c2415Smrg 1235760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1236760c2415Smrg extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1237760c2415Smrg const index_type, const index_type); 1238760c2415Smrg internal_proto(spread_i16); 1239760c2415Smrg 1240760c2415Smrg #endif 1241760c2415Smrg 1242760c2415Smrg extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1243760c2415Smrg const index_type, const index_type); 1244760c2415Smrg internal_proto(spread_r4); 1245760c2415Smrg 1246760c2415Smrg extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1247760c2415Smrg const index_type, const index_type); 1248760c2415Smrg internal_proto(spread_r8); 1249760c2415Smrg 1250760c2415Smrg #ifdef HAVE_GFC_REAL_10 1251760c2415Smrg extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1252760c2415Smrg const index_type, const index_type); 1253760c2415Smrg internal_proto(spread_r10); 1254760c2415Smrg 1255760c2415Smrg #endif 1256760c2415Smrg 1257760c2415Smrg #ifdef HAVE_GFC_REAL_16 1258760c2415Smrg extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1259760c2415Smrg const index_type, const index_type); 1260760c2415Smrg internal_proto(spread_r16); 1261760c2415Smrg 1262760c2415Smrg #endif 1263760c2415Smrg 1264760c2415Smrg extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1265760c2415Smrg const index_type, const index_type); 1266760c2415Smrg internal_proto(spread_c4); 1267760c2415Smrg 1268760c2415Smrg extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1269760c2415Smrg const index_type, const index_type); 1270760c2415Smrg internal_proto(spread_c8); 1271760c2415Smrg 1272760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 1273760c2415Smrg extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1274760c2415Smrg const index_type, const index_type); 1275760c2415Smrg internal_proto(spread_c10); 1276760c2415Smrg 1277760c2415Smrg #endif 1278760c2415Smrg 1279760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 1280760c2415Smrg extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1281760c2415Smrg const index_type, const index_type); 1282760c2415Smrg internal_proto(spread_c16); 1283760c2415Smrg 1284760c2415Smrg #endif 1285760c2415Smrg 1286760c2415Smrg extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *, 1287760c2415Smrg const index_type, const index_type); 1288760c2415Smrg internal_proto(spread_scalar_i1); 1289760c2415Smrg 1290760c2415Smrg extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *, 1291760c2415Smrg const index_type, const index_type); 1292760c2415Smrg internal_proto(spread_scalar_i2); 1293760c2415Smrg 1294760c2415Smrg extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *, 1295760c2415Smrg const index_type, const index_type); 1296760c2415Smrg internal_proto(spread_scalar_i4); 1297760c2415Smrg 1298760c2415Smrg extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *, 1299760c2415Smrg const index_type, const index_type); 1300760c2415Smrg internal_proto(spread_scalar_i8); 1301760c2415Smrg 1302760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1303760c2415Smrg extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *, 1304760c2415Smrg const index_type, const index_type); 1305760c2415Smrg internal_proto(spread_scalar_i16); 1306760c2415Smrg 1307760c2415Smrg #endif 1308760c2415Smrg 1309760c2415Smrg extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *, 1310760c2415Smrg const index_type, const index_type); 1311760c2415Smrg internal_proto(spread_scalar_r4); 1312760c2415Smrg 1313760c2415Smrg extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *, 1314760c2415Smrg const index_type, const index_type); 1315760c2415Smrg internal_proto(spread_scalar_r8); 1316760c2415Smrg 1317760c2415Smrg #ifdef HAVE_GFC_REAL_10 1318760c2415Smrg extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *, 1319760c2415Smrg const index_type, const index_type); 1320760c2415Smrg internal_proto(spread_scalar_r10); 1321760c2415Smrg 1322760c2415Smrg #endif 1323760c2415Smrg 1324760c2415Smrg #ifdef HAVE_GFC_REAL_16 1325760c2415Smrg extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *, 1326760c2415Smrg const index_type, const index_type); 1327760c2415Smrg internal_proto(spread_scalar_r16); 1328760c2415Smrg 1329760c2415Smrg #endif 1330760c2415Smrg 1331760c2415Smrg extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *, 1332760c2415Smrg const index_type, const index_type); 1333760c2415Smrg internal_proto(spread_scalar_c4); 1334760c2415Smrg 1335760c2415Smrg extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *, 1336760c2415Smrg const index_type, const index_type); 1337760c2415Smrg internal_proto(spread_scalar_c8); 1338760c2415Smrg 1339760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 1340760c2415Smrg extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *, 1341760c2415Smrg const index_type, const index_type); 1342760c2415Smrg internal_proto(spread_scalar_c10); 1343760c2415Smrg 1344760c2415Smrg #endif 1345760c2415Smrg 1346760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 1347760c2415Smrg extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *, 1348760c2415Smrg const index_type, const index_type); 1349760c2415Smrg internal_proto(spread_scalar_c16); 1350760c2415Smrg 1351760c2415Smrg #endif 1352760c2415Smrg 1353760c2415Smrg /* string_intrinsics.c */ 1354760c2415Smrg 1355760c2415Smrg extern int compare_string (gfc_charlen_type, const char *, 1356760c2415Smrg gfc_charlen_type, const char *); 1357760c2415Smrg iexport_proto(compare_string); 1358760c2415Smrg 1359760c2415Smrg extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *, 1360760c2415Smrg gfc_charlen_type, const gfc_char4_t *); 1361760c2415Smrg iexport_proto(compare_string_char4); 1362760c2415Smrg 1363760c2415Smrg extern int memcmp_char4 (const void *, const void *, size_t); 1364760c2415Smrg internal_proto(memcmp_char4); 1365760c2415Smrg 1366760c2415Smrg 1367760c2415Smrg /* random.c */ 1368760c2415Smrg 1369760c2415Smrg extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put, 1370760c2415Smrg gfc_array_i4 * get); 1371760c2415Smrg iexport_proto(random_seed_i4); 1372760c2415Smrg extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put, 1373760c2415Smrg gfc_array_i8 * get); 1374760c2415Smrg iexport_proto(random_seed_i8); 1375760c2415Smrg 1376760c2415Smrg /* size.c */ 1377760c2415Smrg 1378760c2415Smrg typedef GFC_ARRAY_DESCRIPTOR (void) array_t; 1379760c2415Smrg 1380760c2415Smrg extern index_type size0 (const array_t * array); 1381760c2415Smrg iexport_proto(size0); 1382760c2415Smrg 1383760c2415Smrg /* is_contiguous.c */ 1384760c2415Smrg 1385760c2415Smrg extern GFC_LOGICAL_4 is_contiguous0 (const array_t * const restrict array); 1386760c2415Smrg iexport_proto(is_contiguous0); 1387760c2415Smrg 1388760c2415Smrg /* bounds.c */ 1389760c2415Smrg 1390760c2415Smrg extern void bounds_equal_extents (array_t *, array_t *, const char *, 1391760c2415Smrg const char *); 1392760c2415Smrg internal_proto(bounds_equal_extents); 1393760c2415Smrg 1394760c2415Smrg extern void bounds_reduced_extents (array_t *, array_t *, int, const char *, 1395760c2415Smrg const char *intrinsic); 1396760c2415Smrg internal_proto(bounds_reduced_extents); 1397760c2415Smrg 1398760c2415Smrg extern void bounds_iforeach_return (array_t *, array_t *, const char *); 1399760c2415Smrg internal_proto(bounds_iforeach_return); 1400760c2415Smrg 1401760c2415Smrg extern void bounds_ifunction_return (array_t *, const index_type *, 1402760c2415Smrg const char *, const char *); 1403760c2415Smrg internal_proto(bounds_ifunction_return); 1404760c2415Smrg 1405760c2415Smrg extern index_type count_0 (const gfc_array_l1 *); 1406760c2415Smrg 1407760c2415Smrg internal_proto(count_0); 1408760c2415Smrg 1409760c2415Smrg /* Internal auxiliary functions for cshift */ 1410760c2415Smrg 1411760c2415Smrg void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ptrdiff_t, int); 1412760c2415Smrg internal_proto(cshift0_i1); 1413760c2415Smrg 1414760c2415Smrg void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ptrdiff_t, int); 1415760c2415Smrg internal_proto(cshift0_i2); 1416760c2415Smrg 1417760c2415Smrg void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ptrdiff_t, int); 1418760c2415Smrg internal_proto(cshift0_i4); 1419760c2415Smrg 1420760c2415Smrg void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ptrdiff_t, int); 1421760c2415Smrg internal_proto(cshift0_i8); 1422760c2415Smrg 1423760c2415Smrg #ifdef HAVE_GFC_INTEGER_16 1424760c2415Smrg void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ptrdiff_t, int); 1425760c2415Smrg internal_proto(cshift0_i16); 1426760c2415Smrg #endif 1427760c2415Smrg 1428760c2415Smrg void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ptrdiff_t, int); 1429760c2415Smrg internal_proto(cshift0_r4); 1430760c2415Smrg 1431760c2415Smrg void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ptrdiff_t, int); 1432760c2415Smrg internal_proto(cshift0_r8); 1433760c2415Smrg 1434760c2415Smrg #ifdef HAVE_GFC_REAL_10 1435760c2415Smrg void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ptrdiff_t, int); 1436760c2415Smrg internal_proto(cshift0_r10); 1437760c2415Smrg #endif 1438760c2415Smrg 1439760c2415Smrg #ifdef HAVE_GFC_REAL_16 1440760c2415Smrg void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ptrdiff_t, int); 1441760c2415Smrg internal_proto(cshift0_r16); 1442760c2415Smrg #endif 1443760c2415Smrg 1444760c2415Smrg void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ptrdiff_t, int); 1445760c2415Smrg internal_proto(cshift0_c4); 1446760c2415Smrg 1447760c2415Smrg void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ptrdiff_t, int); 1448760c2415Smrg internal_proto(cshift0_c8); 1449760c2415Smrg 1450760c2415Smrg #ifdef HAVE_GFC_COMPLEX_10 1451760c2415Smrg void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ptrdiff_t, int); 1452760c2415Smrg internal_proto(cshift0_c10); 1453760c2415Smrg #endif 1454760c2415Smrg 1455760c2415Smrg #ifdef HAVE_GFC_COMPLEX_16 1456760c2415Smrg void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ptrdiff_t, int); 1457760c2415Smrg internal_proto(cshift0_c16); 1458760c2415Smrg #endif 1459760c2415Smrg 1460760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_1) 1461760c2415Smrg void cshift1_4_i1 (gfc_array_i1 * const restrict, 1462760c2415Smrg const gfc_array_i1 * const restrict, 1463760c2415Smrg const gfc_array_i4 * const restrict, 1464760c2415Smrg const GFC_INTEGER_4 * const restrict); 1465760c2415Smrg internal_proto(cshift1_4_i1); 1466760c2415Smrg #endif 1467760c2415Smrg 1468760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_2) 1469760c2415Smrg void cshift1_4_i2 (gfc_array_i2 * const restrict, 1470760c2415Smrg const gfc_array_i2 * const restrict, 1471760c2415Smrg const gfc_array_i4 * const restrict, 1472760c2415Smrg const GFC_INTEGER_4 * const restrict); 1473760c2415Smrg internal_proto(cshift1_4_i2); 1474760c2415Smrg #endif 1475760c2415Smrg 1476760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) 1477760c2415Smrg void cshift1_4_i4 (gfc_array_i4 * const restrict, 1478760c2415Smrg const gfc_array_i4 * const restrict, 1479760c2415Smrg const gfc_array_i4 * const restrict, 1480760c2415Smrg const GFC_INTEGER_4 * const restrict); 1481760c2415Smrg internal_proto(cshift1_4_i4); 1482760c2415Smrg #endif 1483760c2415Smrg 1484760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) 1485760c2415Smrg void cshift1_4_i8 (gfc_array_i8 * const restrict, 1486760c2415Smrg const gfc_array_i8 * const restrict, 1487760c2415Smrg const gfc_array_i4 * const restrict, 1488760c2415Smrg const GFC_INTEGER_4 * const restrict); 1489760c2415Smrg internal_proto(cshift1_4_i8); 1490760c2415Smrg #endif 1491760c2415Smrg 1492760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) 1493760c2415Smrg void cshift1_4_i16 (gfc_array_i16 * const restrict, 1494760c2415Smrg const gfc_array_i16 * const restrict, 1495760c2415Smrg const gfc_array_i4 * const restrict, 1496760c2415Smrg const GFC_INTEGER_4 * const restrict); 1497760c2415Smrg internal_proto(cshift1_4_i16); 1498760c2415Smrg #endif 1499760c2415Smrg 1500760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_1) 1501760c2415Smrg void cshift1_8_i1 (gfc_array_i1 * const restrict, 1502760c2415Smrg const gfc_array_i1 * const restrict, 1503760c2415Smrg const gfc_array_i8 * const restrict, 1504760c2415Smrg const GFC_INTEGER_8 * const restrict); 1505760c2415Smrg internal_proto(cshift1_8_i1); 1506760c2415Smrg #endif 1507760c2415Smrg 1508760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_2) 1509760c2415Smrg void cshift1_8_i2 (gfc_array_i2 * const restrict, 1510760c2415Smrg const gfc_array_i2 * const restrict, 1511760c2415Smrg const gfc_array_i8 * const restrict, 1512760c2415Smrg const GFC_INTEGER_8 * const restrict); 1513760c2415Smrg internal_proto(cshift1_8_i2); 1514760c2415Smrg #endif 1515760c2415Smrg 1516760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) 1517760c2415Smrg void cshift1_8_i4 (gfc_array_i4 * const restrict, 1518760c2415Smrg const gfc_array_i4 * const restrict, 1519760c2415Smrg const gfc_array_i8 * const restrict, 1520760c2415Smrg const GFC_INTEGER_8 * const restrict); 1521760c2415Smrg internal_proto(cshift1_8_i4); 1522760c2415Smrg #endif 1523760c2415Smrg 1524760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) 1525760c2415Smrg void cshift1_8_i8 (gfc_array_i8 * const restrict, 1526760c2415Smrg const gfc_array_i8 * const restrict, 1527760c2415Smrg const gfc_array_i8 * const restrict, 1528760c2415Smrg const GFC_INTEGER_8 * const restrict); 1529760c2415Smrg internal_proto(cshift1_8_i8); 1530760c2415Smrg #endif 1531760c2415Smrg 1532760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) 1533760c2415Smrg void cshift1_8_i16 (gfc_array_i16 * const restrict, 1534760c2415Smrg const gfc_array_i16 * const restrict, 1535760c2415Smrg const gfc_array_i8 * const restrict, 1536760c2415Smrg const GFC_INTEGER_8 * const restrict); 1537760c2415Smrg internal_proto(cshift1_8_i16); 1538760c2415Smrg #endif 1539760c2415Smrg 1540760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_1) 1541760c2415Smrg void cshift1_16_i1 (gfc_array_i1 * const restrict, 1542760c2415Smrg const gfc_array_i1 * const restrict, 1543760c2415Smrg const gfc_array_i16 * const restrict, 1544760c2415Smrg const GFC_INTEGER_16 * const restrict); 1545760c2415Smrg internal_proto(cshift1_16_i1); 1546760c2415Smrg #endif 1547760c2415Smrg 1548760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_2) 1549760c2415Smrg void cshift1_16_i2 (gfc_array_i2 * const restrict, 1550760c2415Smrg const gfc_array_i2 * const restrict, 1551760c2415Smrg const gfc_array_i16 * const restrict, 1552760c2415Smrg const GFC_INTEGER_16 * const restrict); 1553760c2415Smrg internal_proto(cshift1_16_i2); 1554760c2415Smrg #endif 1555760c2415Smrg 1556760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) 1557760c2415Smrg void cshift1_16_i4 (gfc_array_i4 * const restrict, 1558760c2415Smrg const gfc_array_i4 * const restrict, 1559760c2415Smrg const gfc_array_i16 * const restrict, 1560760c2415Smrg const GFC_INTEGER_16 * const restrict); 1561760c2415Smrg internal_proto(cshift1_16_i4); 1562760c2415Smrg #endif 1563760c2415Smrg 1564760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) 1565760c2415Smrg void cshift1_16_i8 (gfc_array_i8 * const restrict, 1566760c2415Smrg const gfc_array_i8 * const restrict, 1567760c2415Smrg const gfc_array_i16 * const restrict, 1568760c2415Smrg const GFC_INTEGER_16 * const restrict); 1569760c2415Smrg internal_proto(cshift1_16_i8); 1570760c2415Smrg #endif 1571760c2415Smrg 1572760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) 1573760c2415Smrg void cshift1_16_i16 (gfc_array_i16 * const restrict, 1574760c2415Smrg const gfc_array_i16 * const restrict, 1575760c2415Smrg const gfc_array_i16 * const restrict, 1576760c2415Smrg const GFC_INTEGER_16 * const restrict); 1577760c2415Smrg internal_proto(cshift1_16_i16); 1578760c2415Smrg #endif 1579760c2415Smrg 1580760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_4) 1581760c2415Smrg void cshift1_4_r4 (gfc_array_r4 * const restrict, 1582760c2415Smrg const gfc_array_r4 * const restrict, 1583760c2415Smrg const gfc_array_i4 * const restrict, 1584760c2415Smrg const GFC_INTEGER_4 * const restrict); 1585760c2415Smrg internal_proto(cshift1_4_r4); 1586760c2415Smrg #endif 1587760c2415Smrg 1588760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_8) 1589760c2415Smrg void cshift1_4_r8 (gfc_array_r8 * const restrict, 1590760c2415Smrg const gfc_array_r8 * const restrict, 1591760c2415Smrg const gfc_array_i4 * const restrict, 1592760c2415Smrg const GFC_INTEGER_4 * const restrict); 1593760c2415Smrg internal_proto(cshift1_4_r8); 1594760c2415Smrg #endif 1595760c2415Smrg 1596760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_10) 1597760c2415Smrg void cshift1_4_r10 (gfc_array_r10 * const restrict, 1598760c2415Smrg const gfc_array_r10 * const restrict, 1599760c2415Smrg const gfc_array_i4 * const restrict, 1600760c2415Smrg const GFC_INTEGER_4 * const restrict); 1601760c2415Smrg internal_proto(cshift1_4_r10); 1602760c2415Smrg #endif 1603760c2415Smrg 1604760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_16) 1605760c2415Smrg void cshift1_4_r16 (gfc_array_r16 * const restrict, 1606760c2415Smrg const gfc_array_r16 * const restrict, 1607760c2415Smrg const gfc_array_i4 * const restrict, 1608760c2415Smrg const GFC_INTEGER_4 * const restrict); 1609760c2415Smrg internal_proto(cshift1_4_r16); 1610760c2415Smrg #endif 1611760c2415Smrg 1612760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_4) 1613760c2415Smrg void cshift1_8_r4 (gfc_array_r4 * const restrict, 1614760c2415Smrg const gfc_array_r4 * const restrict, 1615760c2415Smrg const gfc_array_i8 * const restrict, 1616760c2415Smrg const GFC_INTEGER_8 * const restrict); 1617760c2415Smrg internal_proto(cshift1_8_r4); 1618760c2415Smrg #endif 1619760c2415Smrg 1620760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_8) 1621760c2415Smrg void cshift1_8_r8 (gfc_array_r8 * const restrict, 1622760c2415Smrg const gfc_array_r8 * const restrict, 1623760c2415Smrg const gfc_array_i8 * const restrict, 1624760c2415Smrg const GFC_INTEGER_8 * const restrict); 1625760c2415Smrg internal_proto(cshift1_8_r8); 1626760c2415Smrg #endif 1627760c2415Smrg 1628760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_10) 1629760c2415Smrg void cshift1_8_r10 (gfc_array_r10 * const restrict, 1630760c2415Smrg const gfc_array_r10 * const restrict, 1631760c2415Smrg const gfc_array_i8 * const restrict, 1632760c2415Smrg const GFC_INTEGER_8 * const restrict); 1633760c2415Smrg internal_proto(cshift1_8_r10); 1634760c2415Smrg #endif 1635760c2415Smrg 1636760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_16) 1637760c2415Smrg void cshift1_8_r16 (gfc_array_r16 * const restrict, 1638760c2415Smrg const gfc_array_r16 * const restrict, 1639760c2415Smrg const gfc_array_i8 * const restrict, 1640760c2415Smrg const GFC_INTEGER_8 * const restrict); 1641760c2415Smrg internal_proto(cshift1_8_r16); 1642760c2415Smrg #endif 1643760c2415Smrg 1644760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_4) 1645760c2415Smrg void cshift1_16_r4 (gfc_array_r4 * const restrict, 1646760c2415Smrg const gfc_array_r4 * const restrict, 1647760c2415Smrg const gfc_array_i16 * const restrict, 1648760c2415Smrg const GFC_INTEGER_16 * const restrict); 1649760c2415Smrg internal_proto(cshift1_16_r4); 1650760c2415Smrg #endif 1651760c2415Smrg 1652760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_8) 1653760c2415Smrg void cshift1_16_r8 (gfc_array_r8 * const restrict, 1654760c2415Smrg const gfc_array_r8 * const restrict, 1655760c2415Smrg const gfc_array_i16 * const restrict, 1656760c2415Smrg const GFC_INTEGER_16 * const restrict); 1657760c2415Smrg internal_proto(cshift1_16_r8); 1658760c2415Smrg #endif 1659760c2415Smrg 1660760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_10) 1661760c2415Smrg void cshift1_16_r10 (gfc_array_r10 * const restrict, 1662760c2415Smrg const gfc_array_r10 * const restrict, 1663760c2415Smrg const gfc_array_i16 * const restrict, 1664760c2415Smrg const GFC_INTEGER_16 * const restrict); 1665760c2415Smrg internal_proto(cshift1_16_r10); 1666760c2415Smrg #endif 1667760c2415Smrg 1668760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_16) 1669760c2415Smrg void cshift1_16_r16 (gfc_array_r16 * const restrict, 1670760c2415Smrg const gfc_array_r16 * const restrict, 1671760c2415Smrg const gfc_array_i16 * const restrict, 1672760c2415Smrg const GFC_INTEGER_16 * const restrict); 1673760c2415Smrg internal_proto(cshift1_16_r16); 1674760c2415Smrg #endif 1675760c2415Smrg 1676760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_4) 1677760c2415Smrg void cshift1_4_c4 (gfc_array_c4 * const restrict, 1678760c2415Smrg const gfc_array_c4 * const restrict, 1679760c2415Smrg const gfc_array_i4 * const restrict, 1680760c2415Smrg const GFC_INTEGER_4 * const restrict); 1681760c2415Smrg internal_proto(cshift1_4_c4); 1682760c2415Smrg #endif 1683760c2415Smrg 1684760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_8) 1685760c2415Smrg void cshift1_4_c8 (gfc_array_c8 * const restrict, 1686760c2415Smrg const gfc_array_c8 * const restrict, 1687760c2415Smrg const gfc_array_i4 * const restrict, 1688760c2415Smrg const GFC_INTEGER_4 * const restrict); 1689760c2415Smrg internal_proto(cshift1_4_c8); 1690760c2415Smrg #endif 1691760c2415Smrg 1692760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_10) 1693760c2415Smrg void cshift1_4_c10 (gfc_array_c10 * const restrict, 1694760c2415Smrg const gfc_array_c10 * const restrict, 1695760c2415Smrg const gfc_array_i4 * const restrict, 1696760c2415Smrg const GFC_INTEGER_4 * const restrict); 1697760c2415Smrg internal_proto(cshift1_4_c10); 1698760c2415Smrg #endif 1699760c2415Smrg 1700760c2415Smrg #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_16) 1701760c2415Smrg void cshift1_4_c16 (gfc_array_c16 * const restrict, 1702760c2415Smrg const gfc_array_c16 * const restrict, 1703760c2415Smrg const gfc_array_i4 * const restrict, 1704760c2415Smrg const GFC_INTEGER_4 * const restrict); 1705760c2415Smrg internal_proto(cshift1_4_c16); 1706760c2415Smrg #endif 1707760c2415Smrg 1708760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_4) 1709760c2415Smrg void cshift1_8_c4 (gfc_array_c4 * const restrict, 1710760c2415Smrg const gfc_array_c4 * const restrict, 1711760c2415Smrg const gfc_array_i8 * const restrict, 1712760c2415Smrg const GFC_INTEGER_8 * const restrict); 1713760c2415Smrg internal_proto(cshift1_8_c4); 1714760c2415Smrg #endif 1715760c2415Smrg 1716760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_8) 1717760c2415Smrg void cshift1_8_c8 (gfc_array_c8 * const restrict, 1718760c2415Smrg const gfc_array_c8 * const restrict, 1719760c2415Smrg const gfc_array_i8 * const restrict, 1720760c2415Smrg const GFC_INTEGER_8 * const restrict); 1721760c2415Smrg internal_proto(cshift1_8_c8); 1722760c2415Smrg #endif 1723760c2415Smrg 1724760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_10) 1725760c2415Smrg void cshift1_8_c10 (gfc_array_c10 * const restrict, 1726760c2415Smrg const gfc_array_c10 * const restrict, 1727760c2415Smrg const gfc_array_i8 * const restrict, 1728760c2415Smrg const GFC_INTEGER_8 * const restrict); 1729760c2415Smrg internal_proto(cshift1_8_c10); 1730760c2415Smrg #endif 1731760c2415Smrg 1732760c2415Smrg #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_16) 1733760c2415Smrg void cshift1_8_c16 (gfc_array_c16 * const restrict, 1734760c2415Smrg const gfc_array_c16 * const restrict, 1735760c2415Smrg const gfc_array_i8 * const restrict, 1736760c2415Smrg const GFC_INTEGER_8 * const restrict); 1737760c2415Smrg internal_proto(cshift1_8_c16); 1738760c2415Smrg #endif 1739760c2415Smrg 1740760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_4) 1741760c2415Smrg void cshift1_16_c4 (gfc_array_c4 * const restrict, 1742760c2415Smrg const gfc_array_c4 * const restrict, 1743760c2415Smrg const gfc_array_i16 * const restrict, 1744760c2415Smrg const GFC_INTEGER_16 * const restrict); 1745760c2415Smrg internal_proto(cshift1_16_c4); 1746760c2415Smrg #endif 1747760c2415Smrg 1748760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_8) 1749760c2415Smrg void cshift1_16_c8 (gfc_array_c8 * const restrict, 1750760c2415Smrg const gfc_array_c8 * const restrict, 1751760c2415Smrg const gfc_array_i16 * const restrict, 1752760c2415Smrg const GFC_INTEGER_16 * const restrict); 1753760c2415Smrg internal_proto(cshift1_16_c8); 1754760c2415Smrg #endif 1755760c2415Smrg 1756760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_10) 1757760c2415Smrg void cshift1_16_c10 (gfc_array_c10 * const restrict, 1758760c2415Smrg const gfc_array_c10 * const restrict, 1759760c2415Smrg const gfc_array_i16 * const restrict, 1760760c2415Smrg const GFC_INTEGER_16 * const restrict); 1761760c2415Smrg internal_proto(cshift1_16_c10); 1762760c2415Smrg #endif 1763760c2415Smrg 1764760c2415Smrg #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_16) 1765760c2415Smrg void cshift1_16_c16 (gfc_array_c16 * const restrict, 1766760c2415Smrg const gfc_array_c16 * const restrict, 1767760c2415Smrg const gfc_array_i16 * const restrict, 1768760c2415Smrg const GFC_INTEGER_16 * const restrict); 1769760c2415Smrg internal_proto(cshift1_16_c16); 1770760c2415Smrg #endif 1771760c2415Smrg 1772760c2415Smrg /* We always have these. */ 1773760c2415Smrg 1774760c2415Smrg #define HAVE_GFC_UINTEGER_1 1 1775760c2415Smrg #define HAVE_GFC_UINTEGER_4 1 1776760c2415Smrg 1777760c2415Smrg #endif /* LIBGFOR_H */ 1778