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

   1 (* Library module defined by the International Standard
   2    Information technology - programming languages
   3    BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language.
   4
   5    Copyright ISO/IEC (International Organization for Standardization
   6    and International Electrotechnical Commission) 1996-2021.
   7
   8    It may be freely copied for the purpose of implementation (see page
   9    707 of the Information technology - Programming languages Part 1:
  10    Modula-2, Base Language.  BS ISO/IEC 10514-1:1996).  *)
  11
  12 IMPLEMENTATION MODULE LongIO;
  13
  14   (* Input and output of real numbers in decimal text form
  15      over specified channels.  The read result is of the
  16      type IOConsts.ReadResults.
  17   *)
  18
  19 FROM TextIO IMPORT WriteChar, ReadChar ;
  20 FROM StringChan IMPORT writeString, writeFieldWidth ;
  21 FROM IOChan IMPORT SetReadResult ;
  22 FROM IOConsts IMPORT ReadResults ;
  23
  24 FROM ConvStringLong IMPORT RealToFixedString, RealToFloatString,
  25                            RealToEngString ;
  26
  27 FROM ConvTypes IMPORT ScanClass, ScanState ;
  28 FROM DynamicStrings IMPORT String, char, KillString, Length, InitString, ConCatChar, string ;
  29 FROM LongConv IMPORT ScanReal ;
  30 FROM ldtoa IMPORT strtold ;
  31 FROM TextUtil IMPORT SkipSpaces ;
  32
  33
  34   (* The text form of a signed fixed-point real number is
  35        ["+" | "-"], decimal digit, {decimal digit},
  36        [".", {decimal digit}]
  37
  38      The text form of a signed floating-point real number is
  39        signed fixed-point real number,
  40        "E", ["+" | "-"], decimal digit, {decimal digit}
  41   *)
  42
  43 PROCEDURE ReadReal (cid: IOChan.ChanId; VAR real: LONGREAL);
  44   (* Skips leading spaces, and removes any remaining characters
  45      from cid that form part of a signed fixed or floating
  46      point number.  The value of this number is assigned to real.
  47      The read result is set to the value allRight, outOfRange,
  48      wrongFormat, endOfLine, or endOfInput.
  49   *)
  50 VAR
  51    chClass  : ScanClass ;
  52    nextState: ScanState ;
  53    ch       : CHAR ;
  54    s        : String ;
  55    error    : BOOLEAN ;
  56 BEGIN
  57    SkipSpaces (cid) ;
  58    ReadChar(cid, ch) ;
  59    nextState := ScanReal ;
  60    REPEAT
  61       nextState(ch, chClass, nextState) ;
  62       IF chClass=padding
  63       THEN
  64          ReadChar(cid, ch)
  65       END
  66    UNTIL chClass#padding ;
  67    IF chClass=valid
  68    THEN
  69       s := InitString('') ;
  70       WHILE chClass=valid DO
  71          s := ConCatChar(s, ch) ;
  72          ReadChar(cid, ch) ;
  73          nextState(ch, chClass, nextState)
  74       END ;
  75       real := strtold(string(s), error) ;
  76       s := KillString(s) ;
  77       IF error
  78       THEN
  79          SetReadResult(cid, outOfRange)
  80       ELSE
  81          SetReadResult(cid, allRight)
  82       END
  83    ELSE
  84       SetReadResult(cid, wrongFormat)
  85    END
  86 END ReadReal ;
  87
  88
  89 PROCEDURE WriteFloat (cid: IOChan.ChanId; real: LONGREAL;
  90                       sigFigs: CARDINAL; width: CARDINAL);
  91   (* Writes the value of real to cid in floating-point text form,
  92      with sigFigs significant figures, in a field of the given
  93      minimum width.
  94   *)
  95 VAR
  96    s: String ;
  97 BEGIN
  98    s := RealToFloatString(real, sigFigs) ;
  99    writeFieldWidth(cid, s, width) ;
 100    s := KillString(s)
 101 END WriteFloat ;
 102
 103
 104 PROCEDURE WriteEng (cid: IOChan.ChanId; real: LONGREAL;
 105                     sigFigs: CARDINAL; width: CARDINAL);
 106   (* As for WriteFloat, except that the number is scaled with
 107      one to three digits in the whole number part, and with an
 108      exponent that is a multiple of three.
 109   *)
 110 VAR
 111    s: String ;
 112 BEGIN
 113    s := RealToEngString(real, sigFigs) ;
 114    writeFieldWidth(cid, s, width) ;
 115    s := KillString(s)
 116 END WriteEng ;
 117
 118
 119 PROCEDURE WriteFixed (cid: IOChan.ChanId; real: LONGREAL;
 120                       place: INTEGER; width: CARDINAL);
 121   (* Writes the value of real to cid in fixed-point text form,
 122      rounded to the given place relative to the decimal point,
 123      in a field of the given minimum width.
 124   *)
 125 VAR
 126    s: String ;
 127 BEGIN
 128    s := RealToFixedString(real, place) ;
 129    writeFieldWidth(cid, s, width) ;
 130    s := KillString(s)
 131 END WriteFixed ;
 132
 133
 134 PROCEDURE WriteReal (cid: IOChan.ChanId;
 135                      real: LONGREAL; width: CARDINAL);
 136   (* Writes the value of real to cid, as WriteFixed if the sign
 137      and magnitude can be shown in the given width, or otherwise
 138      as WriteFloat.  The number of places or significant digits
 139      depends on the given width.
 140   *)
 141 VAR
 142    sigFigs: CARDINAL ;
 143    s      : String ;
 144 BEGIN
 145    sigFigs := width ;
 146    WHILE sigFigs>1 DO
 147       s := RealToFixedString(real, sigFigs) ;
 148       IF Length(s)<=width
 149       THEN
 150          writeFieldWidth(cid, s, width) ;
 151          s := KillString(s) ;
 152          RETURN
 153       END ;
 154       s := KillString(s) ;
 155       DEC(sigFigs)
 156    END ;
 157    sigFigs := width ;
 158    WHILE sigFigs#0 DO
 159       s := RealToFloatString(real, sigFigs) ;
 160       IF Length(s)<=width
 161       THEN
 162          writeFieldWidth(cid, s, width) ;
 163          s := KillString(s) ;
 164          RETURN
 165       END ;
 166       s := KillString(s) ;
 167       DEC(sigFigs)
 168    END
 169 END WriteReal ;
 170
 171
 172 END LongIO.