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

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