1(* 	$Id: Real0.Mod,v 1.3 2002/08/12 18:11:30 mva Exp $	 *)
2MODULE Real0;
3(*  Helper functions used by the real conversion modules.
4    Copyright (C) 2002  Michael van Acken
5
6    This module is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public License
8    as published by the Free Software Foundation; either version 2 of
9    the License, or (at your option) any later version.
10
11    This module is distributed in the hope that it will be useful, but
12    WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15
16    You should have received a copy of the GNU Lesser General Public
17    License along with OOC. If not, write to the Free Software Foundation,
18    59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19*)
20
21IMPORT
22  CharClass, ConvTypes, Strings;
23
24
25TYPE
26  ConvResults = ConvTypes.ConvResults;
27
28CONST
29  strAllRight=ConvTypes.strAllRight;
30  strOutOfRange=ConvTypes.strOutOfRange;
31  strWrongFormat=ConvTypes.strWrongFormat;
32  strEmpty=ConvTypes.strEmpty;
33
34CONST
35  padding=ConvTypes.padding;
36  valid=ConvTypes.valid;
37  invalid=ConvTypes.invalid;
38  terminator=ConvTypes.terminator;
39
40TYPE
41  ScanClass = ConvTypes.ScanClass;
42  ScanState = ConvTypes.ScanState;
43
44CONST
45  expChar* = "E";
46
47VAR
48  RS-, P-, F-, E-, SE-, WE-, SR-: ScanState;
49
50
51(* internal state machine procedures *)
52
53PROCEDURE IsSign (ch: CHAR): BOOLEAN;
54(* Return TRUE for '+' or '-' *)
55  BEGIN
56    RETURN (ch='+') OR (ch='-')
57  END IsSign;
58
59PROCEDURE RSState(inputCh: CHAR;
60                  VAR chClass: ScanClass; VAR nextState: ScanState);
61  BEGIN
62    IF CharClass.IsNumeric(inputCh) THEN
63      chClass:=valid; nextState:=P
64    ELSE
65      chClass:=invalid; nextState:=RS
66    END
67  END RSState;
68
69PROCEDURE PState(inputCh: CHAR;
70                 VAR chClass: ScanClass; VAR nextState: ScanState);
71  BEGIN
72    IF CharClass.IsNumeric(inputCh) THEN
73      chClass:=valid; nextState:=P
74    ELSIF inputCh="." THEN
75      chClass:=valid; nextState:=F
76    ELSIF inputCh=expChar THEN
77      chClass:=valid; nextState:=E
78    ELSE
79      chClass:=terminator; nextState:=NIL
80    END
81  END PState;
82
83PROCEDURE FState(inputCh: CHAR;
84                 VAR chClass: ScanClass; VAR nextState: ScanState);
85  BEGIN
86    IF CharClass.IsNumeric(inputCh) THEN
87      chClass:=valid; nextState:=F
88    ELSIF inputCh=expChar THEN
89      chClass:=valid; nextState:=E
90    ELSE
91      chClass:=terminator; nextState:=NIL
92    END
93  END FState;
94
95PROCEDURE EState(inputCh: CHAR;
96                 VAR chClass: ScanClass; VAR nextState: ScanState);
97  BEGIN
98    IF IsSign(inputCh) THEN
99      chClass:=valid; nextState:=SE
100    ELSIF CharClass.IsNumeric(inputCh) THEN
101      chClass:=valid; nextState:=WE
102    ELSE
103      chClass:=invalid; nextState:=E
104    END
105  END EState;
106
107PROCEDURE SEState(inputCh: CHAR;
108                  VAR chClass: ScanClass; VAR nextState: ScanState);
109  BEGIN
110    IF CharClass.IsNumeric(inputCh) THEN
111      chClass:=valid; nextState:=WE
112    ELSE
113      chClass:=invalid; nextState:=SE
114    END
115  END SEState;
116
117PROCEDURE WEState(inputCh: CHAR;
118                  VAR chClass: ScanClass; VAR nextState: ScanState);
119  BEGIN
120    IF CharClass.IsNumeric(inputCh) THEN
121      chClass:=valid; nextState:=WE
122    ELSE
123      chClass:=terminator; nextState:=NIL
124    END
125  END WEState;
126
127PROCEDURE ScanReal*(inputCh: CHAR;
128                    VAR chClass: ScanClass; VAR nextState: ScanState);
129  BEGIN
130    IF CharClass.IsWhiteSpace(inputCh) THEN
131      chClass:=padding; nextState:=SR
132    ELSIF IsSign(inputCh) THEN
133      chClass:=valid; nextState:=RS
134    ELSIF CharClass.IsNumeric(inputCh) THEN
135      chClass:=valid; nextState:=P
136    ELSE
137      chClass:=invalid; nextState:=SR
138    END
139  END ScanReal;
140
141PROCEDURE FormatReal* (str: ARRAY OF CHAR; maxExp: LONGINT;
142                       maxValue: ARRAY OF CHAR): ConvResults;
143  VAR
144    i: LONGINT;
145    ch: CHAR;
146    state: ConvTypes.ScanState;
147    class: ConvTypes.ScanClass;
148    wSigFigs, fLeadingZeros, exp, startOfExp: LONGINT;
149    expNegative, allZeroDigit: BOOLEAN;
150
151  CONST
152    expCutoff = 100000000;
153    (* assume overflow if the value of the exponent is larger than this *)
154
155  PROCEDURE NonZeroDigit (): LONGINT;
156  (* locate first non-zero digit in str *)
157    BEGIN
158      i := 0;
159      WHILE (i # startOfExp) & ((str[i] < "1") OR (str[i] > "9")) DO
160        INC (i);
161      END;
162      RETURN i;
163    END NonZeroDigit;
164
165  PROCEDURE LessOrEqual (upperBound: ARRAY OF CHAR): BOOLEAN;
166    VAR
167      i, j: LONGINT;
168    BEGIN
169      i := NonZeroDigit();
170      IF (i # startOfExp) THEN         (* str[i] is non-zero digit  *)
171        j := 0;
172        WHILE (i # startOfExp) & (upperBound[j] # 0X) DO
173          IF (str[i] < upperBound[j]) THEN
174            RETURN TRUE;
175          ELSIF (str[i] > upperBound[j]) THEN
176            RETURN FALSE;
177          ELSE
178            INC (j); INC (i);
179            IF (str[i] = ".") THEN       (* skip decimal point *)
180              INC (i);
181            END;
182          END;
183        END;
184
185        IF (upperBound[j] = 0X) THEN
186          (* any trailing zeros don't change the outcome: skip them *)
187          WHILE (str[i] = "0") OR (str[i] = ".") DO
188            INC (i);
189          END;
190        END;
191      END;
192      RETURN (i = startOfExp);
193    END LessOrEqual;
194
195  BEGIN
196    (* normalize exponent character *)
197    i := 0;
198    WHILE (str[i] # 0X) & (str[i] # "e") DO
199      INC (i);
200    END;
201    IF (str[i] = "e") THEN
202      str[i] := expChar;
203    END;
204
205    (* move index `i' over padding characters *)
206    i := 0;
207    state := SR;
208    REPEAT
209      ch := str[i];
210      state.p(ch, class, state);
211      INC (i);
212    UNTIL (class # ConvTypes.padding);
213
214    IF (ch = 0X) THEN
215      RETURN strEmpty;
216    ELSE
217      (* scan part before decimal point or exponent *)
218      WHILE (class = ConvTypes.valid) & (state # F) & (state # E) &
219            ((ch < "1") OR (ch > "9")) DO
220        ch := str[i];
221        state.p(ch, class, state);
222        INC (i);
223      END;
224      wSigFigs := 0;
225      WHILE (class = ConvTypes.valid) & (state # F) & (state # E) DO
226        INC (wSigFigs);
227        ch := str[i];
228        state.p(ch, class, state);
229        INC (i);
230      END;
231      (* here holds: wSigFigs is the number of significant digits in
232         the whole number part of the number; 0 means there are only
233         zeros before the decimal point *)
234
235      (* scan fractional part exponent *)
236      fLeadingZeros := 0; allZeroDigit := TRUE;
237      WHILE (class = ConvTypes.valid) & (state # E) DO
238        ch := str[i];
239        IF allZeroDigit THEN
240          IF (ch = "0") THEN
241            INC (fLeadingZeros);
242          ELSIF (ch # ".") THEN
243            allZeroDigit := FALSE;
244          END;
245        END;
246        state.p(ch, class, state);
247        INC (i);
248      END;
249      (* here holds: fLeadingZeros holds the number of zeros after
250         the decimal point *)
251
252      (* scan exponent *)
253      startOfExp := i-1; exp := 0; expNegative := FALSE;
254      WHILE (class = ConvTypes.valid) DO
255        ch := str[i];
256        IF (ch = "-") THEN
257          expNegative := TRUE;
258        ELSIF ("0" <= ch) & (ch <= "9") & (exp < expCutoff) THEN
259          exp := exp*10 + (ORD(ch)-ORD("0"));
260        END;
261        state.p(ch, class, state);
262        INC (i);
263      END;
264      IF expNegative THEN
265        exp := -exp;
266      END;
267      (* here holds: exp holds the value of the exponent; if it's absolute
268         value is larger than expCutoff, then there has been an overflow  *)
269
270      IF (class = ConvTypes.invalid) OR (ch # 0X) THEN
271        RETURN strWrongFormat;
272      ELSE (* (class = ConvTypes.terminator) & (ch = 0X) *)
273        (* normalize the number: calculate the exponent if the number would
274           start with a non-zero digit, immediately followed by the
275           decimal point *)
276        IF (wSigFigs > 0) THEN
277          exp := exp+wSigFigs-1;
278        ELSE
279          exp := exp-fLeadingZeros-1;
280        END;
281
282        IF (exp > maxExp) & (NonZeroDigit() # startOfExp) OR
283           (exp = maxExp) & ~LessOrEqual (maxValue) THEN
284          RETURN strOutOfRange;
285        ELSE
286          RETURN strAllRight;
287        END;
288      END;
289    END;
290  END FormatReal;
291
292PROCEDURE NormalizeFloat* (VAR s: ARRAY OF CHAR);
293  VAR
294    i, d: INTEGER;
295  BEGIN
296    (* massage the output of sprintf to match our requirements; note: this
297       code should also handle "Inf", "Infinity", "NaN", etc., gracefully
298       but this is untested *)
299    IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
300    i := 1;
301    WHILE (s[i] # 0X) DO
302      IF (s[i] = ".") & (s[i+1] = expChar) THEN
303        INC (d);             (* eliminate "." if no digits follow *)
304      ELSIF (s[i] = "0") & (i-d-1 >= 0) & IsSign (s[i-d-1]) THEN
305        INC (d);           (* eliminate zeros after exponent sign *)
306      ELSE
307        s[i-d] := s[i];
308      END;
309      INC (i);
310    END;
311    IF (s[i-d-2] = "E") THEN
312      s[i-d-2] := 0X;                  (* remove "E+" or "E-" *)
313    ELSE
314      s[i-d] := 0X;
315    END;
316  END NormalizeFloat;
317
318PROCEDURE FormatForEng* (VAR s: ARRAY OF CHAR);
319  VAR
320    i, d, fract, exp, posExp, offset: INTEGER;
321  BEGIN
322    (* find out how large the exponent is, and how many digits are in the
323       fractional part *)
324    fract := 0; exp := 0; posExp := 0;
325    IF CharClass.IsNumeric (s[1]) THEN   (* skip for NaN, Inf *)
326      i := 0; d := 0;
327      WHILE (s[i] # "E") DO
328        fract := fract + d;
329        IF (s[i] = ".") THEN d := 1; END;
330        INC (i);
331      END;
332      INC (i);
333      IF (s[i] = "-") THEN d := -1; ELSE d := 1; END;
334      posExp := i;
335      INC (i);
336      WHILE (s[i] # 0X) DO
337        exp := exp*10 + d*(ORD (s[i]) - ORD ("0"));
338        INC (i);
339      END;
340    END;
341
342    offset := exp MOD 3;
343    IF (offset # 0) THEN
344      WHILE (fract < offset) DO        (* need more zeros before "E" *)
345        Strings.Insert ("0", posExp-1, s); INC (fract); INC (posExp);
346      END;
347      i := 2;
348      WHILE (i < offset+2) DO    (* move "." offset places to right *)
349        s[i] := s[i+1]; INC (i);
350      END;
351      s[i] := ".";
352
353      (* write new exponent *)
354      exp := exp-offset;
355      IF (exp < 0) THEN
356        exp := -exp; s[posExp] := "-";
357      ELSE
358        s[posExp] := "+";
359      END;
360      s[posExp+1] := CHR (exp DIV 100 + ORD("0"));
361      s[posExp+2] := CHR (exp DIV 10 MOD 10 + ORD("0"));
362      s[posExp+3] := CHR (exp MOD 10 + ORD("0"));
363      s[posExp+4] := 0X;
364    END;
365    NormalizeFloat (s);
366  END FormatForEng;
367
368PROCEDURE FormatForFixed* (VAR s: ARRAY OF CHAR; place: INTEGER);
369  VAR
370    i, d, c, fract, point, suffix: INTEGER;
371
372  PROCEDURE NotZero (VAR s: ARRAY OF CHAR; pos: INTEGER): BOOLEAN;
373    BEGIN
374      WHILE (s[pos] # 0X) DO
375        IF (s[pos] # "0") & (s[pos] # ".") THEN
376          RETURN TRUE;
377        END;
378        INC (pos);
379      END;
380      RETURN FALSE;
381    END NotZero;
382
383  BEGIN
384    IF (place < 0) THEN
385      (* locate position of decimal point in string *)
386      point := 1;
387      WHILE (s[point] # ".") DO INC (point); END;
388
389      (* number of digits before point is `point-1'; position in string
390         of the first digit that will be converted to zero due to rounding:
391         `point+place+1'; rightmost digit that may be incremented because
392         of rounding: `point+place' *)
393      IF (point+place >= 0) THEN
394        suffix := point+place+1; IF (s[suffix] = ".") THEN INC (suffix); END;
395        IF (s[suffix] > "5") OR
396           (s[suffix] = "5") &
397            (NotZero (s, suffix+1) OR
398             (point+place # 0) & ODD (ORD (s[point+place]))) THEN
399          (* we are rounding up *)
400          i := point+place;
401          WHILE (s[i] = "9") DO s[i] := "0"; DEC (i); END;
402          IF (i = 0) THEN                (* looking at sign *)
403            Strings.Insert ("1", 1, s); INC (point);
404          ELSE
405            s[i] := CHR (ORD (s[i])+1);  (* increment non-"9" digit by one *)
406          END;
407        END;
408
409        (* zero everything after the digit at `place' *)
410        i := point+place+1;
411        IF (i = 1) THEN                  (* all zero *)
412          s[1] := "0"; s[2] := 0X;
413        ELSE
414          WHILE (s[i] # ".") DO s[i] := "0"; INC (i); END;
415        END;
416      ELSE                                 (* round to zero *)
417        s[1] := "0"; s[2] := 0X;
418      END;
419      s[point] := 0X;
420    END;
421
422    (* correct sign, and add trailing zeros if necessary *)
423    IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
424    i := 1; fract := 0; c := 0;
425    WHILE (s[i] # 0X) DO
426      s[i-d] := s[i];
427      fract := fract+c;
428      IF (s[i] = ".") THEN
429        c := 1;
430      END;
431      INC (i);
432    END;
433    WHILE (fract < place) DO
434      s[i-d] := "0"; INC (fract); INC (i);
435    END;
436    s[i-d] := 0X;
437  END FormatForFixed;
438
439BEGIN
440  NEW(RS); RS.p:=RSState;
441  NEW(P);  P.p:=PState;
442  NEW(F);  F.p:=FState;
443  NEW(E);  E.p:=EState;
444  NEW(SE); SE.p:=SEState;
445  NEW(WE); WE.p:=WEState;
446  NEW(SR); SR.p:=ScanReal;
447END Real0.
448