gcc/m2/gm2-libs-iso/ConvStringReal.mod

   1 (* ConvStringReal.mod translate floating point numbers to Strings.
   2
   3 Copyright (C) 2009-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.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 IMPLEMENTATION MODULE ConvStringReal ;
  28
  29 FROM DynamicStrings IMPORT InitString, KillString, ConCat, ConCatChar,
  30                            Slice, Length, Mult, Mark, InitStringCharStar,
  31                            InitStringChar, Index, char ;
  32 FROM StringConvert IMPORT IntegerToString, ToSigFig ;
  33 FROM dtoa IMPORT dtoa, Mode ;
  34 FROM libc IMPORT free, printf ;
  35 FROM SYSTEM IMPORT ADDRESS ;
  36
  37 CONST
  38    Debugging = FALSE ;
  39
  40
  41 (*
  42    IsDigit - returns TRUE if, ch, lies between '0'..'9'.
  43 *)
  44
  45 PROCEDURE IsDigit (ch: CHAR) : BOOLEAN ;
  46 BEGIN
  47    RETURN (ch>='0') AND (ch<='9')
  48 END IsDigit ;
  49
  50
  51 (*
  52    RealToFloatString - converts a real with, sigFigs, into a string
  53                        and returns the result as a string.
  54 *)
  55
  56 PROCEDURE RealToFloatString (real: REAL; sigFigs: CARDINAL) : String ;
  57 VAR
  58    point, l,
  59    powerOfTen: INTEGER ;
  60    s         : String ;
  61    r         : ADDRESS ;
  62    sign      : BOOLEAN ;
  63 BEGIN
  64    r := dtoa(real, maxsignificant, 100, point, sign) ;
  65    s := InitStringCharStar(r) ;
  66    free(r) ;
  67    IF sigFigs>0
  68    THEN
  69       l := Length(s) ;
  70       IF (l>0) AND IsDigit(char(s, 0))
  71       THEN
  72          IF VAL(INTEGER, sigFigs)<l
  73          THEN
  74             s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
  75          ELSE
  76             (* add '0's to make up significant figures *)
  77             s := ConCat(s, Mark(Mult(InitStringChar('0'), l-VAL(INTEGER, sigFigs))))
  78          END ;
  79          l := Length(s) ;
  80          (*
  81           *  we reassign point to 1 and adjust the exponent
  82           *  accordingly, so we can achieve the format X.XXXE+X
  83           *)
  84          powerOfTen := point-1 ;
  85          point := 1 ;
  86
  87          IF (point<l) AND (point<VAL(INTEGER, sigFigs))
  88          THEN
  89             s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
  90                         Slice(s, point, 0))
  91          END ;
  92
  93          IF powerOfTen#0
  94          THEN
  95             s := ConCat(ConCatChar(s, 'E'),
  96                         IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
  97          END
  98       END ;
  99       IF sign
 100       THEN
 101          s := ConCat(InitStringChar('-'), Mark(s))
 102       END
 103    END ;
 104    RETURN( s )
 105 END RealToFloatString ;
 106
 107
 108 (*
 109    RealToEngString - converts the value of real to floating-point
 110                      string form, with sigFigs significant figures.
 111                      The number is scaled with one to three digits
 112                      in the whole number part and with an exponent
 113                      that is a multiple of three.
 114 *)
 115
 116 PROCEDURE RealToEngString (real: REAL; sigFigs: CARDINAL) : String ;
 117 VAR
 118    offset,
 119    point,
 120    powerOfTen: INTEGER ;
 121    s         : String ;
 122    l         : CARDINAL ;
 123    r         : ADDRESS ;
 124    sign      : BOOLEAN ;
 125 BEGIN
 126    r := dtoa(real, maxsignificant, 100, point, sign) ;
 127    s := InitStringCharStar(r) ;
 128    free(r) ;
 129    IF sigFigs>0
 130    THEN
 131       l := Length(s) ;
 132       IF (l>0) AND IsDigit(char(s, 0))
 133       THEN
 134          IF sigFigs<l
 135          THEN
 136             s := Slice(ToSigFig(s, sigFigs), 0, sigFigs)
 137          ELSE
 138             (* add '0's to make up significant figures *)
 139             s := ConCat(s, Mark(Mult(InitStringChar('0'), l-sigFigs)))
 140          END ;
 141          l := Length(s) ;
 142          IF (point>0) AND (point<=2)
 143          THEN
 144             (* current range is fine, no need for a exponent *)
 145             powerOfTen := 0 ;
 146             IF point>VAL(INTEGER, sigFigs)
 147             THEN
 148                (* add '0's to make up required mantissa length *)
 149                s := ConCat(s, Mark(Mult(InitStringChar('0'), point-VAL(INTEGER, sigFigs)))) ;
 150                l := Length(s)
 151             END
 152          ELSE
 153             (*
 154              *  desire a value of point which lies between 1..3
 155              *  this allows the mantissa to have the format
 156              *  X.XXX  or  XX.XX  or XXX.X
 157              *)
 158             powerOfTen := point-VAL(INTEGER, l) ;
 159             point := point-powerOfTen ;
 160             offset := 0 ;
 161             IF point>3
 162             THEN
 163                offset := (point DIV 3) * 3 ;
 164                point := point-offset ;
 165                powerOfTen := powerOfTen+offset
 166             ELSIF point<0
 167             THEN
 168                offset := (ABS(point) DIV 3) * 3 ;
 169                point := point+offset ;
 170                powerOfTen := powerOfTen-offset
 171             END ;
 172             IF powerOfTen<0
 173             THEN
 174                IF ABS(powerOfTen) MOD 3#0
 175                THEN
 176                   offset := 3-(ABS(powerOfTen) MOD 3)
 177                END
 178             ELSE
 179                (* at this stage, point >= sigFigs *)
 180                IF powerOfTen MOD 3#0
 181                THEN
 182                   offset := -(3-(powerOfTen MOD 3))
 183                END
 184             END ;
 185             IF offset+point>VAL(INTEGER, sigFigs)
 186             THEN
 187                (* add '0's to make up required mantissa length *)
 188                s := ConCat(s, Mark(Mult(InitStringChar('0'), offset+point-VAL(INTEGER, sigFigs)))) ;
 189                l := Length(s)
 190             END ;
 191             (* now adjust point and powerOfTen by offset *)
 192             point := point + offset ;
 193             powerOfTen := powerOfTen - offset
 194          END ;
 195
 196          IF point<0
 197          THEN
 198             s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
 199          ELSIF (point>0) AND (point<VAL(INTEGER, l)) AND (point<VAL(INTEGER, sigFigs))
 200          THEN
 201             s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
 202                         Slice(s, point, 0))
 203          END ;
 204
 205          IF powerOfTen#0
 206          THEN
 207             s := ConCat(ConCatChar(s, 'E'),
 208                         IntegerToString(powerOfTen, 0, ' ', TRUE, 10, FALSE))
 209          END
 210       END ;
 211       IF sign
 212       THEN
 213          s := ConCat(InitStringChar('-'), Mark(s))
 214       END
 215    END ;
 216    RETURN( s )
 217 END RealToEngString ;
 218
 219
 220 (*
 221    RealToFixedString - returns the number of characters in the fixed-point
 222                        string representation of real rounded to the given
 223                        place relative to the decimal point.
 224 *)
 225
 226 PROCEDURE RealToFixedString (real: REAL; place: INTEGER) : String ;
 227 VAR
 228    l,
 229    point: INTEGER ;
 230    sign : BOOLEAN ;
 231    r    : ADDRESS ;
 232    s    : String ;
 233 BEGIN
 234    r := dtoa(real, maxsignificant, 100, point, sign) ;
 235    s := InitStringCharStar(r) ;
 236    free(r) ;
 237    l := Length(s) ;
 238    IF Debugging
 239    THEN
 240       printf("length of string returned is %d decimal point at position %d\n", l, point)
 241    END ;
 242    IF (l>0) AND IsDigit(char(s, 0))
 243    THEN
 244       IF point+place>=0
 245       THEN
 246          (* add decimal point at correct position *)
 247          IF point<0
 248          THEN
 249             s := ConCat(ConCat(InitString('0.'), Mult(InitStringChar('0'), -point)), s)
 250          ELSIF point=0
 251          THEN
 252             s := ConCat(InitString('0.'), Mark(s))
 253          ELSIF point<l
 254          THEN
 255             s := ConCat(ConCatChar(Slice(s, 0, point), '.'),
 256                         Slice(s, point, 0))
 257          END ;
 258          IF place<0
 259          THEN
 260             s := ToSigFig(s, point+place+1)
 261          ELSE
 262             s := ToSigFig(s, point+place)
 263          END ;
 264          l := Length(s) ;
 265          IF place>=0
 266          THEN
 267             IF Index(s, '.', 0)<0
 268             THEN
 269                s := ConCatChar(s, '.') ;
 270                s := ConCat(s, Mark(Mult(InitStringChar('0'), place)))
 271             ELSE
 272                point := Index(s, '.', 0) ;
 273                IF l-point<place
 274                THEN
 275                   s := ConCat(s, Mark(Mult(InitStringChar('0'), l-point-place)))
 276                END
 277             END
 278          END
 279       ELSE
 280          IF place<0
 281          THEN
 282             s := InitString('0')
 283          ELSIF place=0
 284          THEN
 285             s := InitString('0.')
 286          ELSE
 287             s := InitString('0.0')
 288          END
 289       END
 290    END ;
 291    IF sign
 292    THEN
 293       s := ConCat(InitStringChar('-'), Mark(s))
 294    END ;
 295    RETURN( s )
 296 END RealToFixedString ;
 297
 298
 299 END ConvStringReal.