Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/multprec_floating_numbers_io.adb, Revision 1.1
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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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