gcc/m2/gm2-libs-ch/dtoa.cc

   1 /* dtoa.c provide floating point string conversion routines.
   2
   3 Copyright (C) 2009-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 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 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 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 #include "config.h"
  28 #include "system.h"
  29 #include "ansidecl.h"
  30
  31 #include "gm2-libs-host.h"
  32 #include "m2rts.h"
  33
  34 #define LIBNAME "m2pim"
  35
  36 #ifdef __cplusplus
  37 extern "C" {
  38 #endif
  39
  40 #define MAX_FP_DIGITS 500
  41
  42 typedef enum Mode { maxsignicant, decimaldigits } Mode;
  43
  44 /* maxsignicant: return a string containing max(1,ndigits)
  45    significant digits.  The return string contains the string
  46    produced by ecvt.  decimaldigits: return a string produced by
  47    fcvt.  The string will contain ndigits past the decimal point
  48    (ndigits may be negative).  */
  49
  50 double
  51 dtoa_strtod (const char *s, bool *error)
  52 {
  53   char *endp;
  54   double d;
  55
  56   errno = 0;
  57   d = strtod (s, &endp);
  58   if (endp != NULL && (*endp == '\0'))
  59     *error = (errno != 0);
  60   else
  61     *error = true;
  62   return d;
  63 }
  64
  65 /* dtoa_calcmaxsig - calculates the position of the decimal point it
  66    also removes the decimal point and exponent from string, p.  */
  67
  68 int
  69 dtoa_calcmaxsig (char *p, int ndigits)
  70 {
  71   char *e;
  72   char *o;
  73   int x;
  74
  75   e = index (p, 'E');
  76   if (e == NULL)
  77     x = 0;
  78   else
  79     {
  80       *e = (char)0;
  81       x = atoi (e + 1);
  82     }
  83
  84   o = index (p, '.');
  85   if (o == NULL)
  86     return strlen (p) + x;
  87   else
  88     {
  89       memmove (o, o + 1, ndigits - (o - p));
  90       return o - p + x;
  91     }
  92 }
  93
  94 /* dtoa_calcdecimal - calculates the position of the decimal point it
  95    also removes the decimal point and exponent from string, p.  It
  96    truncates the digits in p accordingly to ndigits.  Ie ndigits is
  97    the number of digits after the '.' */
  98
  99 int
 100 dtoa_calcdecimal (char *p, int str_size, int ndigits)
 101 {
 102   char *e;
 103   char *o;
 104   int x;
 105   int l;
 106
 107   e = index (p, 'E');
 108   if (e == NULL)
 109     x = 0;
 110   else
 111     {
 112       *e = (char)0;
 113       x = atoi (e + 1);
 114     }
 115
 116   l = strlen (p);
 117   o = index (p, '.');
 118   if (o == NULL)
 119     x += strlen (p);
 120   else
 121     {
 122       int m = strlen (o);
 123       memmove (o, o + 1, l - (o - p));
 124       if (m > 0)
 125         o[m - 1] = '0';
 126       x += o - p;
 127     }
 128   if ((x + ndigits >= 0) && (x + ndigits < str_size))
 129     p[x + ndigits] = (char)0;
 130   return x;
 131 }
 132
 133 bool
 134 dtoa_calcsign (char *p, int str_size)
 135 {
 136   if (p[0] == '-')
 137     {
 138       memmove (p, p + 1, str_size - 1);
 139       return true;
 140     }
 141   else
 142     return false;
 143 }
 144
 145 char *
 146 dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
 147 {
 148   char format[50];
 149   char *p;
 150   int r;
 151   switch (mode)
 152     {
 153
 154     case maxsignicant:
 155       ndigits += 20; /* enough for exponent.  */
 156       p = (char *) malloc (ndigits);
 157       snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
 158       snprintf (p, ndigits, format, d);
 159       *sign = dtoa_calcsign (p, ndigits);
 160       *decpt = dtoa_calcmaxsig (p, ndigits);
 161       return p;
 162     case decimaldigits:
 163       p = (char *) malloc (MAX_FP_DIGITS + 20);
 164       snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
 165       snprintf (p, MAX_FP_DIGITS + 20, format, d);
 166       *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
 167       *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
 168       return p;
 169     default:
 170       abort ();
 171     }
 172 }
 173
 174 /* GNU Modula-2 hooks */
 175
 176 void
 177 _M2_dtoa_init (int, char **, char **)
 178 {
 179 }
 180
 181 void
 182 _M2_dtoa_finish (int, char **, char **)
 183 {
 184 }
 185
 186 void
 187 _M2_dtoa_dep (void)
 188 {
 189 }
 190
 191 #ifdef __cplusplus
 192 }
 193
 194 extern "C" void __attribute__((__constructor__))
 195 _M2_dtoa_ctor (void)
 196 {
 197   M2RTS_RegisterModule ("dtoa", LIBNAME, _M2_dtoa_init, _M2_dtoa_finish,
 198                         _M2_dtoa_dep);
 199 }
 200
 201 #else
 202 void
 203 _M2_dtoa_ctor (void)
 204 {
 205 }
 206
 207 #endif