-/* Copyright (C) 2002-2014 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2024 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
<http://www.gnu.org/licenses/>. */
#include "libgfortran.h"
+#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. */
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
+}