string.c revision 1.1.1.3
1/* Copyright (C) 2002-2022 Free Software Foundation, Inc. 2 Contributed by Paul Brook 3 4This file is part of the GNU Fortran runtime library (libgfortran). 5 6Libgfortran is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 3, or (at your option) 9any later version. 10 11Libgfortran is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16Under Section 7 of GPL version 3, you are granted additional 17permissions described in the GCC Runtime Library Exception, version 183.1, as published by the Free Software Foundation. 19 20You should have received a copy of the GNU General Public License and 21a copy of the GCC Runtime Library Exception along with this program; 22see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 23<http://www.gnu.org/licenses/>. */ 24 25#include "libgfortran.h" 26#include <assert.h> 27#include <string.h> 28#include <strings.h> 29 30 31/* Given a fortran string, return its length exclusive of the trailing 32 spaces. */ 33 34gfc_charlen_type 35fstrlen (const char *string, gfc_charlen_type len) 36{ 37 for (; len > 0; len--) 38 if (string[len-1] != ' ') 39 break; 40 41 return len; 42} 43 44 45/* Copy a Fortran string (not null-terminated, hence length arguments 46 for both source and destination strings. Returns the non-padded 47 length of the destination. */ 48 49gfc_charlen_type 50fstrcpy (char *dest, gfc_charlen_type destlen, 51 const char *src, gfc_charlen_type srclen) 52{ 53 if (srclen >= destlen) 54 { 55 /* This will truncate if too long. */ 56 memcpy (dest, src, destlen); 57 return destlen; 58 } 59 else 60 { 61 memcpy (dest, src, srclen); 62 /* Pad with spaces. */ 63 memset (&dest[srclen], ' ', destlen - srclen); 64 return srclen; 65 } 66} 67 68 69/* Copy a null-terminated C string to a non-null-terminated Fortran 70 string. Returns the non-padded length of the destination string. */ 71 72gfc_charlen_type 73cf_strcpy (char *dest, gfc_charlen_type dest_len, const char *src) 74{ 75 size_t src_len; 76 77 src_len = strlen (src); 78 79 if (src_len >= (size_t) dest_len) 80 { 81 /* This will truncate if too long. */ 82 memcpy (dest, src, dest_len); 83 return dest_len; 84 } 85 else 86 { 87 memcpy (dest, src, src_len); 88 /* Pad with spaces. */ 89 memset (&dest[src_len], ' ', dest_len - src_len); 90 return src_len; 91 } 92} 93 94 95#ifndef HAVE_STRNLEN 96static size_t 97strnlen (const char *s, size_t maxlen) 98{ 99 for (size_t ii = 0; ii < maxlen; ii++) 100 { 101 if (s[ii] == '\0') 102 return ii; 103 } 104 return maxlen; 105} 106#endif 107 108 109#ifndef HAVE_STRNDUP 110static char * 111strndup (const char *s, size_t n) 112{ 113 size_t len = strnlen (s, n); 114 char *p = malloc (len + 1); 115 if (!p) 116 return NULL; 117 memcpy (p, s, len); 118 p[len] = '\0'; 119 return p; 120} 121#endif 122 123 124/* Duplicate a non-null-terminated Fortran string to a malloced 125 null-terminated C string. */ 126 127char * 128fc_strdup (const char *src, gfc_charlen_type src_len) 129{ 130 gfc_charlen_type n = fstrlen (src, src_len); 131 char *p = strndup (src, n); 132 if (!p) 133 os_error ("Memory allocation failed in fc_strdup"); 134 return p; 135} 136 137 138/* Duplicate a non-null-terminated Fortran string to a malloced 139 null-terminated C string, without getting rid of trailing 140 blanks. */ 141 142char * 143fc_strdup_notrim (const char *src, gfc_charlen_type src_len) 144{ 145 char *p = strndup (src, src_len); 146 if (!p) 147 os_error ("Memory allocation failed in fc_strdup"); 148 return p; 149} 150 151 152/* Given a fortran string and an array of st_option structures, search through 153 the array to find a match. If the option is not found, we generate an error 154 if no default is provided. */ 155 156int 157find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, 158 const st_option * opts, const char *error_message) 159{ 160 /* Strip trailing blanks from the Fortran string. */ 161 size_t len = (size_t) fstrlen (s1, s1_len); 162 163 for (; opts->name; opts++) 164 if (len == strlen(opts->name) && strncasecmp (s1, opts->name, len) == 0) 165 return opts->value; 166 167 generate_error (cmp, LIBERROR_BAD_OPTION, error_message); 168 169 return -1; 170} 171 172 173/* Fast helper function for a positive value that fits in uint64_t. */ 174 175static inline char * 176itoa64 (uint64_t n, char *p) 177{ 178 while (n != 0) 179 { 180 *--p = '0' + (n % 10); 181 n /= 10; 182 } 183 return p; 184} 185 186 187#if defined(HAVE_GFC_INTEGER_16) 188# define TEN19 ((GFC_UINTEGER_LARGEST) 1000000 * (GFC_UINTEGER_LARGEST) 1000000 * (GFC_UINTEGER_LARGEST) 10000000) 189 190/* Same as itoa64(), with zero padding of 19 digits. */ 191 192static inline char * 193itoa64_pad19 (uint64_t n, char *p) 194{ 195 for (int k = 0; k < 19; k++) 196 { 197 *--p = '0' + (n % 10); 198 n /= 10; 199 } 200 return p; 201} 202#endif 203 204 205/* Integer to decimal conversion. 206 207 This function is much more restricted than the widespread (but 208 non-standard) itoa() function. This version has the following 209 characteristics: 210 211 - it takes only non-negative arguments 212 - it is async-signal-safe (we use it runtime/backtrace.c) 213 - it works in base 10 (see xtoa, otoa, btoa functions 214 in io/write.c for other radices) 215 */ 216 217const char * 218gfc_itoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) 219{ 220 char *p; 221 222 if (len < GFC_ITOA_BUF_SIZE) 223 sys_abort (); 224 225 if (n == 0) 226 return "0"; 227 228 p = buffer + GFC_ITOA_BUF_SIZE - 1; 229 *p = '\0'; 230 231#if defined(HAVE_GFC_INTEGER_16) 232 /* On targets that have a 128-bit integer type, division in that type 233 is slow, because it occurs through a function call. We avoid that. */ 234 235 if (n <= UINT64_MAX) 236 /* If the value fits in uint64_t, use the fast function. */ 237 return itoa64 (n, p); 238 else 239 { 240 /* Otherwise, break down into smaller bits by division. Two calls to 241 the uint64_t function are not sufficient for all 128-bit unsigned 242 integers (we would need three calls), but they do suffice for all 243 values up to 2^127, which is the largest that Fortran can produce 244 (-HUGE(0_16)-1) with its signed integer types. */ 245 _Static_assert (sizeof(GFC_UINTEGER_LARGEST) <= 2 * sizeof(uint64_t), 246 "integer too large"); 247 248 GFC_UINTEGER_LARGEST r; 249 r = n % TEN19; 250 n = n / TEN19; 251 assert (r <= UINT64_MAX); 252 p = itoa64_pad19 (r, p); 253 254 assert(n <= UINT64_MAX); 255 return itoa64 (n, p); 256 } 257#else 258 /* On targets where the largest integer is 64-bit, just use that. */ 259 return itoa64 (n, p); 260#endif 261} 262