← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libgmpada/trusty-proposed

« back to all changes in this revision

Viewing changes to src/gnu_multiple_precision-aux.adb

  • Committer: Package Import Robot
  • Author(s): Nicolas Boulenguez
  • Date: 2012-04-04 21:36:48 UTC
  • mfrom: (1.1.5)
  • Revision ID: package-import@ubuntu.com-20120404213648-vrgixrp1b1751keo
Tags: 0.0.20120331-1
http://bugs.debian.org/667481
* New upstream release (neither ALI nor SO changes).
* watch: search for bz2 tarballs too.
* control: -dbg does not Pre-Depends: ${misc:Pre-Depends} for multiarch.
  -dev Depends: libmpfr-dev and libgmp-dev (Closes: #667481).
* ada_libraries, control, rules: use dh_ada_library.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/gnu_multiple_precision-aux.adb
20
20
package body GNU_Multiple_Precision.Aux is
21
21
 
22
22
   type Char_Array_Access is access char_array;
23
 
   procedure Free is new Ada.Unchecked_Deallocation (char_array, Char_Array_Access);
 
23
   procedure Free is new Ada.Unchecked_Deallocation (char_array,
 
24
                                                     Char_Array_Access);
24
25
   --  Since we will allocate huge buffers, we have to allocate on the
25
26
   --  heap to avoid stack overflow.
26
27
 
53
54
      Width         : in Natural;
54
55
      Base          : in Integer)
55
56
   is
56
 
      Buffer   : Char_Array_Access := new char_array (0 .. Mpz_Sizeinbase (Item, int (Base)) + 1);
57
 
      Length   : size_t := Buffer'Last - 2; --  no sign and mpz_sizeinbase overestimated
 
57
      Buffer   : Char_Array_Access
 
58
        := new char_array (0 .. Mpz_Sizeinbase (Item, int (Base)) + 1);
 
59
      Length   : size_t
 
60
        := Buffer'Last - 2; --  no sign and mpz_sizeinbase overestimated
58
61
      Negative : Boolean;
59
62
   begin
60
63
      Mpz_Get_Str (Buffer.all, int (Base), Item);
64
67
      end loop;
65
68
      case Base is
66
69
         when 2 .. 9 =>
67
 
            for I in Natural (Length) + 4 .. Width loop Put_Character.all (' '); end loop;
 
70
            for I in Natural (Length) + 4 .. Width loop
 
71
               Put_Character.all (' ');
 
72
            end loop;
68
73
            if Negative then Put_Character.all ('-'); end if;
69
74
            Put_Character.all (Character'Val (Base + Character'Pos ('0')));
70
75
            Put_Character.all ('#');
71
76
         when 10 =>
72
 
            for I in Natural (Length) + 1 .. Width loop Put_Character.all (' '); end loop;
 
77
            for I in Natural (Length) + 1 .. Width loop
 
78
               Put_Character.all (' ');
 
79
            end loop;
73
80
            if Negative then Put_Character.all ('-'); end if;
74
81
         when 11 .. 16 =>
75
 
            for I in Natural (Length) + 5 .. Width loop Put_Character.all (' '); end loop;
 
82
            for I in Natural (Length) + 5 .. Width loop
 
83
               Put_Character.all (' ');
 
84
            end loop;
76
85
            if Negative then Put_Character.all ('-'); end if;
77
86
            Put_Character.all ('1');
78
 
            Put_Character.all (Character'Val (Base - 10 + Character'Pos ('0')));
 
87
            Put_Character.all (Character'Val
 
88
                                 (Base - 10 + Character'Pos ('0')));
79
89
            Put_Character.all ('#');
80
90
         when others =>
81
91
            null;
120
130
      end loop;
121
131
      case Base is
122
132
         when 2 .. 9 =>
123
 
            for I in Natural (Length) + 4 .. Width loop Put_Character.all (' '); end loop;
 
133
            for I in Natural (Length) + 4 .. Width loop
 
134
               Put_Character.all (' ');
 
135
            end loop;
124
136
            if Negative then Put_Character.all ('-'); end if;
125
137
            Put_Character.all (Character'Val (Base + Character'Pos ('0')));
126
138
            Put_Character.all ('#');
127
139
         when 10 =>
128
 
            for I in Natural (Length) + 1 .. Width loop Put_Character.all (' '); end loop;
 
140
            for I in Natural (Length) + 1 .. Width loop
 
141
               Put_Character.all (' ');
 
142
            end loop;
129
143
            if Negative then Put_Character.all ('-'); end if;
130
144
         when 11 .. 16 =>
131
 
            for I in Natural (Length) + 5 .. Width loop Put_Character.all (' '); end loop;
 
145
            for I in Natural (Length) + 5 .. Width loop
 
146
               Put_Character.all (' ');
 
147
            end loop;
132
148
            if Negative then Put_Character.all ('-'); end if;
133
149
            Put_Character.all ('1');
134
 
            Put_Character.all (Character'Val (Base - 10 + Character'Pos ('0')));
 
