source: trunk/minix/lib/ack/libm2/RealConver.mod@ 9

Last change on this file since 9 was 9, checked in by Mattia Monga, 14 years ago

Minix 3.1.2a
File size: 7.2 KB
Line 
1(*
2 (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
3 See the copyright notice in the ACK home directory, in the file "Copyright".
4*)
5
6(*$R-*)
7IMPLEMENTATION MODULE RealConversions;
8(*
9 Module: string-to-real and real-to-string conversions
10 Author: Ceriel J.H. Jacobs
11 Version: $Header: /cvsup/minix/src/lib/ack/libm2/RealConver.mod,v 1.1 2005/10/10 15:27:46 beng Exp $
12*)
13
14
15 PROCEDURE RealToString(arg: REAL;
16 width, digits: INTEGER;
17 VAR str: ARRAY OF CHAR;
18 VAR ok: BOOLEAN);
19 BEGIN
20 LongRealToString(LONG(arg), width, digits, str, ok);
21 END RealToString;
22
23 TYPE
24 Powers = RECORD
25 pval: LONGREAL;
26 rpval: LONGREAL;
27 exp: INTEGER
28 END;
29
30 VAR Powers10: ARRAY[1..6] OF Powers;
31
32 PROCEDURE LongRealToString(arg: LONGREAL;
33 width, digits: INTEGER;
34 VAR str: ARRAY OF CHAR;
35 VAR ok: BOOLEAN);
36 VAR pointpos: INTEGER;
37 i: CARDINAL;
38 ecvtflag: BOOLEAN;
39 r: LONGREAL;
40 ind1, ind2 : CARDINAL;
41 sign: BOOLEAN;
42 ndigits: CARDINAL;
43
44 BEGIN
45 r := arg;
46 IF digits < 0 THEN
47 ecvtflag := TRUE;
48 ndigits := -digits;
49 ELSE
50 ecvtflag := FALSE;
51 ndigits := digits;
52 END;
53 IF (HIGH(str) < ndigits + 3) THEN
54 str[0] := 0C; ok := FALSE; RETURN
55 END;
56 pointpos := 0;
57 sign := r < 0.0D;
58 IF sign THEN r := -r END;
59 ok := TRUE;
60 IF NOT (r / 10.0D < r) THEN
61 (* assume Nan or Infinity *)
62 r := 0.0D;
63 ok := FALSE;
64 END;
65 IF r # 0.0D THEN
66 IF r >= 10.0D THEN
67 FOR i := 1 TO 6 DO
68 WITH Powers10[i] DO
69 WHILE r >= pval DO
70 r := r * rpval;
71 INC(pointpos, exp)
72 END;
73 END;
74 END;
75 END;
76 IF r < 1.0D THEN
77 FOR i := 1 TO 6 DO
78 WITH Powers10[i] DO
79 WHILE r*pval < 10.0D DO
80 r := r * pval;
81 DEC(pointpos, exp)
82 END;
83 END;
84 END;
85 END;
86 (* Now, we have r in [1.0, 10.0) *)
87 INC(pointpos);
88 END;
89 ind1 := 0;
90 ind2 := ndigits+1;
91
92 IF NOT ecvtflag THEN
93 IF INTEGER(ind2) + pointpos <= 0 THEN
94 ind2 := 1;
95 ELSE
96 ind2 := INTEGER(ind2) + pointpos
97 END;
98 END;
99 IF ind2 > HIGH(str) THEN
100 ok := FALSE;
101 str[0] := 0C;
102 RETURN;
103 END;
104 WHILE ind1 < ind2 DO
105 str[ind1] := CHR(TRUNC(r)+ORD('0'));
106 r := 10.0D * (r - FLOATD(TRUNC(r)));
107 INC(ind1);
108 END;
109 IF ind2 > 0 THEN
110 DEC(ind2);
111 ind1 := ind2;
112 str[ind2] := CHR(ORD(str[ind2])+5);
113 WHILE str[ind2] > '9' DO
114 str[ind2] := '0';
115 IF ind2 > 0 THEN
116 DEC(ind2);
117 str[ind2] := CHR(ORD(str[ind2])+1);
118 ELSE
119 str[ind2] := '1';
120 INC(pointpos);
121 IF NOT ecvtflag THEN
122 IF ind1 > 0 THEN str[ind1] := '0'; END;
123 INC(ind1);
124 END;
125 END;
126 END;
127 IF (NOT ecvtflag) AND (ind1 = 0) THEN
128 str[0] := CHR(ORD(str[0])-5);
129 INC(ind1);
130 END;
131 END;
132 IF ecvtflag THEN
133 FOR i := ind1 TO 2 BY -1 DO
134 str[i] := str[i-1];
135 END;
136 str[1] := '.';
137 INC(ind1);
138 IF sign THEN
139 FOR i := ind1 TO 1 BY -1 DO
140 str[i] := str[i-1];
141 END;
142 INC(ind1);
143 str[0] := '-';
144 END;
145 IF (ind1 + 4) > HIGH(str) THEN
146 str[0] := 0C;
147 ok := FALSE;
148 RETURN;
149 END;
150 str[ind1] := 'E'; INC(ind1);
151 IF arg # 0.0D THEN DEC(pointpos); END;
152 IF pointpos < 0 THEN
153 pointpos := -pointpos;
154 str[ind1] := '-';
155 ELSE
156 str[ind1] := '+';
157 END;
158 INC(ind1);
159 str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100));
160 pointpos := pointpos MOD 100;
161 INC(ind1);
162 str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10));
163 INC(ind1);
164 str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10));
165 ELSE
166 IF pointpos <= 0 THEN
167 FOR i := ind1 TO 1 BY -1 DO
168 str[i+CARDINAL(-pointpos)] := str[i-1];
169 END;
170 FOR i := 0 TO CARDINAL(-pointpos) DO
171 str[i] := '0';
172 END;
173 ind1 := ind1 + CARDINAL(1 - pointpos);
174 pointpos := 1;
175 END;
176 FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO
177 str[i] := str[i-1];
178 END;
179 IF ndigits = 0 THEN
180 str[pointpos] := 0C;
181 ind1 := pointpos - 1;
182 ELSE
183 str[pointpos] := '.';
184 IF INTEGER(ind1) > pointpos+INTEGER(ndigits) THEN
185 ind1 := pointpos+INTEGER(ndigits);
186 END;
187 str[pointpos+INTEGER(ndigits)+1] := 0C;
188 END;
189 IF sign THEN
190 FOR i := ind1 TO 0 BY -1 DO
191 str[i+1] := str[i];
192 END;
193 str[0] := '-';
194 INC(ind1);
195 END;
196 END;
197 IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END;
198 IF ind1 >= CARDINAL(width) THEN
199 ok := FALSE;
200 RETURN;
201 END;
202 IF width > 0 THEN
203 DEC(width);
204 END;
205 IF (width > 0) AND (ind1 < CARDINAL(width)) THEN
206 FOR i := ind1 TO 0 BY -1 DO
207 str[i + CARDINAL(width) - ind1] := str[i];
208 END;
209 FOR i := 0 TO CARDINAL(width)-(ind1+1) DO
210 str[i] := ' ';
211 END;
212 ind1 := CARDINAL(width);
213 IF (ind1+1) <= HIGH(str) THEN
214 FOR ind1 := ind1+1 TO HIGH(str) DO
215 str[ind1] := 0C;
216 END;
217 END;
218 END;
219
220 END LongRealToString;
221
222
223 PROCEDURE StringToReal(str: ARRAY OF CHAR;
224 VAR r: REAL; VAR ok: BOOLEAN);
225 VAR x: LONGREAL;
226 BEGIN
227 StringToLongReal(str, x, ok);
228 IF ok THEN
229 r := x;
230 END;
231 END StringToReal;
232
233 PROCEDURE StringToLongReal(str: ARRAY OF CHAR;
234 VAR r: LONGREAL; VAR ok: BOOLEAN);
235 CONST BIG = 1.0D17;
236 TYPE SETOFCHAR = SET OF CHAR;
237 VAR pow10 : INTEGER;
238 i : INTEGER;
239 e : LONGREAL;
240 ch : CHAR;
241 signed: BOOLEAN;
242 signedexp: BOOLEAN;
243 iB: CARDINAL;
244
245 BEGIN
246 r := 0.0D;
247 pow10 := 0;
248 iB := 0;
249 ok := TRUE;
250 signed := FALSE;
251 WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO
252 INC(iB);
253 IF iB > HIGH(str) THEN
254 ok := FALSE;
255 RETURN;
256 END;
257 END;
258 IF str[iB] = '-' THEN signed := TRUE; INC(iB)
259 ELSIF str[iB] = '+' THEN INC(iB)
260 END;
261 ch := str[iB]; INC(iB);
262 IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
263 REPEAT
264 IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r+FLOATD(ORD(ch)-ORD('0')) END;
265 IF iB <= HIGH(str) THEN
266 ch := str[iB]; INC(iB);
267 END;
268 UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
269 IF (ch = '.') AND (iB <= HIGH(str)) THEN
270 ch := str[iB]; INC(iB);
271 IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
272 REPEAT
273 IF r < BIG THEN
274 r := 10.0D * r + FLOATD(ORD(ch)-ORD('0'));
275 DEC(pow10);
276 END;
277 IF iB <= HIGH(str) THEN
278 ch := str[iB]; INC(iB);
279 END;
280 UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
281 END;
282 IF (ch = 'E') THEN
283 IF iB > HIGH(str) THEN
284 ok := FALSE;
285 RETURN;
286 ELSE
287 ch := str[iB]; INC(iB);
288 END;
289 i := 0;
290 signedexp := FALSE;
291 IF (ch = '-') OR (ch = '+') THEN
292 signedexp := ch = '-';
293 IF iB > HIGH(str) THEN
294 ok := FALSE;
295 RETURN;
296 ELSE
297 ch := str[iB]; INC(iB);
298 END;
299 END;
300 IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
301 REPEAT
302 i := i*10 + INTEGER(ORD(ch) - ORD('0'));
303 IF iB <= HIGH(str) THEN
304 ch := str[iB]; INC(iB);
305 END;
306 UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
307 IF signedexp THEN i := -i END;
308 pow10 := pow10 + i;
309 END;
310 IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END;
311 e := 1.0D;
312 DEC(i);
313 WHILE i >= 10 DO
314 e := e * 10000000000.0D;
315 DEC(i,10);
316 END;
317 WHILE i >= 0 DO
318 e := e * 10.0D;
319 DEC(i)
320 END;
321 IF pow10<0 THEN
322 r := r / e;
323 ELSE
324 r := r * e;
325 END;
326 IF signed THEN r := -r; END;
327 IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END
328 END StringToLongReal;
329
330BEGIN
331 WITH Powers10[1] DO pval := 1.0D32; rpval := 1.0D-32; exp := 32 END;
332 WITH Powers10[2] DO pval := 1.0D16; rpval := 1.0D-16; exp := 16 END;
333 WITH Powers10[3] DO pval := 1.0D8; rpval := 1.0D-8; exp := 8 END;
334 WITH Powers10[4] DO pval := 1.0D4; rpval := 1.0D-4; exp := 4 END;
335 WITH Powers10[5] DO pval := 1.0D2; rpval := 1.0D-2; exp := 2 END;
336 WITH Powers10[6] DO pval := 1.0D1; rpval := 1.0D-1; exp := 1 END;
337END RealConversions.
Note: See TracBrowser for help on using the repository browser.