hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed an overflow check bug

Browse Source
This commit is contained in:
hyung-hwan 2014-03-26 07:43:34 +00:00
parent 112f136318
commit ed0835caae
2 changed files with 23 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
lib/h2-scheme-bigint.adb
View File

@ -1078,10 +1078,6 @@ package body Bigint is
R := Make_Bigint(Interp, Size => A.Size); R := Make_Bigint(Interp, Size => A.Size);
loop loop
ada.text_io.put ("A => ");
print (interp.all, A);
ada.text_io.put ("B => ");
print (interp.all, B'Unchecked_Access);
-- Get a word block to convert -- Get a word block to convert
if Is_Less_Unsigned_Array (B.Half_Word_Slot, B.Size, A.Half_Word_Slot, AS) then if Is_Less_Unsigned_Array (B.Half_Word_Slot, B.Size, A.Half_Word_Slot, AS) then
Divide_Unsigned_Array (A.Half_Word_Slot, AS, B.Half_Word_Slot, B.Size, Q.Half_Word_Slot, R.Half_Word_Slot); Divide_Unsigned_Array (A.Half_Word_Slot, AS, B.Half_Word_Slot, B.Size, Q.Half_Word_Slot, R.Half_Word_Slot);
@ -1090,8 +1086,6 @@ print (interp.all, B'Unchecked_Access);
else else
R := A; -- The last block R := A; -- The last block
end if; end if;
ada.text_io.put ("R => ");
print (interp.all, R);
-- Translate up to 2 half-words to a full word. -- Translate up to 2 half-words to a full word.
if R.Size = 1 then if R.Size = 1 then
@ -1099,7 +1093,6 @@ print (interp.all, R);
else else
W := Make_Word(R.Half_Word_Slot(1), R.Half_Word_Slot(2)); W := Make_Word(R.Half_Word_Slot(1), R.Half_Word_Slot(2));
end if; end if;
ada.text_io.put_line ("WORD => " & w'img);
Convert_Word_To_Text (W, Radix, Buf(Totlen + 1 .. Buf'Last), Seglen); Convert_Word_To_Text (W, Radix, Buf(Totlen + 1 .. Buf'Last), Seglen);
Totlen := Totlen + Seglen; Totlen := Totlen + Seglen;
@ -1207,23 +1200,29 @@ ada.text_io.put_line ("WORD => " & w'img);
NDigits := X'Last - Idx + 1; -- number of effective digits NDigits := X'Last - Idx + 1; -- number of effective digits
-- Attemp to perform conversion within the range of Object_Integer. -- Attempt to perform conversion within the range of Object_Integer.
declare declare
OW: Object_Word; --pragma Unsuppress (Range_Check);
--pragma Unsuppress (Overflow_Check);
V1, V2: Object_Word;
I: Object_Integer; I: Object_Integer;
begin begin
W := 0; W := 0;
while Idx <= X'Last loop while Idx <= X'Last loop
OW := W; V1 := W * Radix;
W := W * Radix + Object_Word(Get_Digit_Value(X(Idx))); if V1 / Radix /= W then
-- Overflow
-- Exit if the accumulated value can't be represented
-- in an Object_Integer.
if W > Object_Word(Object_Integer'Last) or else W <= OW then
W := OW;
goto Huge; goto Huge;
end if; end if;
V2 := V1 + Object_Word(Get_Digit_Value(X(Idx)));
if V2 > Object_Word(Object_Integer'Last) or else V2 < V1 then
-- Overflow
goto Huge;
end if;
W := V2;
Idx := Idx + 1; Idx := Idx + 1;
end loop; end loop;
-- Processed all digits. The value can fit -- Processed all digits. The value can fit
@ -1273,16 +1272,12 @@ ada.text_io.put_line ("WORD => " & w'img);
DVB.Tag := Bigint_Object; DVB.Tag := Bigint_Object;
DVB.Half_Word_Slot(1) := Object_Half_Word(Get_Digit_Value(X(Idx))); DVB.Half_Word_Slot(1) := Object_Half_Word(Get_Digit_Value(X(Idx)));
ada.text_io.put ("B =>");
print (interp.all, B);
ada.text_io.put ("RB =>");
print (interp.all, RB'Unchecked_Access);
Multiply_Unsigned_Array (B.Half_Word_Slot, Count_Effective_Array_Slots(B.Half_Word_Slot, B.Size), RB.Half_Word_Slot, RB.Size, C.Half_Word_Slot); Multiply_Unsigned_Array (B.Half_Word_Slot, Count_Effective_Array_Slots(B.Half_Word_Slot, B.Size), RB.Half_Word_Slot, RB.Size, C.Half_Word_Slot);
B.Half_Word_Slot := (others => 0); B.Half_Word_Slot := (others => 0);
Add_Unsigned_Array (C.Half_Word_Slot, Count_Effective_Array_Slots(C.Half_Word_Slot, B.Size), DVB.Half_Word_Slot, DVB.Size, B.Half_Word_Slot); Add_Unsigned_Array (C.Half_Word_Slot, Count_Effective_Array_Slots(C.Half_Word_Slot, B.Size), DVB.Half_Word_Slot, DVB.Size, B.Half_Word_Slot);
C.Half_Word_Slot := (others => 0); C.Half_Word_Slot := (others => 0);
end; end;
print (interp.all, B);
Idx := Idx + 1; Idx := Idx + 1;
end loop; end loop;
end; end;
@ -1297,32 +1292,19 @@ print (interp.all, B);
V, W: Object_Word; V, W: Object_Word;
Len: Object_Size; Len: Object_Size;
begin begin
-- Get the largest multiples of Radix that can be represented
-- in a single Object_Word.
Len := 1; Len := 1;
W := Object_Word(Radix); W := Object_Word(Radix);
loop loop
V := W * Object_Word(Radix); V := W * Object_Word(Radix);
--if V = W then exit when V / Object_Word(Radix) /= W; -- Overflow
-- Len := Len + 1;
-- W := V;
-- exit;
--elsif V < W then
-- -- Overflow
-- exit;
--end if;
exit when V <= W;
Len := Len + 1; Len := Len + 1;
W := V; W := V;
if Radix = 10 then
ada.text_io.put_line ("BLOCK_DIVISOR XX=> " & w'img);
end if;
end loop; end loop;
if Radix = 10 then
ada.text_io.put_line ("BLOCK_DIVISOR => " & w'img);
end if;
return (Low => Get_Low(W), High => Get_High(W), Length => Len); return (Low => Get_Low(W), High => Get_High(W), Length => Len);
end Get_Block_Divisor; end Get_Block_Divisor;

4
lib/h2-scheme.adb
View File

@ -2683,8 +2683,8 @@ Ada.Text_IO.Put_Line (">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP ITERATION XXXXXX C
declare declare
q: object_Pointer; q: object_Pointer;
begin begin
--q := bigint.from_string (interp.self, String_To_Object_Character_Array("20000000000000000000000000000000000000000"), 10); q := bigint.from_string (interp.self, String_To_Object_Character_Array("20000000000000000000000000000000000000000"), 10);
q := bigint.from_string (interp.self, String_To_Object_Character_Array("20000000000"), 10); --q := bigint.from_string (interp.self, String_To_Object_Character_Array("20000000000"), 10);
q := bigint.to_string (interp.self, q, 10); q := bigint.to_string (interp.self, q, 10);
print (interp, q); print (interp, q);
end; end;