public inbox for gcc-prs@sourceware.org
help / color / mirror / Atom feed
* Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
@ 2003-05-13 6:35 steven
0 siblings, 0 replies; 5+ messages in thread
From: steven @ 2003-05-13 6:35 UTC (permalink / raw)
To: duncan.sands, gcc-bugs, gcc-prs, nobody
Synopsis: Internal compiler error in loc_descriptor_from_tree
State-Changed-From-To: open->feedback
State-Changed-By: steven
State-Changed-When: Tue May 13 06:34:59 2003
State-Changed-Why:
Dara has asked for feedback
http://gcc.gnu.org/cgi-bin/gnatsweb.pl?cmd=view%20audit-trail&database=gcc&pr=7984
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
@ 2003-05-13 17:46 Dara Hazeghi
0 siblings, 0 replies; 5+ messages in thread
From: Dara Hazeghi @ 2003-05-13 17:46 UTC (permalink / raw)
To: nobody; +Cc: gcc-prs
The following reply was made to PR ada/7984; it has been noted by GNATS.
From: Dara Hazeghi <dhazeghi@yahoo.com>
To: Duncan Sands <duncan.sands@wanadoo.fr>, gcc-gnats@gcc.gnu.org
Cc:
Subject: Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
Date: Tue, 13 May 2003 10:43:17 -0700 (PDT)
Thanks for the feedback. Note that to reproduce this
bug, only -g is needed (so I'm guessing it's a
debugging problem, because it compiles fine without
-g). I can reproduce this problem on gcc 3.2, 3.3. On
mainline (20030512), your code compiles fine. Thanks,
Dara
__________________________________
Do you Yahoo!?
The New Yahoo! Search - Faster. Easier. Bingo.
http://search.yahoo.com
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
@ 2003-05-13 9:36 Duncan Sands
0 siblings, 0 replies; 5+ messages in thread
From: Duncan Sands @ 2003-05-13 9:36 UTC (permalink / raw)
To: nobody; +Cc: gcc-prs
The following reply was made to PR ada/7984; it has been noted by GNATS.
From: Duncan Sands <duncan.sands@wanadoo.fr>
To: Dara Hazeghi <dhazeghi@yahoo.com>,
gcc-gnats@gcc.gnu.org
Cc:
Subject: Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
Date: Tue, 13 May 2003 11:35:36 +0200
On Tuesday 13 May 2003 01:39, Dara Hazeghi wrote:
> http://gcc.gnu.org/cgi-bin/gnatsweb.pl?cmd=view%20audit-
> trail&database=gcc&pr=7984
>
> Hello,
>
> this is not a proper bug report. As the bug box says, you need to
> include the files which are crashing the compiler. If this problem is
> still occurring for you please send a concatentation of the files which
> are crashing it. If not, tell us, and we will close this bug report.
> Thanks you,
>
> Dara
Sorry about that. The bug still exists with gcc-3.3:
$ gcc-3.3 -c -gnata -g -gnatwa -gnato -fstack-check -funwind-tables multi_precision_integers.adb
+===========================GNAT BUG DETECTED==============================+
| 3.3 20030509 (Debian prerelease) (i386-pc-linux-gnu) GCC error: |
| in loc_descriptor_from_tree, at dwarf2out.c:8754 |
| Error detected at /usr/lib/gcc-lib/i386-linux/3.3/adainclude/s-secsta.ads:65:14|
| Please submit a bug report; see http://gcc.gnu.org/bugs.html. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc-3.3 or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| concatenated together with no headers between files. |
+==========================================================================+
Please include these source files with error report
multi_precision_integers.adb
multi_precision_integers.ads
multi_precision_integers.adb:512:35: warning: useless conversion, "v1" has this type
multi_precision_integers.adb:1081:18: warning: condition is always False
multi_precision_integers.adb:1084:16: warning: condition is always False
compilation abandoned
-----------------------------------------------------------------------------
-- File: mupreint.adb; see specification (mupreint.ads)
-----------------------------------------------------------------------------
-- 15-Feb-2002: "zero" bugs fixed by Duncan Sands
-- To-do/bug symbol: !!!
-- with Text_IO; use Text_IO; -- <--- still here for debugging purposes
package body Multi_precision_integers is
-- package IIO is new Integer_IO(integer); use IIO; -- <--- for debugging
DEBUG: constant Boolean:= True;
Internal_error: exception;
Not_done: exception;
type compar is (smaller, equal, greater);
function Min(a,b:index_int) return index_int is
begin if a<b then return a; else return b; end if; end;
function Max(a,b:index_int) return index_int is
begin if a>b then return a; else return b; end if; end;
procedure Test( m: multi_int; test_last: boolean:= true ) is
last_nz: index_int:= 0;
Negative_block, Overflown_block,
Last_index_has_zero,
Field_last_outside_range, Field_last_is_negative: exception;
begin
if m.zero then return; end if; -- 0, nothing to test
if m.last_used > m.n then raise Field_last_outside_range; end if;
if m.last_used < 0 then raise Field_last_is_negative; end if;
for i in 0 .. m.last_used loop
if m.blk(i) < 0 then
raise Negative_block;
end if;
if not (m.blk(i) in block) then
raise Overflown_block;
end if;
if m.blk(i) /= 0 then
last_nz:= i;
end if;
end loop;
if test_last and then 0 < last_nz and then last_nz < m.last_used then
raise Last_index_has_zero;
end if;
end Test;
-- Another names (because of randomness in DEC Ada trace-back's line numbers)
procedure Testarossa( m: multi_int ) is begin Test(m); end;
procedure Testaverde( m: multi_int ) is begin Test(m); end;
procedure Testazzuro( m: multi_int ) is begin Test(m); end;
procedure Reduce_last_nonzero( n: in out multi_int ) is
old_last: index_int:= n.last_used;
begin
if DEBUG then Test(n, test_last=> false); end if;
if n.zero then -- We avoid de-zeroing accidentally
return; -- and returning a false non-zero with rubbish :-)
end if;
n.zero:= True;
n.last_used:= 0;
for i in 0 .. old_last loop
if n.blk(i) /= 0 then
n.zero:= False;
n.last_used:= i; -- NB: can be 0
end if;
end loop;
end Reduce_last_nonzero;
function Compare_absolute (i1,i2: multi_int) return compar is
l1, l2: index_int;
begin
-- On ne compare que ABS(i1) et ABS(i2)
l1:= i1.last_used;
l2:= i2.last_used;
if l1 > l2 then -- i1 a plus de blocs non nuls
return greater;
elsif l1 < l2 then -- i1 a moins de blocs non nuls
return smaller;
else -- i1 et i2 ont le meme nb de blocs
for i in reverse 0 .. l1 loop -- on parcourt du + signifiant au -
if i1.blk(i) > i2.blk(i) then -- <<chiffre>> de i1 plus grand
return greater;
elsif i1.blk(i) < i2.blk(i) then -- <<chiffre>> de i1 plus petit
return smaller;
end if;
-- M\^emes chiffres -> au suivant!
end loop;
-- Bon, les 2 nombres sont egaux!
return equal;
end if;
end Compare_absolute;
----- Informations, conversions
function Multi(small: basic_int) return multi_int is
abss: basic_int:= ABS(small);
reste: basic_int;
negs: boolean:= small < 0;
Conversion_overflow : exception;
begin
if abss<= maxblock then
return ( n=> 0, -- 1 bloc suffit
blk=> (0=> abss), -- le bloc contient le nombre
neg=> negs,
zero=> small = 0,
last_used=> 0
);
else
reste:= abss / cardblock;
if reste <= maxblock then
return ( n=> 1, -- il faut 2 blocs
blk=> (0=> abss MOD cardblock, -- bloc 0
1=> reste), -- bloc 1
neg=> negs,
zero=> false,
last_used=> 1
);
else
if reste / cardblock > maxblock then
Raise Conversion_overflow;
end if;
return ( n=> 2, -- il faut 3 blocs (e.g. 31 bits 15+15+1)
blk=> (0=> abss MOD cardblock, -- bloc 0
1=> reste MOD cardblock, -- bloc 1
2=> reste / cardblock), -- bloc 2
neg=> negs,
zero=> false,
last_used=> 2
);
end if;
end if;
end;
-- Convert multi_int to basic_int (when possible, else: Cannot_fit raised)
function Basic(large:multi_int) return basic_int is
begin
if large.zero then return 0; end if; -- <- 17-Feb-2002
if large.last_used > 0 then raise Cannot_fit; end if;
return large.blk(0);
end;
-- 14-Feb-2002: "zero" bug fixed by Duncan Sands
procedure Fill(what: out multi_int; with_smaller:multi_int) is
l: constant index_int:= with_smaller.last_used;
begin
if DEBUG then Test(with_smaller); end if;
what.zero:= with_smaller.zero;
if with_smaller.zero then
return;
end if;
if what.n < l then
raise Array_too_small; -- contenant trop petit
end if;
for i in 0 .. l loop -- copie
what.blk (i) := with_smaller.blk(i);
end loop;
what.neg:= with_smaller.neg;
what.last_used:= l;
end Fill;
---------------------------
----- Unary operators -----
---------------------------
function "+" (i: multi_int) return multi_int is begin return i; end;
procedure Opp(i: in out multi_int) is
begin
i.neg:= NOT i.neg; -- -0 possible
end Opp;
function "-" (i: multi_int) return multi_int is
res: multi_int(i.n):= i; -- copy + stack :-(
begin
Opp(res);
return res;
end "-";
procedure Abso(i: in out multi_int) is
begin
i.neg:= False;
end Abso;
function "Abs" (i: multi_int) return multi_int is
abs_i: multi_int(i.n):= i; -- copy + stack :-(
begin
if DEBUG then Test(i); end if;
abs_i.neg:= False;
return abs_i;
end "Abs";
function Sign(i: multi_int) return basic_int is
begin
if i.zero then return 0;
elsif i.neg then return -1;
else return +1;
end if;
end Sign;
function Even(i: multi_int) return boolean is
begin
return i.zero or else i.blk(0) MOD 2 = 0;
end Even;
function Odd (i: multi_int) return boolean is
begin
return (NOT i.zero) and then i.blk(0) MOD 2 = 1;
end Odd;
----------------------------
----- Binary operators -----
----------------------------
-- Internal algorithm to add two numbers AS POSITIVE ( > 0 ) !
procedure Add_absolute(i1,i2: in multi_int; i3: out multi_int) is
l1: constant index_int:= i1.last_used;
l2: constant index_int:= i2.last_used;
min_ind: constant index_int:= Min( l1, l2 );
max_ind: constant index_int:= Max( l1, l2 );
retenue_finale, s: basic_int:= 0;
begin
if DEBUG then Test(i1); Test(i2); end if;
if max_ind > i3.n then raise Result_undersized; end if; -- 17-Feb-2002
-- (1) On additionne sur le <<support commun>>
for ind in 0 .. min_ind loop
s:= i1.blk(ind) + i2.blk(ind) +
s / cardblock; -- (retenue)
i3.blk(ind):= s MOD cardblock;
end loop;
-- (2) On poursuit au besoin si i1 a plus de blocs...
if l1 > min_ind then
for ind in min_ind+1 .. max_ind loop
s:= i1.blk(ind) +
s / cardblock; -- (retenue)
i3.blk(ind):= s MOD cardblock;
end loop;
-- ... ou bien si i2 en a plus.
elsif l2 > min_ind then
for ind in min_ind+1 .. max_ind loop
s:= i2.blk(ind) +
s / cardblock; -- (retenue)
i3.blk(ind):= s MOD cardblock;
end loop;
end if;
-- (3) Il peut rester une retenue
retenue_finale:= s / cardblock;
if retenue_finale /= 0 then
if max_ind+1 > i3.n then raise Result_undersized; end if; -- 17-Feb-2002
i3.blk(max_ind+1):= retenue_finale;
i3.last_used:= max_ind+1;
else
i3.last_used:= max_ind;
end if;
-- (4) i3 = i1+i2 > 0
i3.neg:= False;
i3.zero:= False;
end Add_absolute;
-- Internal algorithm to subtract two numbers AS POSITIVE ( > 0 ) !
procedure Sub_absolute(i1,i2: in multi_int; i3: in out multi_int;
sgn: out boolean) is
l1: constant index_int:= i1.last_used;
l2: constant index_int:= i2.last_used;
max_ind: constant index_int:= Max( l1, l2 );
ai, bi, s: basic_int;
begin
if DEBUG then Test(i1); Test(i2); end if;
if max_ind > i3.n then raise Result_undersized; end if; -- 17-Feb-2002
i3.last_used:= 0;
i3.zero:= true;
s:= 0;
-- (1) Soustraction avec retenue
for ind in 0 .. max_ind loop
if ind <= l1 then ai:= i1.blk(ind); else ai:= 0; end if;
if ind <= l2 then bi:= i2.blk(ind) + s; else bi:= s; end if;
if ai < bi then
ai:= ai + cardblock;
s:= 1;
else
s:= 0;
end if;
i3.blk(ind):= ai-bi;
if ai-bi /= 0 then -- au passage, on corrige .last_used et .zero
i3.last_used:= ind;
i3.zero:= False;
end if;
end loop;
-- (2) Traitement de la derni\`ere retenue
if s = 0 then
i3.neg := False;
sgn := False;
else
i3.neg := True;
sgn := True;
i3.last_used:= 0;
s:= 1; -- on fait "9-chaque chiffre" et on ajoute 1 au tout (s=retenue)
for i in 0 .. max_ind loop
s:= maxblock - i3.blk(i) + s;
i3.blk(i):= s MOD cardblock;
if i3.blk(i) /= 0 then
i3.last_used:= i;
end if;
s:= s / cardblock;
end loop;
end if;
end Sub_absolute;
procedure Add(i1,i2: in multi_int; i3: in out multi_int) is
sgn: Boolean;
begin
-- (1) Les cas o\`u i1 ou i2 = 0
if i1.zero and i2.zero then i3.zero:= True;
elsif i1.zero then Fill( i3, i2 );
elsif i2.zero then Fill( i3, i1 );
-- (2) Maintenant: i1 /= 0 et i2 /= 0; on regarde les signes
-- (2.1) Facile: i1 et i2 de m\^eme signe
elsif i1.neg = i2.neg then
Add_absolute( i1,i2, i3 ); -- On fait comme si i1>0 et i2>0
i3.neg:= i1.neg; -- et on met le bon signe
-- (2.2) i1 < 0, i2 > 0, donc i3 = i2 - abs(i1)
elsif i1.neg and not i2.neg then
Sub_absolute( i2,i1, i3, sgn);
-- (2.3) i1 > 0, i2 < 0, donc i3 = i1 - abs(i2)
elsif i2.neg and not i1.neg then
Sub_absolute( i1,i2, i3, sgn );
end if;
end Add;
function "+" (i1,i2: multi_int) return multi_int is
somme: multi_int( Max(i1.n, i2.n) + 1 );
begin
Add( i1,i2, somme );
return somme;
end "+";
procedure Sub(i1,i2: in multi_int; i3: in out multi_int) is
sgn: Boolean;
begin
-- (1) Les cas o\`u i1 ou i2 = 0
if i1.zero and i2.zero then i3.zero:= True;
elsif i1.zero then Fill( i3, i2 ); i3.neg:= NOT i2.neg;
elsif i2.zero then Fill( i3, i1 );
-- (2) Maintenant: i1 /= 0 et i2 /= 0; on regarde les signes
-- (2.1) Facile: i1 et i2 de m\^eme signe
elsif i1.neg = i2.neg then
Sub_absolute( i1,i2, i3, sgn ); -- On fait comme si i1>0 et i2>0
if i1.neg then -- et on met le bon signe
i3.neg:= NOT sgn;
else
i3.neg:= sgn;
end if;
-- (2.2) i1 < 0, i2 > 0, donc i3 = i1-i2 = - (abs(i1) + abs(i2))
elsif i1.neg and not i2.neg then
Add_absolute( i1,i2, i3 );
i3.neg:= True;
-- (2.3) i1 > 0, i2 < 0, donc i3 = i1-i2 = i1 + (-i2) = i1 + abs(i2)
elsif i2.neg and not i1.neg then
Add_absolute( i1,i2, i3 );
end if;
end Sub;
function "-" (i1,i2: multi_int) return multi_int is
diff: multi_int( Max(i1.n, i2.n) + 1); -- +1: retenue possible (add_abs.)
begin
Sub( i1,i2, diff );
return diff;
end "-";
function "+" (i1: multi_int; i2: basic_int) return multi_int is
begin return i1 + Multi(i2); end;
function "+" (i1: basic_int; i2: multi_int) return multi_int is
begin return Multi(i1) + i2; end;
function "-" (i1: multi_int; i2: basic_int) return multi_int is
begin return i1 - Multi(i2); end;
function "-" (i1: basic_int; i2: multi_int) return multi_int is
begin return Multi(i1) - i2; end;
procedure Multiply(i1,i2: in multi_int; i3: in out multi_int) is
l1: index_int:= i1.last_used;
l2: index_int:= i2.last_used;
d,s : long_basic_int;
k : index_int;
res : block_array( i3.blk'range );
-- res: buffer to avoid problems with Multiply(i,j,i) or Multiply(j,i,i)
begin
if DEBUG then Test(i1); Test(i2); end if;
if l1+l2+2 > i3.n then raise Result_undersized; end if; -- 17-Feb-2002
if i1.zero or i2.zero then
i3.zero:= True;
Return;
end if;
for k in res'range loop res(k):= 0; end loop;
i3.zero:= False;
i3.last_used:= i3.n;
for j in 0..l1 loop
d:= 0;
k:= j;
for i in 0..(l2+1) loop
if i <= l2 then
d:= d / cardblock +
long_basic_int(i1.blk(j)) * long_basic_int(i2.blk(i));
else
d:= d / cardblock;
end if;
s:= long_basic_int(res(k)) + d MOD cardblock;
res(k):= block(s MOD cardblock); -- somme
res(k+1):= res(k+1) + block(s / cardblock); -- retenue
k:= k + 1;
end loop;
end loop;
i3.blk:= res;
Reduce_last_nonzero( i3 );
i3.neg:= i1.neg /= i2.neg;
end Multiply;
function "*" (i1,i2: multi_int) return multi_int is
begin
if i1.zero or i2.zero then
return Multi(0);
else
declare
prod: Multi_int( i1.last_used + i2.last_used + 2 );
begin
Multiply( i1,i2, prod );
Return prod;
end;
end if;
end "*";
function "*" (i1: multi_int; i2: basic_int) return multi_int is
begin return i1 * Multi(i2); end;
function "*" (i1: basic_int; i2: multi_int) return multi_int is
begin return Multi(i1) * i2; end;
----- Begin of DIVISION part -----
-- Interne: Division et reste en 1 coup
procedure Div_Rem(a,b: long_basic_int; q,r: in out long_basic_int) is
Conflict_with_REM: exception;
begin
q:= a / b;
r:= a - b*q;
if DEBUG and then r /= (a rem b) then
Raise Conflict_with_REM;
end if;
end Div_Rem;
procedure Divide_absolute_normalized ( u: in out multi_int;
v: in multi_int;
q: in out multi_int ) is
qi: index_int := u.last_used - v.last_used - 1; -- was: q.n; D.S. Feb-2002
v1: long_basic_int := long_basic_int(v.blk(v.last_used ));
v2: long_basic_int := long_basic_int(v.blk(v.last_used-1));
udigits : block_array renames u.blk;
vdigits : block_array renames v.blk;
vlast : index_int := v.last_used;
v1L : long_basic_int := long_basic_int(v1);
guess : long_basic_int ;
comparand : long_basic_int ;
function Divide_subtract ( ustart: index_int ) return block is
ui : index_int := ustart;
carry : long_basic_int := 0;
begin
if guess = 0 then
return 0;
end if;
-- On soustrait (le chiffre du quotient) * diviseur au dividende
for vi in 0 .. vlast loop
declare
prod: long_basic_int:= long_basic_int(vdigits(vi)) * guess + carry;
bpro: block := block(prod MOD cardblock);
diff: basic_int := udigits(ui) - bpro;
begin
if diff < 0 then
udigits(ui) := diff + cardblock;
carry := (prod / cardblock) + 1;
else
udigits(ui) := diff;
carry := (prod / cardblock);
end if;
ui:= ui + 1;
end;
end loop;
if carry = 0 then
return block(guess MOD cardblock);
end if;
declare
diff: basic_int := udigits(ui) - basic_int(carry MOD cardblock);
begin
if diff < 0 then
udigits(ui) := diff + cardblock; -- carry generated
else
udigits(ui) := diff;
return block(guess MOD cardblock);
end if;
end;
-- Carry was generated
declare
icarry: basic_int := 0;
begin
ui := ustart;
for vi in 0 .. vlast loop
declare
sum: basic_int := vdigits(vi) + udigits(ui) + icarry;
begin
udigits(ui) := sum MOD cardblock;
ui:= ui + 1;
icarry := sum / cardblock;
end;
end loop;
if icarry = 1 then
udigits(ui) := (udigits(ui)+1) MOD cardblock;
end if;
end;
return block( (guess-1) MOD cardblock );
end Divide_subtract;
begin -- Divide_absolute_normalized
-- In this algorithm, we are using q's contents although,
-- for a while, q.zero = True
for i in q.blk'range loop q.blk(i):= 0; end loop;
q.last_used:= qi; -- was: q.n; D.S. Feb-2002
q.zero:= True;
for j in reverse vlast+1 .. u.last_used loop
declare
uj : long_basic_int := long_basic_int(udigits(j));
uj1: long_basic_int := long_basic_int(udigits(j-1));
uj2: long_basic_int := long_basic_int(udigits(j-2));
ujL: long_basic_int;
rmL: long_basic_int;
begin
-- if uj = v1 then
-- Code BigInt suspect (resultat faux)
-- guess := cardblock-1;
-- comparand := uj1 * cardblock + uj2 + v1;
-- Code du cas general, adapte au fait que uj=v1=v1L
-- -- ujL / uj = cardblock, donc...
-- guess := cardblock;
-- -- ujL rem uj = uj1
-- comparand := (uj1 * cardblock) + uj2;
-- else -- cas general
ujL := uj * cardblock + uj1;
Div_Rem( ujL, v1L, guess, rmL );
comparand := (rmL * cardblock) + uj2;
-- end if;
while comparand < v2 * guess loop
guess:= guess - 1;
comparand:= comparand + v1L * cardblock;
exit when comparand > cardblock * cardblock;
end loop;
q.blk(qi) := Divide_subtract( j - vlast - 1 );
if DEBUG and then NOT (q.blk(qi) in block) then
raise Internal_error;
end if;
if q.zero and then q.blk(qi) /= 0 then -- n'arrive que 0 ou 1 fois
q.zero:= false;
q.last_used:= qi;
end if;
qi:= qi - 1;
end;
end loop; -- j
if DEBUG then Test(q); end if;
end Divide_absolute_normalized;
-- Calculate u/v
procedure Divide_absolute ( u,v: in multi_int;
q,r: in out multi_int ) is
shift: integer:= 0;
v1: block:= v.blk(v.last_used);
v_zero, v1_zero: exception;
u_work: multi_int(u.last_used+2);
procedure Normalization ( source: in multi_int;
target: in out multi_int ) is
carry: integer:= 0;
tl: constant index_int:= target.last_used;
to_left_factor : constant integer:= 2 ** shift;
to_right_factor : constant integer:= cardblock / to_left_factor;
blk: block;
no_room_for_carry: exception;
begin
for i in 0 .. source.last_used loop
blk:= source.blk(i);
target.blk(i) := ((blk MOD to_right_factor) * to_left_factor) + carry;
carry := blk / to_right_factor;
end loop;
-- tabuler les MOD et / pour faire AND et shift !!!
if source.last_used < tl then
target.blk(source.last_used+1):= carry;
end if;
for i in source.last_used+2 .. tl loop
target.blk(i):= 0;
end loop;
end Normalization;
procedure Unnormalization ( m: in out multi_int) is
carry: integer:= 0;
to_right_factor : constant integer:= 2 ** shift;
to_left_factor : constant integer:= cardblock / to_right_factor;
blk: block;
begin
for i in reverse 0 .. m.last_used loop
blk:= m.blk(i);
m.blk(i) := (blk / to_right_factor) + carry;
carry := (blk MOD to_right_factor) * to_left_factor;
end loop;
end Unnormalization;
begin -- Divide_absolute (multi u / multi v)
if DEBUG then
if v.zero then raise v_zero; end if;
if v1=0 then raise v1_zero; end if;
end if;
-- Calculate shift needed to normalize
u_work.last_used:= u_work.n;
u_work.zero:= false;
while v1 < cardblock/2 loop
shift:= shift + 1;
v1:= v1 * 2;
end loop;
if shift = 0 then -- no shift needed
u_work.blk( 0 .. u.last_used ):= u.blk( 0 .. u.last_used );
u_work.blk( u.last_used+1 .. u_work.last_used):= (0,0);
Divide_absolute_normalized( u_work,v, q );
else
declare -- shift needed
v_work: multi_int(v.last_used);
begin
v_work.last_used:= v_work.n;
Normalization( u, u_work );
Normalization( v, v_work );
Reduce_last_nonzero( v_work );
Divide_absolute_normalized( u_work,v_work, q );
Unnormalization( u_work );
end;
end if;
u_work.neg:= false; -- check friendly
q.neg:= false; -- check friendly
Reduce_last_nonzero( u_work );
Fill( r, u_work );
end Divide_absolute;
procedure Divide_absolute_big_small ( u: in multi_int;
v: in basic_int;
q: in out multi_int;
r: in out basic_int ) is
lr: long_basic_int:= 0;
ln: long_basic_int;
lv: long_basic_int:= long_basic_int(v);
Quotient_constraint_error: exception;
last_u_nz: constant index_int:= u.last_used;
u_zero: constant boolean:= u.zero;
-- in case u and q are the same variables
begin
if q.n < last_u_nz then raise Quotient_constraint_error; end if;
q.last_used:= 0;
q.neg:= false;
q.zero:= True;
if u_zero then
r:= 0;
else
for i in reverse 0 .. last_u_nz loop
ln:= long_basic_int(u.blk(i)) + lr * cardblock;
lr:= ln MOD lv;
q.blk(i):= block(ln / lv);
if q.zero and then q.blk(i)/= 0 then
q.last_used:= i;
q.zero:= False;
end if;
end loop;
r:= basic_int(lr);
end if;
end Divide_absolute_big_small;
procedure Solve_signs_for_Div_Rem (i1n,i2n: in boolean; qn,rn: out boolean) is
begin
-- Invariant: i1= i2*q+r on cherche (pos) = (pos)*(pos)+(pos)
if i1n and i2n then -- i1<0; i2<0 (-i1) = (-i2) * q + (-r)
qn:= False; -- Quotient > 0
-- rn:= True; -- Reste < 0
elsif i1n then -- i1<0; i2>0 (-i1) = i2 *(-q) + (-r)
qn:= True; -- Quotient < 0
-- rn:= True; -- Reste < 0
elsif i2n then -- i1>0; i2<0 i1 = (-i2) *(-q) + r
qn:= True; -- Quotient < 0
-- rn:= False; -- Reste > 0
else -- i1>0; i2>0 i1 = i2 * q + r
qn:= False; -- Quotient > 0
-- rn:= False; -- Reste > 0
end if;
-- on observe que... "(A rem B) has the sign of A " ARM 4.5.5
-- en effet on peut mettre:
rn:= i1n;
end Solve_signs_for_Div_Rem;
procedure Div_Rem (i1: in multi_int; i2: in basic_int;
q : in out multi_int; r: in out basic_int) is
i1_neg: constant boolean:= i1.neg;
-- in case i1 and q are the same variables
rneg: boolean;
begin
if DEBUG then Test(i1); end if;
if i2=0 then Raise Division_by_zero; end if;
if i1.zero then -- 15-Feb-2002: 0/i2
q.zero:= True;
r:= 0;
return;
end if;
Divide_absolute_big_small( i1, Abs(i2), q,r );
Solve_signs_for_Div_Rem( i1_neg,i2<0, q.neg, rneg );
if rneg then r:= -r; end if;
end Div_Rem;
procedure Div_Rem (i1,i2: in multi_int; q,r: in out multi_int) is
Remainder_constraint_error: exception;
l1: constant index_int:= i1.last_used;
l2: constant index_int:= i2.last_used;
begin
if DEBUG then Test(i1); Test(i2); end if;
if i2.zero then Raise Division_by_zero; end if;
if i1.zero then -- 15-Feb-2002: 0/i2
q.zero:= True;
r.zero:= True;
return;
end if;
if q.n < l1 - l2 or r.n < Max( l1, l2 ) then -- 17-Feb-2002
raise Result_undersized;
end if;
if l2 = 0 then
if l1 = 0 then -- On a affaire a une ridicule division d'entiers
q.blk(0):= i1.blk(0) / i2.blk(0);
r.blk(0):= i1.blk(0) - i2.blk(0)*q.blk(0);
q.blk(0):= Abs(q.blk(0)); -- signes mis a la sortie...
q.zero:= q.blk(0) = 0;
q.last_used:= 0;
else -- multi / entier
Div_Rem ( i1, i2.blk(0), q, r.blk(0) );
end if;
r.blk(0):= Abs(r.blk(0)); -- signes mis a la sortie...
r.zero:= r.blk(0) = 0;
r.last_used:= 0;
else -- multi / multi
case Compare_absolute(i2 , i1) is
when greater =>
q.zero:= True; -- q:= 0;
q.last_used:= 0;
q.neg:= false;
Fill( r, i1 ); -- r:= i1, q:=0 car i1 = 0 * i2 (>i1 en v.abs) + r
Return;
when equal =>
Fill( q, Multi(1) );
Fill( r, Multi(0) );
when smaller => -- cas <<normal>>: diviseur < dividende
if l2 > r.n then
Raise Remainder_constraint_error;
end if;
Divide_absolute( i1,i2, q,r );
if DEBUG then Testazzuro(i1); Testaverde(i2); end if;
Reduce_last_nonzero( r );
if DEBUG then Test(q); Testarossa(r); end if;
end case;
end if;
Solve_signs_for_Div_Rem( i1.neg,i2.neg, q.neg,r.neg );
end Div_Rem;
function "/" (i1,i2: multi_int) return multi_int is
q: Multi_int( Max( 0, i1.last_used - i2.last_used + 1) );
r: Multi_int( Max( i1.last_used, i2.last_used) + 2 );
begin
Div_Rem(i1,i2, q,r);
return q;
end "/";
function "/" (i1: multi_int; i2: basic_int) return multi_int is
q: multi_int(i1.last_used + 1);
r: basic_int;
begin
Div_Rem(i1,i2, q,r);
return q;
end "/";
function "Rem" (i1,i2: multi_int) return multi_int is
q: multi_int(Max(0,i1.last_used - i2.last_used + 1));
r: multi_int(Max(i1.last_used,i2.last_used) + 2);
begin
Div_Rem(i1,i2, q,r);
return r;
end "Rem";
function "Rem" (i1: multi_int; i2: basic_int) return multi_int is
begin return i1 Rem Multi(i2); end "Rem";
function "Rem" (i1: multi_int; i2: basic_int) return basic_int is
q: multi_int(i1.last_used + 1);
r: basic_int;
begin
Div_Rem(i1,i2, q,r);
return r;
end "Rem";
function "Mod" (i1,i2: multi_int) return multi_int is
q: multi_int(Max(0,i1.last_used - i2.last_used + 1));
r: multi_int(Max(i1.last_used,i2.last_used) + 2);
begin
-- Ada RM, 4.5.5 Multiplying Operators
-- (8)
-- The signed integer modulus operator is defined such that
-- the result of A mod B has the sign of B and an absolute value
-- less than the absolute value of B; in addition, for some signed
-- integer value N, this result satisfies the relation:
-- (9) A = B*N + (A mod B)
Div_Rem(i1,i2, q,r);
if r.zero or else i2.neg = r.neg then -- (A rem B) est nul ou
return r; -- a le meme signe que B, donc (A mod B) = (A rem B)
else -- signe opposes
return i2+r; -- alors (B + (A rem B)) est le bon candidat
end if;
end "Mod";
function "Mod" (i1: multi_int; i2: basic_int) return multi_int is
begin return i1 Mod Multi(i2); end "Mod";
function "Mod" (i1: multi_int; i2: basic_int) return basic_int is
r: basic_int:= i1 Rem i2;
begin
if r=0 or else (i2<0) = (r<0) then -- (A rem B) est nul ou
return r; -- a le meme signe que B, donc (A mod B) = (A rem B)
else -- signe opposes
return i2+r; -- alors (B + (A rem B)) est le bon candidat
end if;
end "Mod";
----- End of DIVISION part ------
----- Begin of POWER part -------
procedure Power (i: multi_int; n: Natural; ipn: out multi_int) is
max_ipn_last: Index_int; -- 17-Feb-2002
begin
if i.zero then
if n=0 then
raise Zero_power_zero;
else
Fill( ipn, Multi(0) ); -- the 0**n = 0 case (17-Feb-2002)
return;
end if;
end if;
max_ipn_last:= ((1+i.last_used) * Index_int(n)-1)+2;
if ipn.n < max_ipn_last then
raise Result_undersized;
end if;
case n is
when 0 => Fill( ipn, Multi(1) ); -- the i**0 = 1 case
when 1 => Fill( ipn, i); -- the i**1 = i case
when others =>
declare
nn: natural:= n-1;
i0, ii: Multi_int( max_ipn_last );
begin
Fill(i0, i);
Fill(ii, i0 );
while nn > 0 loop
if nn MOD 2 = 0 then -- x^(2 c) = (x^2) ^c
Mult(i0,i0, i0);
nn:= nn / 2;
else
Mult(i0,ii, ii);
nn:= nn - 1;
end if;
end loop;
Fill( ipn, ii);
end;
end case;
end Power;
function "**" (i: multi_int; n: Natural) return multi_int is
ipn: Multi_int( (1+i.last_used) * index_int(n)+2 );
begin
Power(i,n,ipn);
return ipn;
end "**";
----- End of POWER part ---------
----- Comparisons
function Equal (i1,i2: multi_int) return boolean is
begin
if i1.zero and then i2.zero then
return True;
end if;
if i1.zero = i2.zero and then
i1.neg = i2.neg and then
i1.last_used = i2.last_used then
Return i1.blk(0..i1.last_used) = i2.blk(0..i2.last_used);
else
Return False;
end if;
end Equal;
function Equal (i1: multi_int; i2:basic_int) return boolean is
begin
return Equal( i1, Multi(i2) );
end Equal;
function ">" (i1,i2: multi_int) return Boolean is
begin
-- (1) Cas \'evident o\`u: i1 <= i2
if (i1.zero or i1.neg) and then -- i1 <= 0 et
(i2.zero or not i2.neg) then -- i2 >= 0
return False;
end if;
-- (2.1) Cas \'evident o\`u: i1 > i2
if ((not i1.zero) and not i1.neg) and then -- i1 > 0 et
(i2.zero or i2.neg) then -- i2 <= 0
return True;
end if;
-- (2.2) Cas \'evident o\`u: i1 > i2
if (i1.zero or not i1.neg) and then -- i1 >= 0 et
((not i2.zero) and i2.neg) then -- i2 < 0
return True;
end if;
-- Cas faciles resolus:
-- i1 > i2 - 0 +
-------------------
-- - # F F
-- 0 T F F
-- + T T #
-- On a les cas avec "#", o\`u i1 et i2 ont le meme signe
if i1.neg then
Return NOT (Compare_absolute (i1,i2) = greater);
else
Return (Compare_absolute (i1,i2) = greater);
end if;
end ">";
function ">" (i1: multi_int; i2:basic_int) return Boolean is
begin
return i1 > Multi(i2);
end ">";
function "<" (i1,i2: multi_int) return Boolean is
begin return i2>i1; end;
function "<" (i1: multi_int; i2:basic_int) return Boolean is
begin
return i1 < Multi(i2);
end "<";
function ">=" (i1,i2: multi_int) return Boolean is
begin return not (i2>i1); end;
function ">=" (i1: multi_int; i2:basic_int) return Boolean is
begin
return i1 >= Multi(i2);
end ">=";
function "<=" (i1,i2: multi_int) return Boolean is
begin return not (i1>i2); end;
function "<=" (i1: multi_int; i2:basic_int) return Boolean is
begin
return i1 <= Multi(i2);
end "<=";
begin
if 2*bitsblock >= long_basic_int'size then
raise constraint_error; -- long_basic_int type is too small !
end if;
if bitsblock >= basic_int'size then
raise constraint_error; -- basic_int type is too small !
end if;
end Multi_precision_integers;
------------------------------------------------------------------------------
-- File: mupreint.ads
-- Description: Multiple precision integers package
--
-- Date/version: 17-Feb-2002 / 19-Feb-2001 / 7.XII.1999
--
-- Revised 14.XI.1999 with :
-- a) procedures (no stack, nor copy !)
-- b) new data structure
--
-- First (operators only) XII.1996 - V.1997
--
-- Author: G. de Montmollin
-- Gautier.deMontmollin@Winterthur.ch
--
-- Thanks to: Duncan Sands
--
-- Division algorithm adaptated from BigInt 1.0 library,
-- by Stephen Adams, that refers to
-- D. E. Knuth, the Art of computer programming
-- volume 2, "Seminumerical Algorithms"
-- section 4.3.1, "Multiple-Precision Arithmetic"
--
------------------------------------------------------------------------------
package Multi_precision_integers is
-- Integers for values --
subtype Basic_int is Integer;
subtype Long_basic_int is Long_Integer; -- works even if long is not long
bitsblock: constant:= Long_basic_int'Size / 2 - 2;
-- -1 to avoid sign, -1 to allow carry for add/sub
cardblock: constant:= 2 ** ( bitsblock ); -- # possible values
-- With cardblock as power of 2, the MOD are optimized to AND
-- and *, / are optimized to shifts.
maxblock: constant:= cardblock -1;
subtype Block is Basic_int range 0 .. maxblock;
-- Integers for indices --
type Index_int is new integer;
type Block_array is array( index_int range <> ) of Basic_int;
type Multi_int(n: Index_int) is record
blk: Block_array( 0..n ); -- the n blocks with ABSOLUTE value
neg: Boolean; -- negative flag
zero: Boolean:=True; -- zero flag (supercedes the other fields)
last_used: Index_int; -- the others blocks are supposed 0
end record;
-- NB the `zero' field supercedes EVERY other information (last_used, neg)
----------------------------------------------------------------------------
-- Format of type multi_int.blk: ( i_0, i_1, ..., i_k, *, ..., * ) --
-- i_0..i_k are >=0 ; others (*) are treated as 0 --
----------------------------------------------------------------------------
----- Informations, conversions, filling
-- Convert basic_int to multi_int
function Multi(small: Basic_int) return Multi_int;
-- Convert multi_int to basic_int (when possible, else: Cannot_fit raised)
function Basic(large: Multi_int) return Basic_int;
-- Fill an multi_int of greater array dimension with a smaller one
procedure Fill(what:out Multi_int; with_smaller: Multi_int);
-- Test procedure, to check a number's integrity
procedure Test( m: Multi_int; test_last: Boolean:= true );
---------------------------------------------------------------------------
-------- Arithmetic operators. ----------
-------- For speed, the "procedure" variants should be preffered ----------
---------------------------------------------------------------------------
---------------------------
----- Unary operators -----
---------------------------
procedure Opp(i: in out multi_int);
function "+" (i: multi_int) return multi_int;
function "-" (i: multi_int) return multi_int;
procedure Abso(i: in out multi_int);
function "ABS" (i: multi_int) return multi_int;
function Sign(i: multi_int) return basic_int;
function Even(i: multi_int) return boolean;
function Odd (i: multi_int) return boolean;
----------------------------
----- Binary operators -----
----------------------------
procedure Add(i1,i2: in multi_int; i3: in out multi_int);
function "+" (i1,i2: multi_int) return multi_int;
function "+" (i1: multi_int; i2: basic_int) return multi_int;
function "+" (i1: basic_int; i2: multi_int) return multi_int;
procedure Sub (i1,i2: in multi_int; i3: in out multi_int);
procedure Subtract(i1,i2: in multi_int; i3: in out multi_int)
renames Sub;
function "-" (i1,i2: multi_int) return multi_int;
function "-" (i1: multi_int; i2: basic_int) return multi_int;
function "-" (i1: basic_int; i2: multi_int) return multi_int;
procedure Multiply(i1,i2: in multi_int; i3: in out multi_int);
procedure Mult (i1,i2: in multi_int; i3: in out multi_int)
renames Multiply;
function "*" (i1,i2: multi_int) return multi_int;
function "*" (i1: multi_int; i2: basic_int) return multi_int;
function "*" (i1: basic_int; i2: multi_int) return multi_int;
procedure Div_Rem (i1: in multi_int; i2: in basic_int;
q : in out multi_int; r: in out basic_int);
procedure Div_Rem (i1,i2: in multi_int; q,r: in out multi_int);
function "/" (i1,i2: multi_int) return multi_int;
function "/" (i1: multi_int; i2: basic_int) return multi_int;
function "Rem" (i1,i2: multi_int) return multi_int;
function "Rem" (i1: multi_int; i2: basic_int) return multi_int;
function "Rem" (i1: multi_int; i2: basic_int) return basic_int;
function "Mod" (i1,i2: multi_int) return multi_int;
function "Mod" (i1: multi_int; i2: basic_int) return multi_int;
function "Mod" (i1: multi_int; i2: basic_int) return basic_int;
procedure Power (i: multi_int; n: Natural; ipn: out multi_int);
function "**" (i: multi_int; n: Natural) return multi_int;
function Equal (i1,i2: multi_int) return boolean;
function Equal (i1: multi_int; i2:basic_int) return boolean;
function ">" (i1,i2: multi_int) return Boolean;
function ">" (i1: multi_int; i2:basic_int) return Boolean;
function "<" (i1,i2: multi_int) return Boolean;
function "<" (i1: multi_int; i2:basic_int) return Boolean;
function ">=" (i1,i2: multi_int) return Boolean;
function ">=" (i1: multi_int; i2:basic_int) return Boolean;
function "<=" (i1,i2: multi_int) return Boolean;
function "<=" (i1: multi_int; i2:basic_int) return Boolean;
Cannot_fit, Empty_multi_int : exception;
Array_too_small : exception;
Result_undersized: exception;
Division_by_zero: exception;
Zero_power_zero: exception;
end Multi_precision_integers;
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
@ 2003-05-12 23:46 Dara Hazeghi
0 siblings, 0 replies; 5+ messages in thread
From: Dara Hazeghi @ 2003-05-12 23:46 UTC (permalink / raw)
To: nobody; +Cc: gcc-prs
The following reply was made to PR ada/7984; it has been noted by GNATS.
From: Dara Hazeghi <dhazeghi@yahoo.com>
To: duncan.sands@wanadoo.fr, gcc-gnats@gcc.gnu.org
Cc:
Subject: Re: ada/7984: Internal compiler error in loc_descriptor_from_tree
Date: Mon, 12 May 2003 16:39:41 -0700
http://gcc.gnu.org/cgi-bin/gnatsweb.pl?cmd=view%20audit-
trail&database=gcc&pr=7984
Hello,
this is not a proper bug report. As the bug box says, you need to
include the files which are crashing the compiler. If this problem is
still occurring for you please send a concatentation of the files which
are crashing it. If not, tell us, and we will close this bug report.
Thanks you,
Dara
^ permalink raw reply [flat|nested] 5+ messages in thread
* ada/7984: Internal compiler error in loc_descriptor_from_tree
@ 2002-09-20 2:36 duncan.sands
0 siblings, 0 replies; 5+ messages in thread
From: duncan.sands @ 2002-09-20 2:36 UTC (permalink / raw)
To: gcc-gnats
>Number: 7984
>Category: ada
>Synopsis: Internal compiler error in loc_descriptor_from_tree
>Confidential: no
>Severity: serious
>Priority: medium
>Responsible: unassigned
>State: open
>Class: sw-bug
>Submitter-Id: net
>Arrival-Date: Fri Sep 20 02:36:00 PDT 2002
>Closed-Date:
>Last-Modified:
>Originator: Duncan Sands
>Release: 3.2.1 20020830 (Debian prerelease)
>Organization:
>Environment:
i386-pc-linux-gnu
>Description:
gcc-3.2 -c -gnata -g -gnatwa -gnato -fstack-check -funwind-tables multi_precision_integers.adb
+===========================GNAT BUG DETECTED==============================+
| 3.2.1 20020830 (prerelease) (i386-pc-linux-gnu) GCC error: |
| Internal compiler error in loc_descriptor_from_tree, at |
| dwarf2out.c:8291 |
| Error detected at /usr/lib/gcc-lib/i386-linux/3.2.1/adainclude/s-secsta.ads:66:14|
| Please submit a bug report, see http://gcc.gnu.org/bugs.html. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc-3.2 or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
+==========================================================================+
Please include these source files with error report
multi_precision_integers.adb
multi_precision_integers.ads
>How-To-Repeat:
>Fix:
>Release-Note:
>Audit-Trail:
>Unformatted:
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2003-05-13 17:46 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2003-05-13 6:35 ada/7984: Internal compiler error in loc_descriptor_from_tree steven
-- strict thread matches above, loose matches on Subject: below --
2003-05-13 17:46 Dara Hazeghi
2003-05-13 9:36 Duncan Sands
2003-05-12 23:46 Dara Hazeghi
2002-09-20 2:36 duncan.sands
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).