-/* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2022 Free Software Foundation, Inc.
Contributed by Paul Brook
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-You should have received a copy of the GNU General Public License
-along with libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
-#include "config.h"
-#include <string.h>
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
-
-/* Compare a C-style string with a fortran style string in a case-insensitive
- manner. Used for decoding string options to various statements. Returns
- zero if not equal, nonzero if equal. */
-
-static int
-compare0 (const char *s1, gfc_charlen_type s1_len, const char *s2)
-{
- size_t len;
-
- /* Strip trailing blanks from the Fortran string. */
- len = fstrlen (s1, s1_len);
- if (len != strlen(s2)) return 0; /* don't match */
- return strncasecmp (s1, s2, len) == 0;
-}
+#include <assert.h>
+#include <string.h>
+#include <strings.h>
/* Given a fortran string, return its length exclusive of the trailing
}
+#ifndef HAVE_STRNLEN
+static size_t
+strnlen (const char *s, size_t maxlen)
+{
+ for (size_t ii = 0; ii < maxlen; ii++)
+ {
+ if (s[ii] == '\0')
+ return ii;
+ }
+ return maxlen;
+}
+#endif
+
+
+#ifndef HAVE_STRNDUP
+static char *
+strndup (const char *s, size_t n)
+{
+ size_t len = strnlen (s, n);
+ char *p = malloc (len + 1);
+ if (!p)
+ return NULL;
+ memcpy (p, s, len);
+ p[len] = '\0';
+ return p;
+}
+#endif
+
+
+/* Duplicate a non-null-terminated Fortran string to a malloced
+ null-terminated C string. */
+
+char *
+fc_strdup (const char *src, gfc_charlen_type src_len)
+{
+ gfc_charlen_type n = fstrlen (src, src_len);
+ char *p = strndup (src, n);
+ if (!p)
+ os_error ("Memory allocation failed in fc_strdup");
+ return p;
+}
+
+
+/* Duplicate a non-null-terminated Fortran string to a malloced
+ null-terminated C string, without getting rid of trailing
+ blanks. */
+
+char *
+fc_strdup_notrim (const char *src, gfc_charlen_type src_len)
+{
+ char *p = strndup (src, src_len);
+ if (!p)
+ os_error ("Memory allocation failed in fc_strdup");
+ return p;
+}
+
+
/* Given a fortran string and an array of st_option structures, search through
the array to find a match. If the option is not found, we generate an error
if no default is provided. */
find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len,
const st_option * opts, const char *error_message)
{
+ /* Strip trailing blanks from the Fortran string. */
+ size_t len = (size_t) fstrlen (s1, s1_len);
+
for (; opts->name; opts++)
- if (compare0 (s1, s1_len, opts->name))
+ if (len == strlen(opts->name) && strncasecmp (s1, opts->name, len) == 0)
return opts->value;
- generate_error (cmp, ERROR_BAD_OPTION, error_message);
+ generate_error (cmp, LIBERROR_BAD_OPTION, error_message);
return -1;
}
+
+
+/* Fast helper function for a positive value that fits in uint64_t. */
+
+static inline char *
+itoa64 (uint64_t n, char *p)
+{
+ while (n != 0)
+ {
+ *--p = '0' + (n % 10);
+ n /= 10;
+ }
+ return p;
+}
+
+
+#if defined(HAVE_GFC_INTEGER_16)
+# define TEN19 ((GFC_UINTEGER_LARGEST) 1000000 * (GFC_UINTEGER_LARGEST) 1000000 * (GFC_UINTEGER_LARGEST) 10000000)
+
+/* Same as itoa64(), with zero padding of 19 digits. */
+
+static inline char *
+itoa64_pad19 (uint64_t n, char *p)
+{
+ for (int k = 0; k < 19; k++)
+ {
+ *--p = '0' + (n % 10);
+ n /= 10;
+ }
+ return p;
+}
+#endif
+
+
+/* Integer to decimal conversion.
+
+ This function is much more restricted than the widespread (but
+ non-standard) itoa() function. This version has the following
+ characteristics:
+
+ - it takes only non-negative arguments
+ - it is async-signal-safe (we use it runtime/backtrace.c)
+ - it works in base 10 (see xtoa, otoa, btoa functions
+ in io/write.c for other radices)
+ */
+
+const char *
+gfc_itoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
+{
+ char *p;
+
+ if (len < GFC_ITOA_BUF_SIZE)
+ sys_abort ();
+
+ if (n == 0)
+ return "0";
+
+ p = buffer + GFC_ITOA_BUF_SIZE - 1;
+ *p = '\0';
+
+#if defined(HAVE_GFC_INTEGER_16)
+ /* On targets that have a 128-bit integer type, division in that type
+ is slow, because it occurs through a function call. We avoid that. */
+
+ if (n <= UINT64_MAX)
+ /* If the value fits in uint64_t, use the fast function. */
+ return itoa64 (n, p);
+ else
+ {
+ /* Otherwise, break down into smaller bits by division. Two calls to
+ the uint64_t function are not sufficient for all 128-bit unsigned
+ integers (we would need three calls), but they do suffice for all
+ values up to 2^127, which is the largest that Fortran can produce
+ (-HUGE(0_16)-1) with its signed integer types. */
+ _Static_assert (sizeof(GFC_UINTEGER_LARGEST) <= 2 * sizeof(uint64_t),
+ "integer too large");
+
+ GFC_UINTEGER_LARGEST r;
+ r = n % TEN19;
+ n = n / TEN19;
+ assert (r <= UINT64_MAX);
+ p = itoa64_pad19 (r, p);
+
+ assert(n <= UINT64_MAX);
+ return itoa64 (n, p);
+ }
+#else
+ /* On targets where the largest integer is 64-bit, just use that. */
+ return itoa64 (n, p);
+#endif
+}
projects / thirdparty / gcc.git / blobdiff