From patchwork Fri Dec 31 14:16:47 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jakub Jelinek X-Patchwork-Id: 49439 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3E493385802A for ; Fri, 31 Dec 2021 14:17:28 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3E493385802A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1640960248; bh=6V0ml3Z7MurWDq0fct1ALQv3DCc/3G5kaM+RKgGGmI8=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=WIUgbVIIT4FSg3Gi0bwg3lQ7/W6BacioL1aW3j1IHjT/ml3akVPzxiJ1wQjfYEWO+ wCDJySz3AqPkxHNBxnnUdu9VsjRhKtsp5sxrMmYmXfEnwxWkhiHlrp3/U7bVHtT1sH 1VMhrC2K1CuZzevsHEQYoMsll5kNSSgFo3qGZ+28= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from us-smtp-delivery-124.mimecast.com (us-smtp-delivery-124.mimecast.com [170.10.133.124]) by sourceware.org (Postfix) with ESMTPS id 0BDC33858C3A for ; Fri, 31 Dec 2021 14:16:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 0BDC33858C3A Received: from mimecast-mx01.redhat.com (mimecast-mx01.redhat.com [209.132.183.4]) by relay.mimecast.com with ESMTP with STARTTLS (version=TLSv1.2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id us-mta-482-wseptK3OP_2lZBR6ECWc-Q-1; Fri, 31 Dec 2021 09:16:53 -0500 X-MC-Unique: wseptK3OP_2lZBR6ECWc-Q-1 Received: from smtp.corp.redhat.com (int-mx07.intmail.prod.int.phx2.redhat.com [10.5.11.22]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by mimecast-mx01.redhat.com (Postfix) with ESMTPS id E4D6F1030C20; Fri, 31 Dec 2021 14:16:51 +0000 (UTC) Received: from tucnak.zalov.cz (unknown [10.2.16.169]) by smtp.corp.redhat.com (Postfix) with ESMTPS id 3DA671086484; Fri, 31 Dec 2021 14:16:50 +0000 (UTC) Received: from tucnak.zalov.cz (localhost [127.0.0.1]) by tucnak.zalov.cz (8.16.1/8.16.1) with ESMTPS id 1BVEGmZh1308441 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NOT); Fri, 31 Dec 2021 15:16:48 +0100 Received: (from jakub@localhost) by tucnak.zalov.cz (8.16.1/8.16.1/Submit) id 1BVEGlmG1308440; Fri, 31 Dec 2021 15:16:47 +0100 Date: Fri, 31 Dec 2021 15:16:47 +0100 To: Thomas Koenig Subject: [power-ieee128] gfortran: Introduce gfc_type_abi_kind Message-ID: <20211231141647.GH2664@tucnak> MIME-Version: 1.0 X-Scanned-By: MIMEDefang 2.84 on 10.5.11.22 X-Mimecast-Spam-Score: 0 X-Mimecast-Originator: redhat.com Content-Disposition: inline X-Spam-Status: No, score=-5.5 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Jakub Jelinek via Gcc-patches From: Jakub Jelinek Reply-To: Jakub Jelinek Cc: Michael Meissner , gcc-patches@gcc.gnu.org, fortran@gcc.gnu.org Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hi! The following patch detects the powerpc64le-linux kind == 16 cases and for the -mabi=ieeelongdouble case (no matter whether it is the configured in default or just option used on the command line) uses _r17 or _c17 instead of _r16 or _c17 in the library API names. From what I can see, e.g. calls to sin on real(kind = 16) works fine with or without this patch (we call __builtin_sinl and the backend uses rs6000_mangle_decl_assembler_name which ensures __sinieee128 is called). Haven't played enough with it to see if the various *_r17 or *_c17 API entrypoints are called (but verified abi_kind is right in the debugger), in all my attempts so far everything was emitted inline. What is clearly still broken is IO, where for real(kind=16) a a = 1.0 print *, a end we call _gfortran_transfer_real_write (&dt_parm.0, &a, 16); for both -mabi=ibmlongdouble and -mabi=ieeelongdouble I don't remember what was the agreement, do we want _gfortran_transfer_real_write (&dt_parm.0, &a, 17); for the ieeelongdouble case, or some new entrypoint for the abi_kind == 17 real/complex IO? Also, what about kind stored in array descriptors? Shall we use there the abi_kind or kind? I guess at least before the IO case is solved there is no point in checking the testsuite, too many things will be majorly broken... 2021-12-31 Jakub Jelinek * gfortran.h (gfc_real_info): Add abi_kind member. (gfc_type_abi_kind): Declare. * trans-types.c (gfc_init_kinds): Initialize abi_kind. * intrinsic.c (gfc_type_abi_kind): New function. (conv_name): Use it. * iresolve.c (resolve_transformational, gfc_resolve_abs, gfc_resolve_char_achar, gfc_resolve_acos, gfc_resolve_acosh, gfc_resolve_aimag, gfc_resolve_and, gfc_resolve_aint, gfc_resolve_all, gfc_resolve_anint, gfc_resolve_any, gfc_resolve_asin, gfc_resolve_asinh, gfc_resolve_atan, gfc_resolve_atanh, gfc_resolve_atan2, gfc_resolve_bessel_n2, gfc_resolve_ceiling, gfc_resolve_cmplx, gfc_resolve_complex, gfc_resolve_cos, gfc_resolve_cosh, gfc_resolve_count, gfc_resolve_dble, gfc_resolve_dim, gfc_resolve_dot_product, gfc_resolve_dprod, gfc_resolve_exp, gfc_resolve_floor, gfc_resolve_hypot, gfc_resolve_int, gfc_resolve_int2, gfc_resolve_int8, gfc_resolve_long, gfc_resolve_log, gfc_resolve_log10, gfc_resolve_logical, gfc_resolve_matmul, gfc_resolve_minmax, gfc_resolve_maxloc, gfc_resolve_findloc, gfc_resolve_maxval, gfc_resolve_merge, gfc_resolve_minloc, gfc_resolve_minval, gfc_resolve_mod, gfc_resolve_modulo, gfc_resolve_nearest, gfc_resolve_or, gfc_resolve_real, gfc_resolve_realpart, gfc_resolve_reshape, gfc_resolve_sign, gfc_resolve_sin, gfc_resolve_sinh, gfc_resolve_sqrt, gfc_resolve_tan, gfc_resolve_tanh, gfc_resolve_transpose, gfc_resolve_trigd, gfc_resolve_xor, gfc_resolve_random_number): Likewise. * trans-decl.c (gfc_build_intrinsic_function_decls): Use gfc_real_kinds[rkinds[rkind]].abi_kind instead of rkinds[rkind]. Jakub --- gcc/fortran/gfortran.h +++ gcc/fortran/gfortran.h @@ -2643,7 +2643,7 @@ extern gfc_logical_info gfc_logical_kinds[]; typedef struct { mpfr_t epsilon, huge, tiny, subnormal; - int kind, radix, digits, min_exponent, max_exponent; + int kind, abi_kind, radix, digits, min_exponent, max_exponent; int range, precision; /* The precision of the type as reported by GET_MODE_PRECISION. */ @@ -3499,6 +3499,7 @@ void gfc_intrinsic_init_1 (void); void gfc_intrinsic_done_1 (void); char gfc_type_letter (bt, bool logical_equals_int = false); +int gfc_type_abi_kind (gfc_typespec *); gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *); gfc_symbol *gfc_get_intrinsic_function_symbol (gfc_expr *); gfc_symbol *gfc_find_intrinsic_symbol (gfc_expr *); --- gcc/fortran/trans-types.c +++ gcc/fortran/trans-types.c @@ -363,6 +363,8 @@ gfc_init_kinds (void) int i_index, r_index, kind; bool saw_i4 = false, saw_i8 = false; bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false; + scalar_mode r16_mode = QImode; + scalar_mode composite_mode = QImode; i_index = 0; FOR_EACH_MODE_IN_CLASS (int_mode_iter, MODE_INT) @@ -428,6 +430,10 @@ gfc_init_kinds (void) if (!targetm.scalar_mode_supported_p (mode)) continue; + if (MODE_COMPOSITE_P (mode) + && (GET_MODE_PRECISION (mode) + 7) / 8 == 16) + composite_mode = mode; + /* Only let float, double, long double and TFmode go through. Runtime support for others is not provided, so they would be useless. */ @@ -471,7 +477,10 @@ gfc_init_kinds (void) if (kind == 10) saw_r10 = true; if (kind == 16) - saw_r16 = true; + { + saw_r16 = true; + r16_mode = mode; + } /* Careful we don't stumble a weird internal mode. */ gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind); @@ -479,6 +488,7 @@ gfc_init_kinds (void) gcc_assert (r_index != MAX_REAL_KINDS); gfc_real_kinds[r_index].kind = kind; + gfc_real_kinds[r_index].abi_kind = kind; gfc_real_kinds[r_index].radix = fmt->b; gfc_real_kinds[r_index].digits = fmt->p; gfc_real_kinds[r_index].min_exponent = fmt->emin; @@ -496,6 +506,19 @@ gfc_init_kinds (void) r_index += 1; } + /* Detect the powerpc64le-linux case with -mabi=ieeelongdouble, where + the long double type is non-MODE_COMPOSITE_P TFmode but one can use + -mabi=ibmlongdouble too and get MODE_COMPOSITE_P TFmode with the same + precision. For libgfortran calls pretend the IEEE 754 quad TFmode has + kind 17 rather than 16 and use kind 16 for the IBM extended format + TFmode. */ + if (composite_mode != QImode && saw_r16 && !MODE_COMPOSITE_P (r16_mode)) + { + for (int i = 0; i < r_index; ++i) + if (gfc_real_kinds[i].kind == 16) + gfc_real_kinds[i].abi_kind = 17; + } + /* Choose the default integer kind. We choose 4 unless the user directs us otherwise. Even if the user specified that the default integer kind is 8, the numeric storage size is not 64 bits. In this case, a warning will be --- gcc/fortran/intrinsic.c +++ gcc/fortran/intrinsic.c @@ -103,6 +103,24 @@ gfc_type_letter (bt type, bool logical_equals_int) } +/* Return kind that should be used for ABI purposes in libgfortran + APIs. Usually the same as ts->kind, except for BT_REAL/BT_COMPLEX + for IEEE 754 quad format kind 16 where it returns 17. */ + +int +gfc_type_abi_kind (gfc_typespec *ts) +{ + switch (ts->type) + { + case BT_REAL: + case BT_COMPLEX: + return gfc_real_kinds[ts->kind].abi_kind; + default: + return ts->kind; + } +} + + /* Get a symbol for a resolved name. Note, if needed be, the elemental attribute has be added afterwards. */ @@ -167,8 +185,8 @@ static const char * conv_name (gfc_typespec *from, gfc_typespec *to) { return gfc_get_string ("__convert_%c%d_%c%d", - gfc_type_letter (from->type), from->kind, - gfc_type_letter (to->type), to->kind); + gfc_type_letter (from->type), gfc_type_abi_kind (from), + gfc_type_letter (to->type), gfc_type_abi_kind (to)); } --- gcc/fortran/iresolve.c +++ gcc/fortran/iresolve.c @@ -191,7 +191,8 @@ resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array, f->value.function.name = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -206,7 +207,8 @@ gfc_resolve_abs (gfc_expr *f, gfc_expr *a) f->ts.type = BT_REAL; f->value.function.name - = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -256,7 +258,8 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, f->value.function.name = gfc_get_string ("__%schar_%d_%c%d", is_achar ? "a" : "", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -272,7 +275,8 @@ gfc_resolve_acos (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -282,7 +286,7 @@ gfc_resolve_acosh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -293,7 +297,7 @@ gfc_resolve_aimag (gfc_expr *f, gfc_expr *x) f->ts.kind = x->ts.kind; f->value.function.name = gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -312,7 +316,8 @@ gfc_resolve_and (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -334,7 +339,8 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) /* The resolved name is only used for specific intrinsics where the return kind is the same as the arg kind. */ f->value.function.name - = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -359,7 +365,7 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->value.function.name = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type), - mask->ts.kind); + gfc_type_abi_kind (&mask->ts)); } @@ -383,7 +389,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) the return kind is the same as the arg kind. */ f->value.function.name = gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type), - a->ts.kind); + gfc_type_abi_kind (&a->ts)); } @@ -408,7 +414,7 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->value.function.name = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type), - mask->ts.kind); + gfc_type_abi_kind (&mask->ts)); } @@ -417,7 +423,8 @@ gfc_resolve_asin (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } void @@ -426,7 +433,7 @@ gfc_resolve_asinh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } void @@ -434,7 +441,8 @@ gfc_resolve_atan (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } void @@ -443,7 +451,7 @@ gfc_resolve_atanh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } void @@ -452,7 +460,7 @@ gfc_resolve_atan2 (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) f->ts = x->ts; f->value.function.name = gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -507,10 +515,10 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x) if (f->value.function.isym->id == GFC_ISYM_JN2) f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); else f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } @@ -546,7 +554,8 @@ gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -618,12 +627,15 @@ gfc_resolve_cmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y, gfc_expr *kind) if (y == NULL) f->value.function.name = gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); else f->value.function.name = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind, - gfc_type_letter (y->ts.type), y->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts), + gfc_type_letter (y->ts.type), + gfc_type_abi_kind (&y->ts)); } @@ -659,8 +671,10 @@ gfc_resolve_complex (gfc_expr *f, gfc_expr *x, gfc_expr *y) f->ts.kind = kind; f->value.function.name = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind, - gfc_type_letter (y->ts.type), y->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts), + gfc_type_letter (y->ts.type), + gfc_type_abi_kind (&y->ts)); } @@ -677,7 +691,8 @@ gfc_resolve_cos (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -686,7 +701,8 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -709,7 +725,7 @@ gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) resolve_mask_arg (mask); f->value.function.name - = gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind, + = gfc_get_string (PREFIX ("count_%d_%c"), gfc_type_abi_kind (&f->ts), gfc_type_letter (mask->ts.type)); } @@ -810,7 +826,8 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a) f->ts.type = BT_REAL; f->ts.kind = gfc_default_double_kind; f->value.function.name - = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -832,7 +849,8 @@ gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) } f->value.function.name - = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -850,7 +868,8 @@ gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b) f->ts = temp.ts; f->value.function.name = gfc_get_string (PREFIX ("dot_product_%c%d"), - gfc_type_letter (f->ts.type), f->ts.kind); + gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -860,7 +879,8 @@ gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED, { f->ts.kind = gfc_default_double_kind; f->ts.type = BT_REAL; - f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind); + f->value.function.name = gfc_get_string ("__dprod_r%d", + gfc_type_abi_kind (&f->ts)); } @@ -951,7 +971,8 @@ gfc_resolve_exp (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -1044,7 +1065,8 @@ gfc_resolve_floor (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__floor%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1135,7 +1157,8 @@ void gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) { f->ts = x->ts; - f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind); + f->value.function.name = gfc_get_string ("__hypot_r%d", + gfc_type_abi_kind (&x->ts)); } @@ -1311,7 +1334,8 @@ gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1322,7 +1346,8 @@ gfc_resolve_int2 (gfc_expr *f, gfc_expr *a) f->ts.kind = 2; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1333,7 +1358,8 @@ gfc_resolve_int8 (gfc_expr *f, gfc_expr *a) f->ts.kind = 8; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1344,7 +1370,8 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a) f->ts.kind = 4; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1498,7 +1525,8 @@ gfc_resolve_log (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -1508,7 +1536,7 @@ gfc_resolve_log10 (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -1522,7 +1550,8 @@ gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind) f->value.function.name = gfc_get_string ("__logical_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1579,7 +1608,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b) f->value.function.name = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } @@ -1605,7 +1634,8 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args) } f->value.function.name - = gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string (name, gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -1689,7 +1719,8 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); if (kind) fkind = mpz_get_si (kind->value.integer); @@ -1806,7 +1837,8 @@ gfc_resolve_findloc (gfc_expr *f, gfc_expr *array, gfc_expr *value, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, d_num, - gfc_type_letter (array->ts.type, true), array->ts.kind); + gfc_type_letter (array->ts.type, true), + gfc_type_abi_kind (&array->ts)); /* We only have a single library function, so we need to convert here. If the function is resolved from within a convert @@ -1868,11 +1900,13 @@ gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, if (array->ts.type != BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); else f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -1926,7 +1960,7 @@ gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource, f->ts = tsource->ts; f->value.function.name = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type), - tsource->ts.kind); + gfc_type_abi_kind (&tsource->ts)); } @@ -2017,7 +2051,8 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); if (fkind != f->ts.kind) { @@ -2082,11 +2117,13 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, if (array->ts.type != BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); else f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -2108,7 +2145,8 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) } f->value.function.name - = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -2131,7 +2169,7 @@ gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) f->value.function.name = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } void @@ -2143,7 +2181,7 @@ gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p) f->ts = a->ts; f->value.function.name = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type), - a->ts.kind); + gfc_type_abi_kind (&a->ts)); } void @@ -2187,7 +2225,8 @@ gfc_resolve_or (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -2265,7 +2304,8 @@ gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind) f->value.function.name = gfc_get_string ("__real_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2276,7 +2316,8 @@ gfc_resolve_realpart (gfc_expr *f, gfc_expr *a) f->ts.kind = a->ts.kind; f->value.function.name = gfc_get_string ("__real_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2361,7 +2402,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape, f->value.function.name = gfc_get_string (PREFIX ("reshape_%c%d"), gfc_type_letter (source->ts.type), - source->ts.kind); + gfc_type_abi_kind (&source->ts)); else if (source->ts.type == BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"), kind); @@ -2506,7 +2547,8 @@ gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) { f->ts = a->ts; f->value.function.name - = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2536,7 +2578,8 @@ gfc_resolve_sin (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2545,7 +2588,8 @@ gfc_resolve_sinh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2639,7 +2683,8 @@ gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2803,7 +2848,8 @@ gfc_resolve_tan (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2812,7 +2858,8 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -3012,7 +3059,7 @@ gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix) f->value.function.name = gfc_get_string (PREFIX ("transpose_%c%d"), gfc_type_letter (matrix->ts.type), - matrix->ts.kind); + gfc_type_abi_kind (&matrix->ts)); break; case BT_INTEGER: @@ -3060,7 +3107,8 @@ gfc_resolve_trigd (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), f->value.function.isym->name, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -3188,7 +3236,8 @@ gfc_resolve_xor (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -3326,7 +3375,7 @@ gfc_resolve_random_number (gfc_code *c) const char *name; int kind; - kind = c->ext.actual->expr->ts.kind; + kind = gfc_type_abi_kind (&c->ext.actual->expr->ts); if (c->ext.actual->expr->rank == 0) name = gfc_get_string (PREFIX ("random_r%d"), kind); else --- gcc/fortran/trans-decl.c +++ gcc/fortran/trans-decl.c @@ -3602,8 +3602,9 @@ gfc_build_intrinsic_function_decls (void) rtype = gfc_get_real_type (rkinds[rkind]); if (rtype && itype) { - sprintf (name, PREFIX("pow_r%d_i%d"), rkinds[rkind], - ikinds[ikind]); + sprintf (name, PREFIX("pow_r%d_i%d"), + gfc_real_kinds[rkinds[rkind]].abi_kind, + ikinds[ikind]); gfor_fndecl_math_powi[rkind][ikind].real = gfc_build_library_function_decl (get_identifier (name), rtype, 2, rtype, itype); @@ -3614,8 +3615,9 @@ gfc_build_intrinsic_function_decls (void) ctype = gfc_get_complex_type (rkinds[rkind]); if (ctype && itype) { - sprintf (name, PREFIX("pow_c%d_i%d"), rkinds[rkind], - ikinds[ikind]); + sprintf (name, PREFIX("pow_c%d_i%d"), + gfc_real_kinds[rkinds[rkind]].abi_kind, + ikinds[ikind]); gfor_fndecl_math_powi[rkind][ikind].cmplx = gfc_build_library_function_decl (get_identifier (name), ctype, 2,ctype, itype);