1 /* Common declarations for all of libgfortran. 2 Copyright (C) 2002-2022 Free Software Foundation, Inc. 3 Contributed by Paul Brook <paul (at) nowt.org>, and 4 Andy Vaught <andy (at) xena.eas.asu.edu> 5 6 This file is part of the GNU Fortran runtime library (libgfortran). 7 8 Libgfortran is free software; you can redistribute it and/or modify 9 it under the terms of the GNU General Public License as published by 10 the Free Software Foundation; either version 3, or (at your option) 11 any later version. 12 13 Libgfortran is distributed in the hope that it will be useful, 14 but WITHOUT ANY WARRANTY; without even the implied warranty of 15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 GNU General Public License for more details. 17 18 Under Section 7 of GPL version 3, you are granted additional 19 permissions described in the GCC Runtime Library Exception, version 20 3.1, as published by the Free Software Foundation. 21 22 You should have received a copy of the GNU General Public License and 23 a copy of the GCC Runtime Library Exception along with this program; 24 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 25 <http://www.gnu.org/licenses/>. */ 26 27 #ifndef LIBGFOR_H 28 #define LIBGFOR_H 29 30 /* Ensure that ANSI conform stdio is used. This needs to be set before 31 any system header file is included. */ 32 #if defined __MINGW32__ 33 # define _POSIX 1 34 # define gfc_printf gnu_printf 35 #else 36 # define gfc_printf __printf__ 37 #endif 38 39 /* config.h MUST be first because it can affect system headers. */ 40 #include "config.h" 41 42 #include <ctype.h> 43 #include <stdio.h> 44 #include <stdlib.h> 45 #include <stddef.h> 46 #include <float.h> 47 #include <stdarg.h> 48 #include <stdbool.h> 49 50 #if HAVE_COMPLEX_H 51 /* Must appear before math.h on VMS systems. */ 52 # include <complex.h> 53 #else 54 #define complex __complex__ 55 #endif 56 57 #include <math.h> 58 59 /* If we're support quad-precision floating-point type, include the 60 header to our support library. */ 61 #ifdef HAVE_FLOAT128 62 # include "quadmath_weak.h" 63 #endif 64 65 #ifdef __MINGW32__ 66 extern float __strtof (const char *, char **); 67 #define gfc_strtof __strtof 68 extern double __strtod (const char *, char **); 69 #define gfc_strtod __strtod 70 extern long double __strtold (const char *, char **); 71 #define gfc_strtold __strtold 72 #else 73 #define gfc_strtof strtof 74 #define gfc_strtod strtod 75 #define gfc_strtold strtold 76 #endif 77 78 #include "../gcc/fortran/libgfortran.h" 79 80 #include "c99_protos.h" 81 82 #if HAVE_IEEEFP_H 83 #include <ieeefp.h> 84 #endif 85 86 #include "gstdint.h" 87 88 #if HAVE_SYS_TYPES_H 89 #include <sys/types.h> 90 #endif 91 92 #ifdef HAVE_SYS_UIO_H 93 #include <sys/uio.h> 94 #endif 95 96 #ifdef __MINGW32__ 97 typedef off64_t gfc_offset; 98 #else 99 typedef off_t gfc_offset; 100 #endif 101 102 #ifndef NULL 103 #define NULL (void *) 0 104 #endif 105 106 #if defined(__powerpc64__) && __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ \ 107 && defined __GLIBC_PREREQ 108 #if __GLIBC_PREREQ (2, 32) 109 #define POWER_IEEE128 1 110 #endif 111 #endif 112 113 /* These functions from <ctype.h> should only be used on values that can be 114 represented as unsigned char, otherwise the behavior is undefined. 115 Some targets have a char type that is signed, so we cast the argument 116 to unsigned char. See: 117 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95177 118 https://wiki.sei.cmu.edu/confluence/x/BNcxBQ 119 */ 120 121 #define safe_isalnum(x) isalnum((unsigned char) (x)) 122 #define safe_isdigit(x) isdigit((unsigned char) (x)) 123 #define safe_tolower(x) tolower((unsigned char) (x)) 124 #define safe_toupper(x) toupper((unsigned char) (x)) 125 126 127 /* The following macros can be used to annotate conditions which are likely or 128 unlikely to be true. Avoid using them when a condition is only slightly 129 more likely/less unlikely than average to avoid the performance penalties of 130 branch misprediction. In addition, as __builtin_expect overrides the compiler 131 heuristic, do not use in conditions where one of the branches ends with a 132 call to a function with __attribute__((noreturn)): the compiler internal 133 heuristic will mark this branch as much less likely as unlikely() would 134 do. */ 135 136 #define likely(x) __builtin_expect(!!(x), 1) 137 #define unlikely(x) __builtin_expect(!!(x), 0) 138 139 /* This macro can be used to annotate conditions which we know to 140 be true, so that the compiler can optimize based on the condition. */ 141 142 #define GFC_ASSERT(EXPR) \ 143 ((void)(__builtin_expect (!(EXPR), 0) ? __builtin_unreachable (), 0 : 0)) 144 145 /* Make sure we have ptrdiff_t. */ 146 #ifndef HAVE_PTRDIFF_T 147 typedef intptr_t ptrdiff_t; 148 #endif 149 150 /* On mingw, work around the buggy Windows snprintf() by using the one 151 mingw provides, __mingw_snprintf(). We also provide a prototype for 152 __mingw_snprintf(), because the mingw headers currently don't have one. */ 153 #if HAVE_MINGW_SNPRINTF 154 extern int __mingw_snprintf (char *, size_t, const char *, ...) 155 __attribute__ ((format (gnu_printf, 3, 4))); 156 #undef snprintf 157 #define snprintf __mingw_snprintf 158 /* Fallback to sprintf if target does not have snprintf. */ 159 #elif !defined(HAVE_SNPRINTF) 160 #undef snprintf 161 #define snprintf(str, size, ...) sprintf (str, __VA_ARGS__) 162 #endif 163 164 165 /* For a library, a standard prefix is a requirement in order to partition 166 the namespace. IPREFIX is for symbols intended to be internal to the 167 library. */ 168 #define PREFIX(x) _gfortran_ ## x 169 #define IPREFIX(x) _gfortrani_ ## x 170 171 /* Magic to rename a symbol at the compiler level. You continue to refer 172 to the symbol as OLD in the source, but it'll be named NEW in the asm. */ 173 #define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new) 174 #define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new) 175 #define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new) 176 177 /* There are several classifications of routines: 178 179 (1) Symbols used only within the library, 180 (2) Symbols to be exported from the library, 181 (3) Symbols to be exported from the library, but 182 also used inside the library. 183 184 By telling the compiler about these different classifications we can 185 tightly control the interface seen by the user, and get better code 186 from the compiler at the same time. 187 188 One of the following should be used immediately after the declaration 189 of each symbol: 190 191 internal_proto Marks a symbol used only within the library, 192 and adds IPREFIX to the assembly-level symbol 193 name. The later is important for maintaining 194 the namespace partition for the static library. 195 196 export_proto Marks a symbol to be exported, and adds PREFIX 197 to the assembly-level symbol name. 198 199 export_proto_np Marks a symbol to be exported without adding PREFIX. 200 201 iexport_proto Marks a function to be exported, but with the 202 understanding that it can be used inside as well. 203 204 iexport_data_proto Similarly, marks a data symbol to be exported. 205 Unfortunately, some systems can't play the hidden 206 symbol renaming trick on data symbols, thanks to 207 the horribleness of COPY relocations. 208 209 If iexport_proto or iexport_data_proto is used, you must also use 210 iexport or iexport_data after the *definition* of the symbol. */ 211 212 #if defined(HAVE_ATTRIBUTE_VISIBILITY) 213 # define internal_proto(x) \ 214 sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden"))) 215 #else 216 # define internal_proto(x) sym_rename(x, IPREFIX(x)) 217 #endif 218 219 #if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS) 220 # define export_proto(x) sym_rename(x, PREFIX(x)) 221 # define export_proto_np(x) extern char swallow_semicolon 222 # define iexport_proto(x) internal_proto(x) 223 # define iexport(x) iexport1(x, IPREFIX(x)) 224 # define iexport1(x,y) iexport2(x,y) 225 # define iexport2(x,y) \ 226 extern __typeof(x) PREFIX(x) __attribute__((__alias__(#y), __copy__ (x))) 227 #else 228 # define export_proto(x) sym_rename(x, PREFIX(x)) 229 # define export_proto_np(x) extern char swallow_semicolon 230 # define iexport_proto(x) export_proto(x) 231 # define iexport(x) extern char swallow_semicolon 232 #endif 233 234 /* TODO: detect the case when we *can* hide the symbol. */ 235 #define iexport_data_proto(x) export_proto(x) 236 #define iexport_data(x) extern char swallow_semicolon 237 238 /* The only reliable way to get the offset of a field in a struct 239 in a system independent way is via this macro. */ 240 #ifndef offsetof 241 #define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER) 242 #endif 243 244 /* The C99 classification macros isfinite, isinf, isnan, isnormal 245 and signbit are broken or inconsistent on quite a few targets. 246 So, we use GCC's builtins instead. 247 248 Another advantage for GCC's builtins for these type-generic macros 249 is that it handles floating-point types that the system headers 250 may not support (like __float128). */ 251 252 #undef isnan 253 #define isnan(x) __builtin_isnan(x) 254 #undef isfinite 255 #define isfinite(x) __builtin_isfinite(x) 256 #undef isinf 257 #define isinf(x) __builtin_isinf(x) 258 #undef isnormal 259 #define isnormal(x) __builtin_isnormal(x) 260 #undef signbit 261 #define signbit(x) __builtin_signbit(x) 262 263 #include "kinds.h" 264 265 /* Define the type used for the current record number for large file I/O. 266 The size must be consistent with the size defined on the compiler side. */ 267 #ifdef HAVE_GFC_INTEGER_8 268 typedef GFC_INTEGER_8 GFC_IO_INT; 269 #else 270 #ifdef HAVE_GFC_INTEGER_4 271 typedef GFC_INTEGER_4 GFC_IO_INT; 272 #else 273 #error "GFC_INTEGER_4 should be available for the library to compile". 274 #endif 275 #endif 276 277 /* The following two definitions must be consistent with the types used 278 by the compiler. */ 279 /* The type used of array indices, amongst other things. */ 280 typedef ptrdiff_t index_type; 281 282 /* The type used for the lengths of character variables. */ 283 typedef size_t gfc_charlen_type; 284 285 /* Definitions of CHARACTER data types: 286 - CHARACTER(KIND=1) corresponds to the C char type, 287 - CHARACTER(KIND=4) corresponds to an unsigned 32-bit integer. */ 288 typedef GFC_UINTEGER_4 gfc_char4_t; 289 290 /* Byte size of character kinds. For the kinds currently supported, it's 291 simply equal to the kind parameter itself. */ 292 #define GFC_SIZE_OF_CHAR_KIND(kind) (kind) 293 294 #define GFOR_POINTER_TO_L1(p, kind) \ 295 ((__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__ ? 1: 0) * (kind - 1) + (GFC_LOGICAL_1 *)(p)) 296 297 #define GFC_INTEGER_1_HUGE \ 298 (GFC_INTEGER_1)((((GFC_UINTEGER_1)1) << 7) - 1) 299 #define GFC_INTEGER_2_HUGE \ 300 (GFC_INTEGER_2)((((GFC_UINTEGER_2)1) << 15) - 1) 301 #define GFC_INTEGER_4_HUGE \ 302 (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1) 303 #define GFC_INTEGER_8_HUGE \ 304 (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1) 305 #ifdef HAVE_GFC_INTEGER_16 306 #define GFC_INTEGER_16_HUGE \ 307 (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1) 308 #endif 309 310 /* M{IN,AX}{LOC,VAL} need also infinities and NaNs if supported. */ 311 312 #if __FLT_HAS_INFINITY__ 313 # define GFC_REAL_4_INFINITY __builtin_inff () 314 #endif 315 #if __DBL_HAS_INFINITY__ 316 # define GFC_REAL_8_INFINITY __builtin_inf () 317 #endif 318 #if __LDBL_HAS_INFINITY__ 319 # ifdef HAVE_GFC_REAL_10 320 # define GFC_REAL_10_INFINITY __builtin_infl () 321 # endif 322 # ifdef HAVE_GFC_REAL_16 323 # ifdef GFC_REAL_16_IS_LONG_DOUBLE 324 # define GFC_REAL_16_INFINITY __builtin_infl () 325 # else 326 # define GFC_REAL_16_INFINITY __builtin_infq () 327 # endif 328 # endif 329 # ifdef HAVE_GFC_REAL_17 330 # define GFC_REAL_17_INFINITY __builtin_inff128 () 331 # endif 332 #endif 333 #if __FLT_HAS_QUIET_NAN__ 334 # define GFC_REAL_4_QUIET_NAN __builtin_nanf ("") 335 #endif 336 #if __DBL_HAS_QUIET_NAN__ 337 # define GFC_REAL_8_QUIET_NAN __builtin_nan ("") 338 #endif 339 #if __LDBL_HAS_QUIET_NAN__ 340 # ifdef HAVE_GFC_REAL_10 341 # define GFC_REAL_10_QUIET_NAN __builtin_nanl ("") 342 # endif 343 # ifdef HAVE_GFC_REAL_16 344 # ifdef GFC_REAL_16_IS_LONG_DOUBLE 345 # define GFC_REAL_16_QUIET_NAN __builtin_nanl ("") 346 # else 347 # define GFC_REAL_16_QUIET_NAN nanq ("") 348 # endif 349 # endif 350 # ifdef HAVE_GFC_REAL_17 351 # define GFC_REAL_17_QUIET_NAN __builtin_nanf128 ("") 352 # endif 353 #endif 354 355 typedef struct descriptor_dimension 356 { 357 index_type _stride; 358 index_type lower_bound; 359 index_type _ubound; 360 } 361 descriptor_dimension; 362 363 typedef struct dtype_type 364 { 365 size_t elem_len; 366 int version; 367 signed char rank; 368 signed char type; 369 signed short attribute; 370 } 371 dtype_type; 372 373 #define GFC_ARRAY_DESCRIPTOR(type) \ 374 struct {\ 375 type *base_addr;\ 376 size_t offset;\ 377 dtype_type dtype;\ 378 index_type span;\ 379 descriptor_dimension dim[];\ 380 } 381 382 /* Commonly used array descriptor types. */ 383 typedef GFC_ARRAY_DESCRIPTOR (void) gfc_array_void; 384 typedef GFC_ARRAY_DESCRIPTOR (char) gfc_array_char; 385 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_1) gfc_array_i1; 386 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_2) gfc_array_i2; 387 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_4) gfc_array_i4; 388 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_8) gfc_array_i8; 389 typedef GFC_ARRAY_DESCRIPTOR (index_type) gfc_array_index_type; 390 #ifdef HAVE_GFC_INTEGER_16 391 typedef GFC_ARRAY_DESCRIPTOR (GFC_INTEGER_16) gfc_array_i16; 392 #endif 393 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_4) gfc_array_r4; 394 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_8) gfc_array_r8; 395 #ifdef HAVE_GFC_REAL_10 396 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_10) gfc_array_r10; 397 #endif 398 #ifdef HAVE_GFC_REAL_16 399 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_16) gfc_array_r16; 400 #endif 401 #ifdef HAVE_GFC_REAL_17 402 typedef GFC_ARRAY_DESCRIPTOR (GFC_REAL_17) gfc_array_r17; 403 #endif 404 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_4) gfc_array_c4; 405 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_8) gfc_array_c8; 406 #ifdef HAVE_GFC_COMPLEX_10 407 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_10) gfc_array_c10; 408 #endif 409 #ifdef HAVE_GFC_COMPLEX_16 410 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_16) gfc_array_c16; 411 #endif 412 #ifdef HAVE_GFC_COMPLEX_17 413 typedef GFC_ARRAY_DESCRIPTOR (GFC_COMPLEX_17) gfc_array_c17; 414 #endif 415 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_1) gfc_array_l1; 416 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_2) gfc_array_l2; 417 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_4) gfc_array_l4; 418 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_8) gfc_array_l8; 419 #ifdef HAVE_GFC_LOGICAL_16 420 typedef GFC_ARRAY_DESCRIPTOR (GFC_LOGICAL_16) gfc_array_l16; 421 #endif 422 423 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_1) gfc_array_s1; 424 typedef GFC_ARRAY_DESCRIPTOR (GFC_UINTEGER_4) gfc_array_s4; 425 426 /* These are for when you actually want to declare a descriptor, as 427 opposed to a pointer to it. */ 428 429 #define GFC_FULL_ARRAY_DESCRIPTOR(r, type) \ 430 struct {\ 431 type *base_addr;\ 432 size_t offset;\ 433 dtype_type dtype;\ 434 index_type span;\ 435 descriptor_dimension dim[r];\ 436 } 437 438 typedef GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_full_array_i4; 439 440 #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank) 441 #define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type) 442 #define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len) 443 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr) 444 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) 445 #define GFC_DESCRIPTOR_SPAN(desc) ((desc)->span) 446 447 #define GFC_DIMENSION_LBOUND(dim) ((dim).lower_bound) 448 #define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound) 449 #define GFC_DIMENSION_STRIDE(dim) ((dim)._stride) 450 #define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim).lower_bound) 451 #define GFC_DIMENSION_SET(dim,lb,ub,str) \ 452 do \ 453 { \ 454 (dim).lower_bound = lb; \ 455 (dim)._ubound = ub; \ 456 (dim)._stride = str; \ 457 } while (0) 458 459 460 #define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lower_bound) 461 #define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound) 462 #define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \ 463 - (desc)->dim[i].lower_bound) 464 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \ 465 (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) 466 467 #define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride) 468 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \ 469 (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc)) 470 471 /* Macros to get both the size and the type with a single masking operation */ 472 473 #define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT)) 474 #define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK) 475 476 #define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \ 477 | ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK) 478 479 /* Macros to set size and type information. */ 480 481 #define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0) 482 #define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0)) 483 #define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \ 484 (a)->dtype.version = 0; \ 485 (a)->dtype.rank = 0; \ 486 (a)->dtype.type = 0; \ 487 (a)->dtype.attribute = 0; \ 488 } while(0) 489 490 #define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 491 | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) 492 #define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 493 | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) 494 #define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 495 | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) 496 #define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 497 | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) 498 #ifdef HAVE_GFC_INTEGER_16 499 #define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ 500 | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) 501 #endif 502 503 #define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 504 | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT)) 505 #define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 506 | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT)) 507 #define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 508 | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT)) 509 #define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 510 | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT)) 511 #ifdef HAVE_GFC_LOGICAL_16 512 #define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ 513 | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) 514 #endif 515 516 #define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 517 | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT)) 518 #define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 519 | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT)) 520 #ifdef HAVE_GFC_REAL_10 521 #define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 522 | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT)) 523 #endif 524 #ifdef HAVE_GFC_REAL_16 525 #define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 526 | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) 527 #endif 528 #ifdef HAVE_GFC_REAL_17 529 #define GFC_DTYPE_REAL_17 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ 530 | (sizeof(GFC_REAL_17) << GFC_DTYPE_SIZE_SHIFT)) 531 #endif 532 533 #define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 534 | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT)) 535 #define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 536 | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT)) 537 #ifdef HAVE_GFC_COMPLEX_10 538 #define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 539 | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT)) 540 #endif 541 #ifdef HAVE_GFC_COMPLEX_16 542 #define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 543 | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) 544 #endif 545 #ifdef HAVE_GFC_COMPLEX_17 546 #define GFC_DTYPE_COMPLEX_17 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ 547 | (sizeof(GFC_COMPLEX_17) << GFC_DTYPE_SIZE_SHIFT)) 548 #endif 549 550 /* Macros to determine the alignment of pointers. */ 551 552 #define GFC_UNALIGNED_2(x) (((uintptr_t)(x)) & \ 553 (__alignof__(GFC_INTEGER_2) - 1)) 554 #define GFC_UNALIGNED_4(x) (((uintptr_t)(x)) & \ 555 (__alignof__(GFC_INTEGER_4) - 1)) 556 #define GFC_UNALIGNED_8(x) (((uintptr_t)(x)) & \ 557 (__alignof__(GFC_INTEGER_8) - 1)) 558 #ifdef HAVE_GFC_INTEGER_16 559 #define GFC_UNALIGNED_16(x) (((uintptr_t)(x)) & \ 560 (__alignof__(GFC_INTEGER_16) - 1)) 561 #endif 562 563 #define GFC_UNALIGNED_C4(x) (((uintptr_t)(x)) & \ 564 (__alignof__(GFC_COMPLEX_4) - 1)) 565 566 #define GFC_UNALIGNED_C8(x) (((uintptr_t)(x)) & \ 567 (__alignof__(GFC_COMPLEX_8) - 1)) 568 569 /* Runtime library include. */ 570 #define stringize(x) expand_macro(x) 571 #define expand_macro(x) # x 572 573 /* Runtime options structure. */ 574 575 typedef struct 576 { 577 int stdin_unit, stdout_unit, stderr_unit, optional_plus; 578 int locus; 579 580 int separator_len; 581 const char *separator; 582 583 int all_unbuffered, unbuffered_preconnected; 584 int fpe, backtrace; 585 int unformatted_buffer_size, formatted_buffer_size; 586 } 587 options_t; 588 589 extern options_t options; 590 internal_proto(options); 591 592 extern void backtrace_handler (int); 593 internal_proto(backtrace_handler); 594 595 596 /* Compile-time options that will influence the library. */ 597 598 typedef struct 599 { 600 int warn_std; 601 int allow_std; 602 int pedantic; 603 int convert; 604 int backtrace; 605 int sign_zero; 606 size_t record_marker; 607 int max_subrecord_length; 608 int bounds_check; 609 int fpe_summary; 610 } 611 compile_options_t; 612 613 extern compile_options_t compile_options; 614 internal_proto(compile_options); 615 616 extern void init_compile_options (void); 617 internal_proto(init_compile_options); 618 619 #define GFC_MAX_SUBRECORD_LENGTH 2147483639 /* 2**31 - 9 */ 620 621 /* Structure for statement options. */ 622 623 typedef struct 624 { 625 const char *name; 626 int value; 627 } 628 st_option; 629 630 631 /* This is returned by notification_std to know if, given the flags 632 that were given (-std=, -pedantic) we should issue an error, a warning 633 or nothing. */ 634 typedef enum 635 { NOTIFICATION_SILENT, NOTIFICATION_WARNING, NOTIFICATION_ERROR } 636 notification; 637 638 639 /* The filename and line number don't go inside the globals structure. 640 They are set by the rest of the program and must be linked to. */ 641 642 /* Location of the current library call (optional). */ 643 extern unsigned line; 644 iexport_data_proto(line); 645 646 extern char *filename; 647 iexport_data_proto(filename); 648 649 650 #define CHARACTER2(name) \ 651 gfc_charlen_type name ## _len; \ 652 char * name 653 654 typedef struct st_parameter_common 655 { 656 GFC_INTEGER_4 flags; 657 GFC_INTEGER_4 unit; 658 const char *filename; 659 GFC_INTEGER_4 line; 660 CHARACTER2 (iomsg); 661 GFC_INTEGER_4 *iostat; 662 } 663 st_parameter_common; 664 665 #undef CHARACTER2 666 667 #define IOPARM_LIBRETURN_MASK (3 << 0) 668 #define IOPARM_LIBRETURN_OK (0 << 0) 669 #define IOPARM_LIBRETURN_ERROR (1 << 0) 670 #define IOPARM_LIBRETURN_END (2 << 0) 671 #define IOPARM_LIBRETURN_EOR (3 << 0) 672 #define IOPARM_ERR (1 << 2) 673 #define IOPARM_END (1 << 3) 674 #define IOPARM_EOR (1 << 4) 675 #define IOPARM_HAS_IOSTAT (1 << 5) 676 #define IOPARM_HAS_IOMSG (1 << 6) 677 678 #define IOPARM_COMMON_MASK ((1 << 7) - 1) 679 680 /* Make sure to keep in sync with io/io.h (st_parameter_open). */ 681 #define IOPARM_OPEN_HAS_RECL_IN (1 << 7) 682 #define IOPARM_OPEN_HAS_FILE (1 << 8) 683 #define IOPARM_OPEN_HAS_STATUS (1 << 9) 684 #define IOPARM_OPEN_HAS_ACCESS (1 << 10) 685 #define IOPARM_OPEN_HAS_FORM (1 << 11) 686 #define IOPARM_OPEN_HAS_BLANK (1 << 12) 687 #define IOPARM_OPEN_HAS_POSITION (1 << 13) 688 #define IOPARM_OPEN_HAS_ACTION (1 << 14) 689 #define IOPARM_OPEN_HAS_DELIM (1 << 15) 690 #define IOPARM_OPEN_HAS_PAD (1 << 16) 691 #define IOPARM_OPEN_HAS_CONVERT (1 << 17) 692 #define IOPARM_OPEN_HAS_DECIMAL (1 << 18) 693 #define IOPARM_OPEN_HAS_ENCODING (1 << 19) 694 #define IOPARM_OPEN_HAS_ROUND (1 << 20) 695 #define IOPARM_OPEN_HAS_SIGN (1 << 21) 696 #define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22) 697 #define IOPARM_OPEN_HAS_NEWUNIT (1 << 23) 698 #define IOPARM_OPEN_HAS_READONLY (1 << 24) 699 #define IOPARM_OPEN_HAS_CC (1 << 25) 700 #define IOPARM_OPEN_HAS_SHARE (1 << 26) 701 702 /* library start function and end macro. These can be expanded if needed 703 in the future. cmp is st_parameter_common *cmp */ 704 705 extern void library_start (st_parameter_common *); 706 internal_proto(library_start); 707 708 #define library_end() 709 710 /* main.c */ 711 712 extern void stupid_function_name_for_static_linking (void); 713 internal_proto(stupid_function_name_for_static_linking); 714 715 extern void set_args (int, char **); 716 iexport_proto(set_args); 717 718 extern void get_args (int *, char ***); 719 internal_proto(get_args); 720 721 /* backtrace.c */ 722 723 extern void show_backtrace (bool); 724 internal_proto(show_backtrace); 725 726 727 /* error.c */ 728 729 #if defined(HAVE_GFC_REAL_16) 730 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_16)) 731 #elif defined(HAVE_GFC_INTEGER_16) 732 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) 733 #elif defined(HAVE_GFC_REAL_10) 734 #define GFC_LARGEST_BUF (sizeof (GFC_REAL_10)) 735 #else 736 #define GFC_LARGEST_BUF (sizeof (GFC_INTEGER_LARGEST)) 737 #endif 738 739 #define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1) 740 #define GFC_XTOA_BUF_SIZE (GFC_LARGEST_BUF * 2 + 1) 741 #define GFC_OTOA_BUF_SIZE (GFC_LARGEST_BUF * 3 + 1) 742 #define GFC_BTOA_BUF_SIZE (GFC_LARGEST_BUF * 8 + 1) 743 744 extern _Noreturn void sys_abort (void); 745 internal_proto(sys_abort); 746 747 extern _Noreturn void exit_error (int); 748 internal_proto(exit_error); 749 750 extern ssize_t estr_write (const char *); 751 internal_proto(estr_write); 752 753 #if !defined(HAVE_WRITEV) && !defined(HAVE_SYS_UIO_H) 754 struct iovec { 755 void *iov_base; /* Starting address */ 756 size_t iov_len; /* Number of bytes to transfer */ 757 }; 758 #endif 759 760 extern ssize_t estr_writev (const struct iovec *iov, int iovcnt); 761 internal_proto(estr_writev); 762 763 extern int st_printf (const char *, ...) 764 __attribute__((format (gfc_printf, 1, 2))); 765 internal_proto(st_printf); 766 767 extern _Noreturn void os_error (const char *); 768 iexport_proto(os_error); 769 770 extern _Noreturn void os_error_at (const char *, const char *, ...) 771 __attribute__ ((format (gfc_printf, 2, 3))); 772 iexport_proto(os_error_at); 773 774 extern void show_locus (st_parameter_common *); 775 internal_proto(show_locus); 776 777 extern _Noreturn void runtime_error (const char *, ...) 778 __attribute__ ((format (gfc_printf, 1, 2))); 779 iexport_proto(runtime_error); 780 781 extern _Noreturn void runtime_error_at (const char *, const char *, ...) 782 __attribute__ ((format (gfc_printf, 2, 3))); 783 iexport_proto(runtime_error_at); 784 785 extern void runtime_warning_at (const char *, const char *, ...) 786 __attribute__ ((format (gfc_printf, 2, 3))); 787 iexport_proto(runtime_warning_at); 788 789 extern _Noreturn void internal_error (st_parameter_common *, const char *); 790 internal_proto(internal_error); 791 792 extern const char *translate_error (int); 793 internal_proto(translate_error); 794 795 extern void generate_error (st_parameter_common *, int, const char *); 796 iexport_proto(generate_error); 797 798 extern bool generate_error_common (st_parameter_common *, int, const char *); 799 iexport_proto(generate_error_common); 800 801 extern void generate_warning (st_parameter_common *, const char *); 802 internal_proto(generate_warning); 803 804 extern bool notify_std (st_parameter_common *, int, const char *); 805 internal_proto(notify_std); 806 807 extern notification notification_std(int); 808 internal_proto(notification_std); 809 810 extern char *gf_strerror (int, char *, size_t); 811 internal_proto(gf_strerror); 812 813 /* fpu.c */ 814 815 extern void set_fpu (void); 816 internal_proto(set_fpu); 817 818 extern int get_fpu_trap_exceptions (void); 819 internal_proto(get_fpu_trap_exceptions); 820 821 extern void set_fpu_trap_exceptions (int, int); 822 internal_proto(set_fpu_trap_exceptions); 823 824 extern int support_fpu_trap (int); 825 internal_proto(support_fpu_trap); 826 827 extern int get_fpu_except_flags (void); 828 internal_proto(get_fpu_except_flags); 829 830 extern void set_fpu_except_flags (int, int); 831 internal_proto(set_fpu_except_flags); 832 833 extern int support_fpu_flag (int); 834 internal_proto(support_fpu_flag); 835 836 extern void set_fpu_rounding_mode (int); 837 internal_proto(set_fpu_rounding_mode); 838 839 extern int get_fpu_rounding_mode (void); 840 internal_proto(get_fpu_rounding_mode); 841 842 extern int support_fpu_rounding_mode (int); 843 internal_proto(support_fpu_rounding_mode); 844 845 extern void get_fpu_state (void *); 846 internal_proto(get_fpu_state); 847 848 extern void set_fpu_state (void *); 849 internal_proto(set_fpu_state); 850 851 extern int get_fpu_underflow_mode (void); 852 internal_proto(get_fpu_underflow_mode); 853 854 extern void set_fpu_underflow_mode (int); 855 internal_proto(set_fpu_underflow_mode); 856 857 extern int support_fpu_underflow_control (int); 858 internal_proto(support_fpu_underflow_control); 859 860 /* memory.c */ 861 862 extern void *xmalloc (size_t) __attribute__ ((malloc)); 863 internal_proto(xmalloc); 864 865 extern void *xmallocarray (size_t, size_t) __attribute__ ((malloc)); 866 internal_proto(xmallocarray); 867 868 extern void *xcalloc (size_t, size_t) __attribute__ ((malloc)); 869 internal_proto(xcalloc); 870 871 extern void *xrealloc (void *, size_t); 872 internal_proto(xrealloc); 873 874 /* environ.c */ 875 876 extern void init_variables (void); 877 internal_proto(init_variables); 878 879 unit_convert get_unformatted_convert (int); 880 internal_proto(get_unformatted_convert); 881 882 /* Secure getenv() which returns NULL if running as SUID/SGID. */ 883 #ifndef HAVE_SECURE_GETENV 884 #if defined(HAVE_GETUID) && defined(HAVE_GETEUID) \ 885 && defined(HAVE_GETGID) && defined(HAVE_GETEGID) 886 #define FALLBACK_SECURE_GETENV 887 extern char *secure_getenv (const char *); 888 internal_proto(secure_getenv); 889 #else 890 #define secure_getenv getenv 891 #endif 892 #endif 893 894 /* string.c */ 895 896 extern int find_option (st_parameter_common *, const char *, gfc_charlen_type, 897 const st_option *, const char *); 898 internal_proto(find_option); 899 900 extern gfc_charlen_type fstrlen (const char *, gfc_charlen_type); 901 internal_proto(fstrlen); 902 903 extern gfc_charlen_type fstrcpy (char *, gfc_charlen_type, const char *, gfc_charlen_type); 904 internal_proto(fstrcpy); 905 906 extern gfc_charlen_type cf_strcpy (char *, gfc_charlen_type, const char *); 907 internal_proto(cf_strcpy); 908 909 extern gfc_charlen_type string_len_trim (gfc_charlen_type, const char *); 910 export_proto(string_len_trim); 911 912 extern gfc_charlen_type string_len_trim_char4 (gfc_charlen_type, 913 const gfc_char4_t *); 914 export_proto(string_len_trim_char4); 915 916 extern char *fc_strdup(const char *, gfc_charlen_type); 917 internal_proto(fc_strdup); 918 919 extern char *fc_strdup_notrim(const char *, gfc_charlen_type); 920 internal_proto(fc_strdup_notrim); 921 922 extern const char *gfc_itoa(GFC_UINTEGER_LARGEST, char *, size_t); 923 internal_proto(gfc_itoa); 924 925 /* io/intrinsics.c */ 926 927 extern void flush_all_units (void); 928 internal_proto(flush_all_units); 929 930 /* io.c */ 931 932 extern void init_units (void); 933 internal_proto(init_units); 934 935 extern void close_units (void); 936 internal_proto(close_units); 937 938 extern int unit_to_fd (int); 939 internal_proto(unit_to_fd); 940 941 extern char * filename_from_unit (int); 942 internal_proto(filename_from_unit); 943 944 /* stop.c */ 945 946 extern _Noreturn void stop_string (const char *, size_t, bool); 947 export_proto(stop_string); 948 949 /* reshape_packed.c */ 950 951 extern void reshape_packed (char *, index_type, const char *, index_type, 952 const char *, index_type); 953 internal_proto(reshape_packed); 954 955 /* Repacking functions. These are called internally by internal_pack 956 and internal_unpack. */ 957 958 GFC_INTEGER_1 *internal_pack_1 (gfc_array_i1 *); 959 internal_proto(internal_pack_1); 960 961 GFC_INTEGER_2 *internal_pack_2 (gfc_array_i2 *); 962 internal_proto(internal_pack_2); 963 964 GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); 965 internal_proto(internal_pack_4); 966 967 GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *); 968 internal_proto(internal_pack_8); 969 970 #if defined HAVE_GFC_INTEGER_16 971 GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *); 972 internal_proto(internal_pack_16); 973 #endif 974 975 GFC_REAL_4 *internal_pack_r4 (gfc_array_r4 *); 976 internal_proto(internal_pack_r4); 977 978 GFC_REAL_8 *internal_pack_r8 (gfc_array_r8 *); 979 internal_proto(internal_pack_r8); 980 981 #if defined HAVE_GFC_REAL_10 982 GFC_REAL_10 *internal_pack_r10 (gfc_array_r10 *); 983 internal_proto(internal_pack_r10); 984 #endif 985 986 #if defined HAVE_GFC_REAL_16 987 GFC_REAL_16 *internal_pack_r16 (gfc_array_r16 *); 988 internal_proto(internal_pack_r16); 989 #endif 990 991 #if defined HAVE_GFC_REAL_17 992 GFC_REAL_17 *internal_pack_r17 (gfc_array_r17 *); 993 internal_proto(internal_pack_r17); 994 #endif 995 996 GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); 997 internal_proto(internal_pack_c4); 998 999 GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *); 1000 internal_proto(internal_pack_c8); 1001 1002 #if defined HAVE_GFC_COMPLEX_10 1003 GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *); 1004 internal_proto(internal_pack_c10); 1005 #endif 1006 1007 #if defined HAVE_GFC_COMPLEX_16 1008 GFC_COMPLEX_16 *internal_pack_c16 (gfc_array_c16 *); 1009 internal_proto(internal_pack_c16); 1010 #endif 1011 1012 #if defined HAVE_GFC_COMPLEX_17 1013 GFC_COMPLEX_17 *internal_pack_c17 (gfc_array_c17 *); 1014 internal_proto(internal_pack_c17); 1015 #endif 1016 1017 extern void internal_unpack_1 (gfc_array_i1 *, const GFC_INTEGER_1 *); 1018 internal_proto(internal_unpack_1); 1019 1020 extern void internal_unpack_2 (gfc_array_i2 *, const GFC_INTEGER_2 *); 1021 internal_proto(internal_unpack_2); 1022 1023 extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); 1024 internal_proto(internal_unpack_4); 1025 1026 extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *); 1027 internal_proto(internal_unpack_8); 1028 1029 #if defined HAVE_GFC_INTEGER_16 1030 extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *); 1031 internal_proto(internal_unpack_16); 1032 #endif 1033 1034 extern void internal_unpack_r4 (gfc_array_r4 *, const GFC_REAL_4 *); 1035 internal_proto(internal_unpack_r4); 1036 1037 extern void internal_unpack_r8 (gfc_array_r8 *, const GFC_REAL_8 *); 1038 internal_proto(internal_unpack_r8); 1039 1040 #if defined HAVE_GFC_REAL_10 1041 extern void internal_unpack_r10 (gfc_array_r10 *, const GFC_REAL_10 *); 1042 internal_proto(internal_unpack_r10); 1043 #endif 1044 1045 #if defined HAVE_GFC_REAL_16 1046 extern void internal_unpack_r16 (gfc_array_r16 *, const GFC_REAL_16 *); 1047 internal_proto(internal_unpack_r16); 1048 #endif 1049 1050 #if defined HAVE_GFC_REAL_17 1051 extern void internal_unpack_r17 (gfc_array_r17 *, const GFC_REAL_17 *); 1052 internal_proto(internal_unpack_r17); 1053 #endif 1054 1055 extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); 1056 internal_proto(internal_unpack_c4); 1057 1058 extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *); 1059 internal_proto(internal_unpack_c8); 1060 1061 #if defined HAVE_GFC_COMPLEX_10 1062 extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *); 1063 internal_proto(internal_unpack_c10); 1064 #endif 1065 1066 #if defined HAVE_GFC_COMPLEX_16 1067 extern void internal_unpack_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *); 1068 internal_proto(internal_unpack_c16); 1069 #endif 1070 1071 #if defined HAVE_GFC_COMPLEX_17 1072 extern void internal_unpack_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *); 1073 internal_proto(internal_unpack_c17); 1074 #endif 1075 1076 /* Internal auxiliary functions for the pack intrinsic. */ 1077 1078 extern void pack_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1079 const gfc_array_l1 *, const gfc_array_i1 *); 1080 internal_proto(pack_i1); 1081 1082 extern void pack_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1083 const gfc_array_l1 *, const gfc_array_i2 *); 1084 internal_proto(pack_i2); 1085 1086 extern void pack_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1087 const gfc_array_l1 *, const gfc_array_i4 *); 1088 internal_proto(pack_i4); 1089 1090 extern void pack_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1091 const gfc_array_l1 *, const gfc_array_i8 *); 1092 internal_proto(pack_i8); 1093 1094 #ifdef HAVE_GFC_INTEGER_16 1095 extern void pack_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1096 const gfc_array_l1 *, const gfc_array_i16 *); 1097 internal_proto(pack_i16); 1098 #endif 1099 1100 extern void pack_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1101 const gfc_array_l1 *, const gfc_array_r4 *); 1102 internal_proto(pack_r4); 1103 1104 extern void pack_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1105 const gfc_array_l1 *, const gfc_array_r8 *); 1106 internal_proto(pack_r8); 1107 1108 #ifdef HAVE_GFC_REAL_10 1109 extern void pack_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1110 const gfc_array_l1 *, const gfc_array_r10 *); 1111 internal_proto(pack_r10); 1112 #endif 1113 1114 #ifdef HAVE_GFC_REAL_16 1115 extern void pack_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1116 const gfc_array_l1 *, const gfc_array_r16 *); 1117 internal_proto(pack_r16); 1118 #endif 1119 1120 #ifdef HAVE_GFC_REAL_17 1121 extern void pack_r17 (gfc_array_r17 *, const gfc_array_r17 *, 1122 const gfc_array_l1 *, const gfc_array_r17 *); 1123 internal_proto(pack_r17); 1124 #endif 1125 1126 extern void pack_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1127 const gfc_array_l1 *, const gfc_array_c4 *); 1128 internal_proto(pack_c4); 1129 1130 extern void pack_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1131 const gfc_array_l1 *, const gfc_array_c8 *); 1132 internal_proto(pack_c8); 1133 1134 #ifdef HAVE_GFC_REAL_10 1135 extern void pack_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1136 const gfc_array_l1 *, const gfc_array_c10 *); 1137 internal_proto(pack_c10); 1138 #endif 1139 1140 #ifdef HAVE_GFC_REAL_16 1141 extern void pack_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1142 const gfc_array_l1 *, const gfc_array_c16 *); 1143 internal_proto(pack_c16); 1144 #endif 1145 1146 #ifdef HAVE_GFC_REAL_17 1147 extern void pack_c17 (gfc_array_c17 *, const gfc_array_c17 *, 1148 const gfc_array_l1 *, const gfc_array_c17 *); 1149 internal_proto(pack_c17); 1150 #endif 1151 1152 /* Internal auxiliary functions for the unpack intrinsic. */ 1153 1154 extern void unpack0_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1155 const gfc_array_l1 *, const GFC_INTEGER_1 *); 1156 internal_proto(unpack0_i1); 1157 1158 extern void unpack0_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1159 const gfc_array_l1 *, const GFC_INTEGER_2 *); 1160 internal_proto(unpack0_i2); 1161 1162 extern void unpack0_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1163 const gfc_array_l1 *, const GFC_INTEGER_4 *); 1164 internal_proto(unpack0_i4); 1165 1166 extern void unpack0_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1167 const gfc_array_l1 *, const GFC_INTEGER_8 *); 1168 internal_proto(unpack0_i8); 1169 1170 #ifdef HAVE_GFC_INTEGER_16 1171 1172 extern void unpack0_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1173 const gfc_array_l1 *, const GFC_INTEGER_16 *); 1174 internal_proto(unpack0_i16); 1175 1176 #endif 1177 1178 extern void unpack0_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1179 const gfc_array_l1 *, const GFC_REAL_4 *); 1180 internal_proto(unpack0_r4); 1181 1182 extern void unpack0_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1183 const gfc_array_l1 *, const GFC_REAL_8 *); 1184 internal_proto(unpack0_r8); 1185 1186 #ifdef HAVE_GFC_REAL_10 1187 1188 extern void unpack0_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1189 const gfc_array_l1 *, const GFC_REAL_10 *); 1190 internal_proto(unpack0_r10); 1191 1192 #endif 1193 1194 #ifdef HAVE_GFC_REAL_16 1195 1196 extern void unpack0_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1197 const gfc_array_l1 *, const GFC_REAL_16 *); 1198 internal_proto(unpack0_r16); 1199 1200 #endif 1201 1202 #ifdef HAVE_GFC_REAL_17 1203 1204 extern void unpack0_r17 (gfc_array_r17 *, const gfc_array_r17 *, 1205 const gfc_array_l1 *, const GFC_REAL_17 *); 1206 internal_proto(unpack0_r17); 1207 1208 #endif 1209 1210 extern void unpack0_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1211 const gfc_array_l1 *, const GFC_COMPLEX_4 *); 1212 internal_proto(unpack0_c4); 1213 1214 extern void unpack0_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1215 const gfc_array_l1 *, const GFC_COMPLEX_8 *); 1216 internal_proto(unpack0_c8); 1217 1218 #ifdef HAVE_GFC_COMPLEX_10 1219 1220 extern void unpack0_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1221 const gfc_array_l1 *mask, const GFC_COMPLEX_10 *); 1222 internal_proto(unpack0_c10); 1223 1224 #endif 1225 1226 #ifdef HAVE_GFC_COMPLEX_16 1227 1228 extern void unpack0_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1229 const gfc_array_l1 *, const GFC_COMPLEX_16 *); 1230 internal_proto(unpack0_c16); 1231 1232 #endif 1233 1234 #ifdef HAVE_GFC_COMPLEX_17 1235 1236 extern void unpack0_c17 (gfc_array_c17 *, const gfc_array_c17 *, 1237 const gfc_array_l1 *, const GFC_COMPLEX_17 *); 1238 internal_proto(unpack0_c17); 1239 1240 #endif 1241 1242 extern void unpack1_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1243 const gfc_array_l1 *, const gfc_array_i1 *); 1244 internal_proto(unpack1_i1); 1245 1246 extern void unpack1_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1247 const gfc_array_l1 *, const gfc_array_i2 *); 1248 internal_proto(unpack1_i2); 1249 1250 extern void unpack1_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1251 const gfc_array_l1 *, const gfc_array_i4 *); 1252 internal_proto(unpack1_i4); 1253 1254 extern void unpack1_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1255 const gfc_array_l1 *, const gfc_array_i8 *); 1256 internal_proto(unpack1_i8); 1257 1258 #ifdef HAVE_GFC_INTEGER_16 1259 extern void unpack1_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1260 const gfc_array_l1 *, const gfc_array_i16 *); 1261 internal_proto(unpack1_i16); 1262 #endif 1263 1264 extern void unpack1_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1265 const gfc_array_l1 *, const gfc_array_r4 *); 1266 internal_proto(unpack1_r4); 1267 1268 extern void unpack1_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1269 const gfc_array_l1 *, const gfc_array_r8 *); 1270 internal_proto(unpack1_r8); 1271 1272 #ifdef HAVE_GFC_REAL_10 1273 extern void unpack1_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1274 const gfc_array_l1 *, const gfc_array_r10 *); 1275 internal_proto(unpack1_r10); 1276 #endif 1277 1278 #ifdef HAVE_GFC_REAL_16 1279 extern void unpack1_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1280 const gfc_array_l1 *, const gfc_array_r16 *); 1281 internal_proto(unpack1_r16); 1282 #endif 1283 1284 #ifdef HAVE_GFC_REAL_17 1285 extern void unpack1_r17 (gfc_array_r17 *, const gfc_array_r17 *, 1286 const gfc_array_l1 *, const gfc_array_r17 *); 1287 internal_proto(unpack1_r17); 1288 #endif 1289 1290 extern void unpack1_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1291 const gfc_array_l1 *, const gfc_array_c4 *); 1292 internal_proto(unpack1_c4); 1293 1294 extern void unpack1_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1295 const gfc_array_l1 *, const gfc_array_c8 *); 1296 internal_proto(unpack1_c8); 1297 1298 #ifdef HAVE_GFC_COMPLEX_10 1299 extern void unpack1_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1300 const gfc_array_l1 *, const gfc_array_c10 *); 1301 internal_proto(unpack1_c10); 1302 #endif 1303 1304 #ifdef HAVE_GFC_COMPLEX_16 1305 extern void unpack1_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1306 const gfc_array_l1 *, const gfc_array_c16 *); 1307 internal_proto(unpack1_c16); 1308 #endif 1309 1310 #ifdef HAVE_GFC_COMPLEX_17 1311 extern void unpack1_c17 (gfc_array_c17 *, const gfc_array_c17 *, 1312 const gfc_array_l1 *, const gfc_array_c17 *); 1313 internal_proto(unpack1_c17); 1314 #endif 1315 1316 /* Helper functions for spread. */ 1317 1318 extern void spread_i1 (gfc_array_i1 *, const gfc_array_i1 *, 1319 const index_type, const index_type); 1320 internal_proto(spread_i1); 1321 1322 extern void spread_i2 (gfc_array_i2 *, const gfc_array_i2 *, 1323 const index_type, const index_type); 1324 internal_proto(spread_i2); 1325 1326 extern void spread_i4 (gfc_array_i4 *, const gfc_array_i4 *, 1327 const index_type, const index_type); 1328 internal_proto(spread_i4); 1329 1330 extern void spread_i8 (gfc_array_i8 *, const gfc_array_i8 *, 1331 const index_type, const index_type); 1332 internal_proto(spread_i8); 1333 1334 #ifdef HAVE_GFC_INTEGER_16 1335 extern void spread_i16 (gfc_array_i16 *, const gfc_array_i16 *, 1336 const index_type, const index_type); 1337 internal_proto(spread_i16); 1338 1339 #endif 1340 1341 extern void spread_r4 (gfc_array_r4 *, const gfc_array_r4 *, 1342 const index_type, const index_type); 1343 internal_proto(spread_r4); 1344 1345 extern void spread_r8 (gfc_array_r8 *, const gfc_array_r8 *, 1346 const index_type, const index_type); 1347 internal_proto(spread_r8); 1348 1349 #ifdef HAVE_GFC_REAL_10 1350 extern void spread_r10 (gfc_array_r10 *, const gfc_array_r10 *, 1351 const index_type, const index_type); 1352 internal_proto(spread_r10); 1353 1354 #endif 1355 1356 #ifdef HAVE_GFC_REAL_16 1357 extern void spread_r16 (gfc_array_r16 *, const gfc_array_r16 *, 1358 const index_type, const index_type); 1359 internal_proto(spread_r16); 1360 1361 #endif 1362 1363 #ifdef HAVE_GFC_REAL_17 1364 extern void spread_r17 (gfc_array_r17 *, const gfc_array_r17 *, 1365 const index_type, const index_type); 1366 internal_proto(spread_r17); 1367 1368 #endif 1369 1370 extern void spread_c4 (gfc_array_c4 *, const gfc_array_c4 *, 1371 const index_type, const index_type); 1372 internal_proto(spread_c4); 1373 1374 extern void spread_c8 (gfc_array_c8 *, const gfc_array_c8 *, 1375 const index_type, const index_type); 1376 internal_proto(spread_c8); 1377 1378 #ifdef HAVE_GFC_COMPLEX_10 1379 extern void spread_c10 (gfc_array_c10 *, const gfc_array_c10 *, 1380 const index_type, const index_type); 1381 internal_proto(spread_c10); 1382 1383 #endif 1384 1385 #ifdef HAVE_GFC_COMPLEX_16 1386 extern void spread_c16 (gfc_array_c16 *, const gfc_array_c16 *, 1387 const index_type, const index_type); 1388 internal_proto(spread_c16); 1389 1390 #endif 1391 1392 #ifdef HAVE_GFC_COMPLEX_17 1393 extern void spread_c17 (gfc_array_c17 *, const gfc_array_c17 *, 1394 const index_type, const index_type); 1395 internal_proto(spread_c17); 1396 1397 #endif 1398 1399 extern void spread_scalar_i1 (gfc_array_i1 *, const GFC_INTEGER_1 *, 1400 const index_type, const index_type); 1401 internal_proto(spread_scalar_i1); 1402 1403 extern void spread_scalar_i2 (gfc_array_i2 *, const GFC_INTEGER_2 *, 1404 const index_type, const index_type); 1405 internal_proto(spread_scalar_i2); 1406 1407 extern void spread_scalar_i4 (gfc_array_i4 *, const GFC_INTEGER_4 *, 1408 const index_type, const index_type); 1409 internal_proto(spread_scalar_i4); 1410 1411 extern void spread_scalar_i8 (gfc_array_i8 *, const GFC_INTEGER_8 *, 1412 const index_type, const index_type); 1413 internal_proto(spread_scalar_i8); 1414 1415 #ifdef HAVE_GFC_INTEGER_16 1416 extern void spread_scalar_i16 (gfc_array_i16 *, const GFC_INTEGER_16 *, 1417 const index_type, const index_type); 1418 internal_proto(spread_scalar_i16); 1419 1420 #endif 1421 1422 extern void spread_scalar_r4 (gfc_array_r4 *, const GFC_REAL_4 *, 1423 const index_type, const index_type); 1424 internal_proto(spread_scalar_r4); 1425 1426 extern void spread_scalar_r8 (gfc_array_r8 *, const GFC_REAL_8 *, 1427 const index_type, const index_type); 1428 internal_proto(spread_scalar_r8); 1429 1430 #ifdef HAVE_GFC_REAL_10 1431 extern void spread_scalar_r10 (gfc_array_r10 *, const GFC_REAL_10 *, 1432 const index_type, const index_type); 1433 internal_proto(spread_scalar_r10); 1434 1435 #endif 1436 1437 #ifdef HAVE_GFC_REAL_16 1438 extern void spread_scalar_r16 (gfc_array_r16 *, const GFC_REAL_16 *, 1439 const index_type, const index_type); 1440 internal_proto(spread_scalar_r16); 1441 1442 #endif 1443 1444 #ifdef HAVE_GFC_REAL_17 1445 extern void spread_scalar_r17 (gfc_array_r17 *, const GFC_REAL_17 *, 1446 const index_type, const index_type); 1447 internal_proto(spread_scalar_r17); 1448 1449 #endif 1450 1451 extern void spread_scalar_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *, 1452 const index_type, const index_type); 1453 internal_proto(spread_scalar_c4); 1454 1455 extern void spread_scalar_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *, 1456 const index_type, const index_type); 1457 internal_proto(spread_scalar_c8); 1458 1459 #ifdef HAVE_GFC_COMPLEX_10 1460 extern void spread_scalar_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *, 1461 const index_type, const index_type); 1462 internal_proto(spread_scalar_c10); 1463 1464 #endif 1465 1466 #ifdef HAVE_GFC_COMPLEX_16 1467 extern void spread_scalar_c16 (gfc_array_c16 *, const GFC_COMPLEX_16 *, 1468 const index_type, const index_type); 1469 internal_proto(spread_scalar_c16); 1470 1471 #endif 1472 1473 #ifdef HAVE_GFC_COMPLEX_17 1474 extern void spread_scalar_c17 (gfc_array_c17 *, const GFC_COMPLEX_17 *, 1475 const index_type, const index_type); 1476 internal_proto(spread_scalar_c17); 1477 1478 #endif 1479 1480 /* string_intrinsics.c */ 1481 1482 extern int compare_string (gfc_charlen_type, const char *, 1483 gfc_charlen_type, const char *); 1484 iexport_proto(compare_string); 1485 1486 extern int compare_string_char4 (gfc_charlen_type, const gfc_char4_t *, 1487 gfc_charlen_type, const gfc_char4_t *); 1488 iexport_proto(compare_string_char4); 1489 1490 extern int memcmp_char4 (const void *, const void *, size_t); 1491 internal_proto(memcmp_char4); 1492 1493 1494 /* random.c */ 1495 1496 extern void random_seed_i4 (GFC_INTEGER_4 * size, gfc_array_i4 * put, 1497 gfc_array_i4 * get); 1498 iexport_proto(random_seed_i4); 1499 extern void random_seed_i8 (GFC_INTEGER_8 * size, gfc_array_i8 * put, 1500 gfc_array_i8 * get); 1501 iexport_proto(random_seed_i8); 1502 1503 /* size.c */ 1504 1505 typedef GFC_ARRAY_DESCRIPTOR (void) array_t; 1506 1507 extern index_type size0 (const array_t * array); 1508 iexport_proto(size0); 1509 1510 /* is_contiguous.c */ 1511 1512 extern GFC_LOGICAL_4 is_contiguous0 (const array_t * const restrict array); 1513 iexport_proto(is_contiguous0); 1514 1515 /* bounds.c */ 1516 1517 extern void bounds_equal_extents (array_t *, array_t *, const char *, 1518 const char *); 1519 internal_proto(bounds_equal_extents); 1520 1521 extern void bounds_reduced_extents (array_t *, array_t *, int, const char *, 1522 const char *intrinsic); 1523 internal_proto(bounds_reduced_extents); 1524 1525 extern void bounds_iforeach_return (array_t *, array_t *, const char *); 1526 internal_proto(bounds_iforeach_return); 1527 1528 extern void bounds_ifunction_return (array_t *, const index_type *, 1529 const char *, const char *); 1530 internal_proto(bounds_ifunction_return); 1531 1532 extern index_type count_0 (const gfc_array_l1 *); 1533 1534 internal_proto(count_0); 1535 1536 /* Internal auxiliary functions for cshift */ 1537 1538 void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ptrdiff_t, int); 1539 internal_proto(cshift0_i1); 1540 1541 void cshift0_i2 (gfc_array_i2 *, const gfc_array_i2 *, ptrdiff_t, int); 1542 internal_proto(cshift0_i2); 1543 1544 void cshift0_i4 (gfc_array_i4 *, const gfc_array_i4 *, ptrdiff_t, int); 1545 internal_proto(cshift0_i4); 1546 1547 void cshift0_i8 (gfc_array_i8 *, const gfc_array_i8 *, ptrdiff_t, int); 1548 internal_proto(cshift0_i8); 1549 1550 #ifdef HAVE_GFC_INTEGER_16 1551 void cshift0_i16 (gfc_array_i16 *, const gfc_array_i16 *, ptrdiff_t, int); 1552 internal_proto(cshift0_i16); 1553 #endif 1554 1555 void cshift0_r4 (gfc_array_r4 *, const gfc_array_r4 *, ptrdiff_t, int); 1556 internal_proto(cshift0_r4); 1557 1558 void cshift0_r8 (gfc_array_r8 *, const gfc_array_r8 *, ptrdiff_t, int); 1559 internal_proto(cshift0_r8); 1560 1561 #ifdef HAVE_GFC_REAL_10 1562 void cshift0_r10 (gfc_array_r10 *, const gfc_array_r10 *, ptrdiff_t, int); 1563 internal_proto(cshift0_r10); 1564 #endif 1565 1566 #ifdef HAVE_GFC_REAL_16 1567 void cshift0_r16 (gfc_array_r16 *, const gfc_array_r16 *, ptrdiff_t, int); 1568 internal_proto(cshift0_r16); 1569 #endif 1570 1571 #ifdef HAVE_GFC_REAL_17 1572 void cshift0_r17 (gfc_array_r17 *, const gfc_array_r17 *, ptrdiff_t, int); 1573 internal_proto(cshift0_r17); 1574 #endif 1575 1576 void cshift0_c4 (gfc_array_c4 *, const gfc_array_c4 *, ptrdiff_t, int); 1577 internal_proto(cshift0_c4); 1578 1579 void cshift0_c8 (gfc_array_c8 *, const gfc_array_c8 *, ptrdiff_t, int); 1580 internal_proto(cshift0_c8); 1581 1582 #ifdef HAVE_GFC_COMPLEX_10 1583 void cshift0_c10 (gfc_array_c10 *, const gfc_array_c10 *, ptrdiff_t, int); 1584 internal_proto(cshift0_c10); 1585 #endif 1586 1587 #ifdef HAVE_GFC_COMPLEX_16 1588 void cshift0_c16 (gfc_array_c16 *, const gfc_array_c16 *, ptrdiff_t, int); 1589 internal_proto(cshift0_c16); 1590 #endif 1591 1592 #ifdef HAVE_GFC_COMPLEX_17 1593 void cshift0_c17 (gfc_array_c17 *, const gfc_array_c17 *, ptrdiff_t, int); 1594 internal_proto(cshift0_c17); 1595 #endif 1596 1597 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_1) 1598 void cshift1_4_i1 (gfc_array_i1 * const restrict, 1599 const gfc_array_i1 * const restrict, 1600 const gfc_array_i4 * const restrict, 1601 const GFC_INTEGER_4 * const restrict); 1602 internal_proto(cshift1_4_i1); 1603 #endif 1604 1605 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_2) 1606 void cshift1_4_i2 (gfc_array_i2 * const restrict, 1607 const gfc_array_i2 * const restrict, 1608 const gfc_array_i4 * const restrict, 1609 const GFC_INTEGER_4 * const restrict); 1610 internal_proto(cshift1_4_i2); 1611 #endif 1612 1613 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_4) 1614 void cshift1_4_i4 (gfc_array_i4 * const restrict, 1615 const gfc_array_i4 * const restrict, 1616 const gfc_array_i4 * const restrict, 1617 const GFC_INTEGER_4 * const restrict); 1618 internal_proto(cshift1_4_i4); 1619 #endif 1620 1621 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_8) 1622 void cshift1_4_i8 (gfc_array_i8 * const restrict, 1623 const gfc_array_i8 * const restrict, 1624 const gfc_array_i4 * const restrict, 1625 const GFC_INTEGER_4 * const restrict); 1626 internal_proto(cshift1_4_i8); 1627 #endif 1628 1629 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_INTEGER_16) 1630 void cshift1_4_i16 (gfc_array_i16 * const restrict, 1631 const gfc_array_i16 * const restrict, 1632 const gfc_array_i4 * const restrict, 1633 const GFC_INTEGER_4 * const restrict); 1634 internal_proto(cshift1_4_i16); 1635 #endif 1636 1637 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_1) 1638 void cshift1_8_i1 (gfc_array_i1 * const restrict, 1639 const gfc_array_i1 * const restrict, 1640 const gfc_array_i8 * const restrict, 1641 const GFC_INTEGER_8 * const restrict); 1642 internal_proto(cshift1_8_i1); 1643 #endif 1644 1645 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_2) 1646 void cshift1_8_i2 (gfc_array_i2 * const restrict, 1647 const gfc_array_i2 * const restrict, 1648 const gfc_array_i8 * const restrict, 1649 const GFC_INTEGER_8 * const restrict); 1650 internal_proto(cshift1_8_i2); 1651 #endif 1652 1653 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_4) 1654 void cshift1_8_i4 (gfc_array_i4 * const restrict, 1655 const gfc_array_i4 * const restrict, 1656 const gfc_array_i8 * const restrict, 1657 const GFC_INTEGER_8 * const restrict); 1658 internal_proto(cshift1_8_i4); 1659 #endif 1660 1661 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_8) 1662 void cshift1_8_i8 (gfc_array_i8 * const restrict, 1663 const gfc_array_i8 * const restrict, 1664 const gfc_array_i8 * const restrict, 1665 const GFC_INTEGER_8 * const restrict); 1666 internal_proto(cshift1_8_i8); 1667 #endif 1668 1669 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_INTEGER_16) 1670 void cshift1_8_i16 (gfc_array_i16 * const restrict, 1671 const gfc_array_i16 * const restrict, 1672 const gfc_array_i8 * const restrict, 1673 const GFC_INTEGER_8 * const restrict); 1674 internal_proto(cshift1_8_i16); 1675 #endif 1676 1677 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_1) 1678 void cshift1_16_i1 (gfc_array_i1 * const restrict, 1679 const gfc_array_i1 * const restrict, 1680 const gfc_array_i16 * const restrict, 1681 const GFC_INTEGER_16 * const restrict); 1682 internal_proto(cshift1_16_i1); 1683 #endif 1684 1685 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_2) 1686 void cshift1_16_i2 (gfc_array_i2 * const restrict, 1687 const gfc_array_i2 * const restrict, 1688 const gfc_array_i16 * const restrict, 1689 const GFC_INTEGER_16 * const restrict); 1690 internal_proto(cshift1_16_i2); 1691 #endif 1692 1693 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_4) 1694 void cshift1_16_i4 (gfc_array_i4 * const restrict, 1695 const gfc_array_i4 * const restrict, 1696 const gfc_array_i16 * const restrict, 1697 const GFC_INTEGER_16 * const restrict); 1698 internal_proto(cshift1_16_i4); 1699 #endif 1700 1701 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_8) 1702 void cshift1_16_i8 (gfc_array_i8 * const restrict, 1703 const gfc_array_i8 * const restrict, 1704 const gfc_array_i16 * const restrict, 1705 const GFC_INTEGER_16 * const restrict); 1706 internal_proto(cshift1_16_i8); 1707 #endif 1708 1709 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_INTEGER_16) 1710 void cshift1_16_i16 (gfc_array_i16 * const restrict, 1711 const gfc_array_i16 * const restrict, 1712 const gfc_array_i16 * const restrict, 1713 const GFC_INTEGER_16 * const restrict); 1714 internal_proto(cshift1_16_i16); 1715 #endif 1716 1717 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_4) 1718 void cshift1_4_r4 (gfc_array_r4 * const restrict, 1719 const gfc_array_r4 * const restrict, 1720 const gfc_array_i4 * const restrict, 1721 const GFC_INTEGER_4 * const restrict); 1722 internal_proto(cshift1_4_r4); 1723 #endif 1724 1725 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_8) 1726 void cshift1_4_r8 (gfc_array_r8 * const restrict, 1727 const gfc_array_r8 * const restrict, 1728 const gfc_array_i4 * const restrict, 1729 const GFC_INTEGER_4 * const restrict); 1730 internal_proto(cshift1_4_r8); 1731 #endif 1732 1733 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_10) 1734 void cshift1_4_r10 (gfc_array_r10 * const restrict, 1735 const gfc_array_r10 * const restrict, 1736 const gfc_array_i4 * const restrict, 1737 const GFC_INTEGER_4 * const restrict); 1738 internal_proto(cshift1_4_r10); 1739 #endif 1740 1741 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_16) 1742 void cshift1_4_r16 (gfc_array_r16 * const restrict, 1743 const gfc_array_r16 * const restrict, 1744 const gfc_array_i4 * const restrict, 1745 const GFC_INTEGER_4 * const restrict); 1746 internal_proto(cshift1_4_r16); 1747 #endif 1748 1749 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_REAL_17) 1750 void cshift1_4_r17 (gfc_array_r17 * const restrict, 1751 const gfc_array_r17 * const restrict, 1752 const gfc_array_i4 * const restrict, 1753 const GFC_INTEGER_4 * const restrict); 1754 internal_proto(cshift1_4_r17); 1755 #endif 1756 1757 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_4) 1758 void cshift1_8_r4 (gfc_array_r4 * const restrict, 1759 const gfc_array_r4 * const restrict, 1760 const gfc_array_i8 * const restrict, 1761 const GFC_INTEGER_8 * const restrict); 1762 internal_proto(cshift1_8_r4); 1763 #endif 1764 1765 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_8) 1766 void cshift1_8_r8 (gfc_array_r8 * const restrict, 1767 const gfc_array_r8 * const restrict, 1768 const gfc_array_i8 * const restrict, 1769 const GFC_INTEGER_8 * const restrict); 1770 internal_proto(cshift1_8_r8); 1771 #endif 1772 1773 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_10) 1774 void cshift1_8_r10 (gfc_array_r10 * const restrict, 1775 const gfc_array_r10 * const restrict, 1776 const gfc_array_i8 * const restrict, 1777 const GFC_INTEGER_8 * const restrict); 1778 internal_proto(cshift1_8_r10); 1779 #endif 1780 1781 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_16) 1782 void cshift1_8_r16 (gfc_array_r16 * const restrict, 1783 const gfc_array_r16 * const restrict, 1784 const gfc_array_i8 * const restrict, 1785 const GFC_INTEGER_8 * const restrict); 1786 internal_proto(cshift1_8_r16); 1787 #endif 1788 1789 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_REAL_17) 1790 void cshift1_8_r17 (gfc_array_r17 * const restrict, 1791 const gfc_array_r17 * const restrict, 1792 const gfc_array_i8 * const restrict, 1793 const GFC_INTEGER_8 * const restrict); 1794 internal_proto(cshift1_8_r17); 1795 #endif 1796 1797 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_4) 1798 void cshift1_16_r4 (gfc_array_r4 * const restrict, 1799 const gfc_array_r4 * const restrict, 1800 const gfc_array_i16 * const restrict, 1801 const GFC_INTEGER_16 * const restrict); 1802 internal_proto(cshift1_16_r4); 1803 #endif 1804 1805 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_8) 1806 void cshift1_16_r8 (gfc_array_r8 * const restrict, 1807 const gfc_array_r8 * const restrict, 1808 const gfc_array_i16 * const restrict, 1809 const GFC_INTEGER_16 * const restrict); 1810 internal_proto(cshift1_16_r8); 1811 #endif 1812 1813 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_10) 1814 void cshift1_16_r10 (gfc_array_r10 * const restrict, 1815 const gfc_array_r10 * const restrict, 1816 const gfc_array_i16 * const restrict, 1817 const GFC_INTEGER_16 * const restrict); 1818 internal_proto(cshift1_16_r10); 1819 #endif 1820 1821 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_16) 1822 void cshift1_16_r16 (gfc_array_r16 * const restrict, 1823 const gfc_array_r16 * const restrict, 1824 const gfc_array_i16 * const restrict, 1825 const GFC_INTEGER_16 * const restrict); 1826 internal_proto(cshift1_16_r16); 1827 #endif 1828 1829 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_REAL_17) 1830 void cshift1_16_r17 (gfc_array_r17 * const restrict, 1831 const gfc_array_r17 * const restrict, 1832 const gfc_array_i16 * const restrict, 1833 const GFC_INTEGER_16 * const restrict); 1834 internal_proto(cshift1_16_r17); 1835 #endif 1836 1837 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_4) 1838 void cshift1_4_c4 (gfc_array_c4 * const restrict, 1839 const gfc_array_c4 * const restrict, 1840 const gfc_array_i4 * const restrict, 1841 const GFC_INTEGER_4 * const restrict); 1842 internal_proto(cshift1_4_c4); 1843 #endif 1844 1845 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_8) 1846 void cshift1_4_c8 (gfc_array_c8 * const restrict, 1847 const gfc_array_c8 * const restrict, 1848 const gfc_array_i4 * const restrict, 1849 const GFC_INTEGER_4 * const restrict); 1850 internal_proto(cshift1_4_c8); 1851 #endif 1852 1853 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_10) 1854 void cshift1_4_c10 (gfc_array_c10 * const restrict, 1855 const gfc_array_c10 * const restrict, 1856 const gfc_array_i4 * const restrict, 1857 const GFC_INTEGER_4 * const restrict); 1858 internal_proto(cshift1_4_c10); 1859 #endif 1860 1861 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_16) 1862 void cshift1_4_c16 (gfc_array_c16 * const restrict, 1863 const gfc_array_c16 * const restrict, 1864 const gfc_array_i4 * const restrict, 1865 const GFC_INTEGER_4 * const restrict); 1866 internal_proto(cshift1_4_c16); 1867 #endif 1868 1869 #if defined (HAVE_GFC_INTEGER_4) && defined (HAVE_GFC_COMPLEX_17) 1870 void cshift1_4_c17 (gfc_array_c17 * const restrict, 1871 const gfc_array_c17 * const restrict, 1872 const gfc_array_i4 * const restrict, 1873 const GFC_INTEGER_4 * const restrict); 1874 internal_proto(cshift1_4_c17); 1875 #endif 1876 1877 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_4) 1878 void cshift1_8_c4 (gfc_array_c4 * const restrict, 1879 const gfc_array_c4 * const restrict, 1880 const gfc_array_i8 * const restrict, 1881 const GFC_INTEGER_8 * const restrict); 1882 internal_proto(cshift1_8_c4); 1883 #endif 1884 1885 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_8) 1886 void cshift1_8_c8 (gfc_array_c8 * const restrict, 1887 const gfc_array_c8 * const restrict, 1888 const gfc_array_i8 * const restrict, 1889 const GFC_INTEGER_8 * const restrict); 1890 internal_proto(cshift1_8_c8); 1891 #endif 1892 1893 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_10) 1894 void cshift1_8_c10 (gfc_array_c10 * const restrict, 1895 const gfc_array_c10 * const restrict, 1896 const gfc_array_i8 * const restrict, 1897 const GFC_INTEGER_8 * const restrict); 1898 internal_proto(cshift1_8_c10); 1899 #endif 1900 1901 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_16) 1902 void cshift1_8_c16 (gfc_array_c16 * const restrict, 1903 const gfc_array_c16 * const restrict, 1904 const gfc_array_i8 * const restrict, 1905 const GFC_INTEGER_8 * const restrict); 1906 internal_proto(cshift1_8_c16); 1907 #endif 1908 1909 #if defined (HAVE_GFC_INTEGER_8) && defined (HAVE_GFC_COMPLEX_17) 1910 void cshift1_8_c17 (gfc_array_c17 * const restrict, 1911 const gfc_array_c17 * const restrict, 1912 const gfc_array_i8 * const restrict, 1913 const GFC_INTEGER_8 * const restrict); 1914 internal_proto(cshift1_8_c17); 1915 #endif 1916 1917 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_4) 1918 void cshift1_16_c4 (gfc_array_c4 * const restrict, 1919 const gfc_array_c4 * const restrict, 1920 const gfc_array_i16 * const restrict, 1921 const GFC_INTEGER_16 * const restrict); 1922 internal_proto(cshift1_16_c4); 1923 #endif 1924 1925 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_8) 1926 void cshift1_16_c8 (gfc_array_c8 * const restrict, 1927 const gfc_array_c8 * const restrict, 1928 const gfc_array_i16 * const restrict, 1929 const GFC_INTEGER_16 * const restrict); 1930 internal_proto(cshift1_16_c8); 1931 #endif 1932 1933 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_10) 1934 void cshift1_16_c10 (gfc_array_c10 * const restrict, 1935 const gfc_array_c10 * const restrict, 1936 const gfc_array_i16 * const restrict, 1937 const GFC_INTEGER_16 * const restrict); 1938 internal_proto(cshift1_16_c10); 1939 #endif 1940 1941 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_16) 1942 void cshift1_16_c16 (gfc_array_c16 * const restrict, 1943 const gfc_array_c16 * const restrict, 1944 const gfc_array_i16 * const restrict, 1945 const GFC_INTEGER_16 * const restrict); 1946 internal_proto(cshift1_16_c16); 1947 #endif 1948 1949 #if defined (HAVE_GFC_INTEGER_16) && defined (HAVE_GFC_COMPLEX_17) 1950 void cshift1_16_c17 (gfc_array_c17 * const restrict, 1951 const gfc_array_c17 * const restrict, 1952 const gfc_array_i16 * const restrict, 1953 const GFC_INTEGER_16 * const restrict); 1954 internal_proto(cshift1_16_c17); 1955 #endif 1956 1957 /* Prototypes for the POWER __ieee128 functions. */ 1958 #ifdef POWER_IEEE128 1959 extern __float128 __acoshieee128 (__float128) 1960 __attribute__ ((__nothrow__, __leaf__)); 1961 extern __float128 __acosieee128 (__float128) 1962 __attribute__ ((__nothrow__, __leaf__)); 1963 extern __float128 __asinhieee128 (__float128) 1964 __attribute__ ((__nothrow__, __leaf__)); 1965 extern __float128 __asinieee128 (__float128) 1966 __attribute__ ((__nothrow__, __leaf__)); 1967 extern __float128 __atan2ieee128 (__float128) 1968 __attribute__ ((__nothrow__, __leaf__)); 1969 extern __float128 __atanhieee128 (__float128) 1970 __attribute__ ((__nothrow__, __leaf__)); 1971 extern __float128 __atanieee128 (__float128) 1972 __attribute__ ((__nothrow__, __leaf__)); 1973 extern __float128 __copysignieee128 (__float128, __float128) 1974 __attribute__ ((__nothrow__, __leaf__)); 1975 extern __float128 __coshieee128 (__float128) 1976 __attribute__ ((__nothrow__, __leaf__)); 1977 extern __float128 __cosieee128 (__float128) 1978 __attribute__ ((__nothrow__, __leaf__)); 1979 extern __float128 __erfcieee128 (__float128) 1980 __attribute__ ((__nothrow__, __leaf__)); 1981 extern __float128 __erfieee128 (__float128) 1982 __attribute__ ((__nothrow__, __leaf__)); 1983 extern __float128 __expieee128 (__float128) 1984 __attribute__ ((__nothrow__, __leaf__)); 1985 extern __float128 __fabsieee128 (__float128) 1986 __attribute__ ((__nothrow__, __leaf__)); 1987 extern __float128 __fmaieee128 (__float128, __float128, __float128) 1988 __attribute__ ((__nothrow__, __leaf__)); 1989 extern __float128 __fmodieee128 (__float128, __float128) 1990 __attribute__ ((__nothrow__, __leaf__)); 1991 extern __float128 __jnieee128 (int, __float128) 1992 __attribute__ ((__nothrow__, __leaf__)); 1993 extern __float128 __log10ieee128 (__float128) 1994 __attribute__ ((__nothrow__, __leaf__)); 1995 extern __float128 __logieee128 (__float128) 1996 __attribute__ ((__nothrow__, __leaf__)); 1997 extern __float128 __powieee128 (__float128) 1998 __attribute__ ((__nothrow__, __leaf__)); 1999 extern __float128 __sinhieee128 (__float128) 2000 __attribute__ ((__nothrow__, __leaf__)); 2001 extern __float128 __sinieee128 (__float128) 2002 __attribute__ ((__nothrow__, __leaf__)); 2003 extern __float128 __sqrtieee128 (__float128) 2004 __attribute__ ((__nothrow__, __leaf__)); 2005 extern __float128 __tanhieee128 (__float128) 2006 __attribute__ ((__nothrow__, __leaf__)); 2007 extern __float128 __tanieee128 (__float128) 2008 __attribute__ ((__nothrow__, __leaf__)); 2009 extern __float128 __ynieee128 (int , __float128) 2010 __attribute__ ((__nothrow__, __leaf__)); 2011 extern __float128 __strtoieee128 (const char *, char **) 2012 __attribute__ ((__nothrow__, __leaf__)); 2013 extern int __snprintfieee128 (char *, size_t, const char *, ...) 2014 __attribute__ ((__nothrow__)); 2015 2016 #endif 2017 2018 /* We always have these. */ 2019 2020 #define HAVE_GFC_UINTEGER_1 1 2021 #define HAVE_GFC_UINTEGER_4 1 2022 2023 #endif /* LIBGFOR_H */ 2024
Indexes created Tue Feb 24 01:34:59 UTC 2026