![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to multprec_floating_numbers_io.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers|
Return to multprec_floating_numbers_io.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers |
1.1 maekawa 1: with integer_io; use integer_io;
2: with Characters_and_Numbers; use Characters_and_Numbers;
3: with Multprec_Natural_Numbers; use Multprec_Natural_Numbers;
4: with Multprec_Natural_Numbers_io; use Multprec_Natural_Numbers_io;
5: with Multprec_Integer_Numbers; use Multprec_Integer_Numbers;
6: with Multprec_Integer_Numbers_io; use Multprec_Integer_Numbers_io;
7:
8: package body Multprec_Floating_Numbers_io is
9:
10: -- NOTE :
11: -- No exceptions are raised when the input format is incorrect.
12:
13: -- AUXILIARIES FOR OUTPUT :
14:
15: function Head ( i : Integer_Number ) return integer is
16:
17: -- DESCRIPTION :
18: -- Returns the leading decimal number of the i, can be negative.
19:
20: res : integer;
21: wrk : Integer_Number;
22:
23: begin
24: if Multprec_Integer_Numbers.Positive(i)
25: then Copy(i,wrk);
26: while wrk > 9 loop
27: Div(wrk,10);
28: end loop;
29: res := Create(wrk);
30: Clear(wrk);
31: elsif Negative(i)
32: then Copy(i,wrk);
33: while wrk < -9 loop
34: Div(wrk,10);
35: end loop;
36: res := Create(wrk);
37: Clear(wrk);
38: else res := 0;
39: end if;
40: return res;
41: end Head;
42:
43: function Tail ( i : Integer_Number ) return Natural_Number is
44:
45: -- DESCRIPTION :
46: -- Returns the decimals after the leading decimal of i.
47: -- The number on return has the same size as i.
48:
49: res : Natural_Number;
50: res_rep : Array_of_Naturals(0..Size(i));
51: acc,wrk,prod : Integer_Number;
52: cnt : natural := 0;
53: r : integer;
54:
55: begin
56: if Multprec_Integer_Numbers.Positive(i)
57: then Copy(i,wrk);
58: while wrk > 9 loop
59: cnt := cnt+1;
60: Div(wrk,10,r);
61: if r /= 0
62: then prod := Create(r);
63: for i in 1..cnt-1 loop
64: Mul(prod,10);
65: end loop;
66: Add(acc,prod);
67: Clear(prod);
68: end if;
69: end loop;
70: Clear(wrk);
71: elsif Negative(i)
72: then Copy(i,wrk);
73: while wrk < -9 loop
74: cnt := cnt+1;
75: Div(wrk,10,r);
76: if r /= 0
77: then prod := Create(r);
78: for i in 1..cnt-1 loop
79: Mul(prod,10);
80: end loop;
81: Add(acc,prod);
82: Clear(prod);
83: end if;
84: end loop;
85: Clear(wrk);
86: else acc := Create(0);
87: end if;
88: for i in res_rep'range loop
89: res_rep(i) := Coefficient(acc,i);
90: end loop;
91: Clear(acc);
92: res := Create(res_rep);
93: return res;
94: end Tail;
95:
96: procedure Write_Number ( file : in file_type; n : in natural;
97: cnt : in out natural ) is
98: begin
99: if n < 10
100: then put(file,n,1);
101: cnt := cnt - 1;
102: else Write_Number(file,n/10,cnt);
103: if cnt > 0
104: then put(file,n mod 10,1);
105: cnt := cnt - 1;
106: end if;
107: end if;
108: end Write_Number;
109:
110: procedure Write_Block ( file : in file_type; n : in natural;
111: cnt : in out natural ) is
112:
113: -- DESCRIPTION :
114: -- This procedure writes the leading zeros, not exceeding cnt.
115:
116: expo : constant natural := Multprec_Natural_Numbers.Exponent;
117: nbz,acc : natural := 0;
118:
119: begin
120: if n = 0
121: then for i in 1..expo loop
122: put(file,"0");
123: cnt := cnt - 1;
124: exit when (cnt = 0);
125: end loop;
126: else acc := 10;
127: for i in 1..(expo-1) loop
128: if n < acc
129: then nbz := expo-i;
130: else acc := acc*10;
131: end if;
132: exit when (nbz /= 0);
133: end loop;
134: for i in 1..nbz loop
135: put(file,"0");
136: cnt := cnt - 1;
137: exit when (cnt = 0);
138: end loop;
139: if cnt > 0
140: then Write_Number(file,n,cnt);
141: end if;
142: end if;
143: end Write_Block;
144:
145: procedure Write_Zero_Block ( file : in file_type; cnt : in out natural ) is
146:
147: -- DESCRIPTION :
148: -- Writes as many zeros as there are in one block, not exceeding cnt.
149:
150: expo : constant natural := Multprec_Natural_Numbers.Exponent;
151:
152: begin
153: for i in 1..expo loop
154: put(file,"0");
155: cnt := cnt - 1;
156: exit when (cnt = 0);
157: end loop;
158: end Write_Zero_Block;
159:
160: procedure put ( file : in file_type;
161: n : in Natural_Number; dp : in natural ) is
162:
163: -- DESCRIPTION :
164: -- Writes the natural number n using dp decimal places.
165: -- If n is too long, then the leading dp decimal places will be written,
166: -- otherwise zeros will be added.
167:
168: deciplan : natural := Decimal_Places(n);
169: first : boolean;
170: coeff,cnt : natural;
171:
172: begin
173: if deciplan <= dp
174: then put(file,n);
175: for i in 1..(dp-deciplan) loop
176: put(file,"0");
177: end loop;
178: else first := true;
179: cnt := dp;
180: for i in reverse 0..Size(n) loop
181: coeff := Coefficient(n,i);
182: if coeff /= 0
183: then if first
184: then Write_Number(file,coeff,cnt);
185: first := false;
186: else Write_Block(file,coeff,cnt);
187: end if;
188: elsif not first
189: then Write_Zero_Block(file,cnt);
190: -- else skip leading zeros in representation
191: end if;
192: exit when (cnt = 0);
193: end loop;
194: end if;
195: end put;
196:
197: -- INPUT ROUTINES :
198:
199: procedure get ( f : in out Floating_Number ) is
200: begin
201: get(Standard_Input,f);
202: end get;
203:
204: procedure get ( file : in file_type; f : in out Floating_Number ) is
205:
206: fraction,decifrac,exponent : Integer_Number;
207: shifexpo : integer := 0;
208: deciplac : natural;
209: c : character := ' ';
210:
211: begin
212: get(file,c,fraction);
213: if c = '.'
214: then get(file,c);
215: while c = '0' loop
216: Mul(fraction,10);
217: shifexpo := shifexpo - 1;
218: exit when End_of_Line(file);
219: get(file,c);
220: end loop;
221: if Convert(c) < 10
222: then get(file,c,decifrac);
223: deciplac := Decimal_Places(decifrac);
224: shifexpo := shifexpo - deciplac;
225: for i in 1..deciplac loop
226: Mul(fraction,10);
227: end loop;
228: if Negative(fraction)
229: then Sub(fraction,decifrac);
230: else Add(fraction,decifrac);
231: end if;
232: end if;
233: end if;
234: if c = 'E'
235: then get(file,exponent);
236: if Equal(fraction,0)
237: then Clear(exponent);
238: exponent := Create(0);
239: elsif shifexpo /= 0
240: then Add(exponent,shifexpo);
241: end if;
242: else if Equal(fraction,0)
243: then exponent := Create(0);
244: else exponent := Create(shifexpo);
245: end if;
246: end if;
247: f := Create(fraction,exponent);
248: end get;
249:
250: -- OUTPUT ROUTINES :
251:
252: procedure put ( f : in Floating_Number ) is
253: begin
254: put(Standard_Output,f);
255: end put;
256:
257: procedure put ( file : in file_type; f : in Floating_Number ) is
258:
259: frac,expo : Integer_Number;
260: tafr : Natural_Number;
261: decifrac,decitafr : natural;
262: hd : integer;
263:
264: begin
265: Copy(Fraction(f),frac);
266: if Equal(frac,0)
267: then put(file,"0");
268: else hd := Head(frac);
269: put(file,hd,1); put(file,".");
270: tafr := Tail(Fraction(f));
271: decifrac := Decimal_Places(frac);
272: decitafr := Decimal_Places(tafr);
273: if not Equal(tafr,0)
274: then for i in 1..decifrac-decitafr-1 loop
275: put(file,"0");
276: end loop;
277: put(file,tafr);
278: else put(file,"0");
279: end if;
280: expo := Exponent(f) + (decifrac - 1);
281: if not Equal(expo,0)
282: then put(file,"E");
283: if expo > 0
284: then put(file,"+");
285: end if;
286: put(file,expo);
287: end if;
288: Clear(tafr);
289: Clear(expo);
290: end if;
291: Clear(frac);
292: end put;
293:
294: procedure put ( f : in Floating_Number; fore,aft,exp : in natural ) is
295: begin
296: put(Standard_Output,f,fore,aft,exp);
297: end put;
298:
299: procedure put ( file : in file_type;
300: f : in Floating_Number; fore,aft,exp : in natural ) is
301:
302: frac,expo : Integer_Number;
303: tafr : Natural_Number;
304: decifrac,decitafr,deciexpo,cnt : natural;
305: hd : integer;
306:
307: begin
308: Copy(Fraction(f),frac);
309: if Equal(frac,0)
310: then for i in 1..(fore-1) loop
311: put(file," ");
312: end loop;
313: put(file,"0.");
314: for i in 1..aft loop
315: put(file,"0");
316: end loop;
317: put(file,"E+");
318: for i in 1..(exp-1) loop
319: put(file,"0");
320: end loop;
321: else hd := Head(frac);
322: if hd > 0
323: then for i in 1..(fore-1) loop
324: put(file," ");
325: end loop;
326: else for i in 1..(fore-2) loop
327: put(file," ");
328: end loop;
329: end if;
330: put(file,hd,1); put(file,".");
331: tafr := Tail(Fraction(f));
332: decifrac := Decimal_Places(frac);
333: decitafr := Decimal_Places(tafr);
334: if Equal(tafr,0)
335: then for i in 1..aft loop
336: put(file,"0");
337: end loop;
338: else cnt := aft;
339: for i in 1..decifrac-decitafr-1 loop
340: put(file,"0");
341: cnt := cnt-1;
342: exit when (cnt = 0);
343: end loop;
344: if cnt /= 0
345: then put(file,tafr,cnt);
346: end if;
347: end if;
348: expo := Exponent(f) + (decifrac - 1);
349: deciexpo := Decimal_Places(expo);
350: put(file,"E");
351: if Equal(expo,0)
352: then put(file,"+");
353: for i in 1..(exp-1) loop
354: put(file,"0");
355: end loop;
356: else if expo > 0
357: then put(file,"+");
358: else put(file,"-");
359: end if;
360: for i in 1..(exp-deciexpo-1) loop
361: put(file,"0");
362: end loop;
363: put(file,Unsigned(expo));
364: end if;
365: Clear(tafr);
366: Clear(expo);
367: end if;
368: Clear(frac);
369: end put;
370:
371: procedure put ( f : in Floating_Number; dp : in natural ) is
372: begin
373: put(f,dp,dp,dp);
374: end put;
375:
376: procedure put ( file : in file_type;
377: f : in Floating_Number; dp : in natural ) is
378: begin
379: put(file,f,dp,dp,dp);
380: end put;
381:
382: end Multprec_Floating_Numbers_io;