150
            Put_Character.all (Character'Val
 
151
                                 (Base - 10 + Character'Pos ('0')));
135
152
            Put_Character.all ('#');
136
153
         when others =>
137
154
            null;
201
218
   begin
202
219
      if Exp > 0 then
203
220
         declare
204
 
            Buffer : Char_Array_Access := new char_array (1 .. size_t (Actual_Fore + Actual_Aft) + 2); --  sign, nul
 
221
            Buffer : Char_Array_Access
 
222
              := new char_array (1 .. size_t (Actual_Fore + Actual_Aft) + 2);
 
223
            --  2 for sign and nul
205
224
         begin
206
225
            Mpf_Get_Str (Buffer.all, Exponent, 10, Buffer'Length - 2, Item);
207
226
            Blank_And_Sign (Buffer.all, 1);
208
 
            if Buffer.all (Next_In) /= nul then Exponent := Exponent - 1; end if;
 
227
            if Buffer.all (Next_In) /= nul then
 
228
               Exponent := Exponent - 1;
 
229
            end if;
209
230
            Copy (Buffer.all);
210
231
            Put_Character.all ('.');
211
232
            for I in 1 .. Actual_Aft loop Copy (Buffer.all); end loop;
215
236
            begin
216
237
               if Exponent >= 0 then E_Img (1) := '+'; end if;
217
238
               Put_Character.all (E_Img (1));
218
 
               for I in E_Img'Length + 1 .. Exp loop Put_Character.all ('0'); end loop;
219
 
               for I in 2 .. E_Img'Last loop Put_Character.all (E_Img (I)); end loop;
 
239
               for I in E_Img'Length + 1 .. Exp loop
 
240
                  Put_Character.all ('0');
 
241
               end loop;
 
242
               for I in 2 .. E_Img'Last loop
 
243
                  Put_Character.all (E_Img (I));
 
244
               end loop;
220
245
            end;
221
246
            Free (Buffer);
222
247
         exception
230
255
            --  10^{d-1} \leqslant Arg < 10^d
231
256
            --  \ln Arg < d\ln 10 \leqslant \ln Arg + \ln 10
232
257
            --  \ln Arg < b\ln 2  \leqslant \ln Arg + \ln 2
233
 
            --  d \leqslant \frac{\ln Arg}{\ln 10} + 1 < b\frac{\ln 2}{\ln 10} + 1 < b / 3 + 1
 
258
            --  d \leqslant \frac{\ln Arg}{\ln 10} + 1
 
259
            --            < b\frac{\ln 2}{\ln 10} + 1 < b / 3 + 1
234
260
            N_Digits : constant unsigned_long
235
261
              := unsigned_long'Max (1, Mpf_Get_Prec (Item) / 3);
236
 
            --  We want to be sure to ask at least one digit, no C allocated-string.
237
 
            Buffer : Char_Array_Access := new char_array (1 .. size_t (N_Digits) + 2); --  sign nul
 
262
            --  We want to be sure to ask at least one digit, no C
 
263
            --  allocated-string.
 
264
            Buffer : Char_Array_Access
 
265
              := new char_array (1 .. size_t (N_Digits) + 2); --  sign nul
238
266
         begin
239
267
            Mpf_Get_Str (Buffer.all, Exponent, 10, Buffer'Length - 2, Item);
240
268
            if Exponent > 0 then
248
276
               Put_Character.all ('0');
249
277
               Put_Character.all ('.');
250
278
               if Mp_Exp_T (Actual_Aft) <= Exponent then
251
 
                  for I in 1 .. Actual_Aft loop Put_Character.all ('0'); end loop;
 
279
                  for I in 1 .. Actual_Aft loop
 
280
                     Put_Character.all ('0');
 
281
                  end loop;
252
282
               else
253
283
                  for I in 1 .. Exponent loop
254
284
                     Put_Character.all ('0');
272
302
      procedure Blanks_And_Sign (Buffer   : in out char_array;
273
303
                                 Next_Out : in out size_t);
274
304
 
275
 
      procedure Scan_Based_Numeral (Action : access procedure; --  Consuming a digit
276
 
                                    Base   : in     int);
 
305
      procedure Scan_Based_Numeral
 
306
        (Action : access procedure;     --  Consuming a digit
 
307
         Base   : in     int);
277
308
      procedure Copy (Buffer   : in out char_array;
278
309
                      Next_Out : in out size_t);
279
310
      procedure Copy_Numeral (Buffer    : in out char_array;
300
331
         end if;
301
332
      end Blanks_And_Sign;
302
333
 
303
 
      procedure Scan_Based_Numeral (Action : access procedure; --  Consuming a digit
304
 
                                    Base   : in int)
 
334
      procedure Scan_Based_Numeral
 
335
        (Action : access procedure; --  Consuming a digit
 
336
         Base   : in int)
305
337
      is
306
338
         Digit_Is_Mandatory : Boolean := True;
307
339
      begin
364
396
         Start    : constant size_t := Next_Out;
365
397
         Dot_Seen : Boolean;
366
398
      begin
367
 
         Copy_Numeral (Buffer, Next_Out, Dot_Seen, 10, Allow_Dot => Allow_Float);
 
399
         Copy_Numeral (Buffer, Next_Out, Dot_Seen, 10,
 
400
                       Allow_Dot => Allow_Float);
368
401
         if Next /= '#' or Dot_Seen then
369
402
            Base := 10;
370
403
         else
371
404
            Consume;
372
405
            Base := 0;
373
406
            for I in Start .. Next_Out - 1 loop
374
 
               Base := Base * 10 + char'Pos (Buffer (I)) - char'Pos (To_C ('0'));
 
407
               Base := Base * 10
 
408
                 + char'Pos (Buffer (I)) - char'Pos (To_C ('0'));
375
409
               if Base > 16 then raise Ada.IO_Exceptions.Data_Error; end if;
376
410
               --  Check it before an overflow occurs.
377
411
            end loop;
378
412
            if Base < 2 then raise Ada.IO_Exceptions.Data_Error; end if;
379
413
            Next_Out := Start;
380
 
            Copy_Numeral (Buffer, Next_Out, Dot_Seen, Base, Allow_Dot => Allow_Float);
 
414
            Copy_Numeral (Buffer, Next_Out, Dot_Seen, Base,
 
415
                          Allow_Dot => Allow_Float);
381
416
            if Next /= '#' then
382
417
               raise Ada.IO_Exceptions.Data_Error;
383
418
            end if;
388
423
      procedure Get_Mpz_T (Item  : in out Mpz_T;
389
424
                           Width : in     Natural)
390
425
      is
391
 
         Buffer    : Char_Array_Access := new char_array (1 .. size_t (Width) + 1); --  Keep space for nul.
 
426
         Buffer    : Char_Array_Access
 
427
           := new char_array (1 .. size_t (Width) + 1); --  Keep space for nul.
392
428
         Next_Out  : size_t := Buffer'First;
393
429
         Base, Ret : int;
394
430
         Exponent  : unsigned_long := 0;
395
431
         Temp      : Mpz_T;
396
432
         procedure Action;
397
433
         procedure Action is begin
398
 
            Exponent := Exponent * 10 + Character'Pos (Next) - Character'Pos ('0');
 
434
            Exponent := Exponent * 10
 
435
              + Character'Pos (Next) - Character'Pos ('0');
399
436
            Consume;
400
437
         end Action;
401
438
      begin
410
447
            Scan_Based_Numeral (Action'Access, 10);
411
448
            Mpz_Init (Temp);
412
449
            Mpz_Ui_Pow_Ui (Temp, 10, Exponent);
413
 
            pragma Warnings (Off, "writable actual for ""Rop"" overlaps with actual for ""Op1""");
 
450
            pragma Warnings
 
451
              (Off,
 
452
               "writable actual for ""Rop"" overlaps with actual for ""Op1""");
414
453
            Mpz_Mul (Item, Item, Temp);
415
 
            pragma Warnings (On, "writable actual for ""Rop"" overlaps with actual for ""Op1""");
 
454
            pragma Warnings
 
455
              (On,
 
456
               "writable actual for ""Rop"" overlaps with actual for ""Op1""");
416
457
            Mpz_Clear (Temp);
417
458
         end if;
418
459
         Free (Buffer);
425
466
      procedure Get_Mpf_T (Item  : in out Mpf_T;
426
467
                           Width : in     Natural)
427
468
      is
428
 
         Buffer    : Char_Array_Access := new char_array (1 .. size_t (Width) + 1); --  Keep space for nul.
 
469
         Buffer    : Char_Array_Access
 
470
           := new char_array (1 .. size_t (Width) + 1); --  Keep space for nul.
429
471
         Next_Out  : size_t := Buffer'First;
430
472
         Base, Ret : int;
431
473
         Dot_Seen  : Boolean;
441
483
            elsif Next = '-' then
442
484
               Copy (Buffer.all, Next_Out);
443
485
            end if;
444
 
            Copy_Numeral (Buffer.all, Next_Out, Dot_Seen, 10, Allow_Dot => False);
 
486
            Copy_Numeral (Buffer.all, Next_Out, Dot_Seen, 10,
 
487
                          Allow_Dot => False);
445
488
         end if;
446
489
         Buffer.all (Next_Out) := nul;
447
490
         Mpf_Set_Str (Ret, Item, Buffer.all, -Base);