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

added bigint multiplication

Browse Source
This commit is contained in:
hyung-hwan 2014-02-24 15:17:57 +00:00
parent bee0815c1e
commit 998f5a2e55
3 changed files with 260 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,7 +13,8 @@ package body Bigint is
System.Default_Bit_Order = System.Low_Order_First System.Default_Bit_Order = System.Low_Order_First
); );
Half_Word_Bits: constant := Object_Pointer_Bits / 2; --Half_Word_Bits: constant := Object_Pointer_Bits / 2;
Half_Word_Bits: constant := Object_Half_Word'Size;
Half_Word_Bytes: constant := Half_Word_Bits / System.Storage_Unit; Half_Word_Bytes: constant := Half_Word_Bits / System.Storage_Unit;
type Word_Record is record type Word_Record is record
@ -35,6 +36,8 @@ package body Bigint is
--for Word_Record'Bit_Order use System.High_Order_First; --for Word_Record'Bit_Order use System.High_Order_First;
--for Word_Record'Bit_Order use System.Low_Order_First; --for Word_Record'Bit_Order use System.Low_Order_First;
-----------------------------------------------------------------------------
function Get_Low (W: in Object_Word) return Object_Half_Word is function Get_Low (W: in Object_Word) return Object_Half_Word is
R: Word_Record; R: Word_Record;
for R'Address use W'Address; for R'Address use W'Address;
@ -60,6 +63,8 @@ package body Bigint is
return W; return W;
end Make_Word; end Make_Word;
-----------------------------------------------------------------------------
function Is_Less_Unsigned (X: in Object_Pointer; function Is_Less_Unsigned (X: in Object_Pointer;
Y: in Object_Pointer) return Standard.Boolean is Y: in Object_Pointer) return Standard.Boolean is
pragma Inline (Is_Less_Unsigned); pragma Inline (Is_Less_Unsigned);
@ -99,9 +104,20 @@ package body Bigint is
return X.Size = 1 and then X.Half_Word_Slot(1) = 0; return X.Size = 1 and then X.Half_Word_Slot(1) = 0;
end Is_Zero; end Is_Zero;
function Normalize (X: in Object_Pointer) return Object_Pointer is -----------------------------------------------------------------------------
function Normalize (Interp: access Interpreter_Record;
X: in Object_Pointer) return Object_Pointer is
Last: Half_Word_Object_Size := 1;
begin begin
case X.Size is for I in reverse 1 .. X.Size loop
if X.Half_Word_Slot(I) /= 0 then
Last := I;
exit;
end if;
end loop;
case Last is
when 1 => when 1 =>
if X.Sign = Negative_Sign then if X.Sign = Negative_Sign then
return Integer_To_Pointer(-Object_Integer(X.Half_Word_Slot(1))); return Integer_To_Pointer(-Object_Integer(X.Half_Word_Slot(1)));
@ -115,29 +131,90 @@ package body Bigint is
if X.Sign = Negative_Sign then if X.Sign = Negative_Sign then
if W in 0 .. Object_Word(-Object_Signed_Word(Object_Integer'First)) then if W in 0 .. Object_Word(-Object_Signed_Word(Object_Integer'First)) then
return Integer_To_Pointer(-Object_Integer(W)); return Integer_To_Pointer(-Object_Integer(W));
else
return X;
end if; end if;
else else
if W in 0 .. Object_Word(Object_Integer'Last) then if W in 0 .. Object_Word(Object_Integer'Last) then
return Integer_To_Pointer(Object_Integer(W)); return Integer_To_Pointer(Object_Integer(W));
else
return X;
end if; end if;
end if; end if;
end; end;
when others => when others =>
return X; null;
end case; end case;
if X.Size = Last then
return X;
else
return Make_Bigint(Interp, X, Last);
end if;
end Normalize; end Normalize;
-----------------------------------------------------------------------------
generic
with function Operator (X: in Object_Integer;
Y: in Object_Integer) return Object_Integer;
procedure Plain_Integer_Op (Interp: access Interpreter_Record;
X: in out Object_Pointer;
Y: in out Object_Pointer;
Z: out Object_Pointer);
procedure Plain_Integer_Op (Interp: access Interpreter_Record;
X: in out Object_Pointer;
Y: in out Object_Pointer;
Z: out Object_Pointer) is
A: aliased Object_Pointer := X;
B: aliased Object_Pointer := Y;
begin
if Is_Integer(A) and then Is_Integer(B) then
declare
G: Object_Integer := Pointer_To_Integer(A);
H: Object_Integer := Pointer_To_Integer(B);
begin
X := A;
Y := B;
Z := Integer_To_Pointer(Operator(G, H));
return;
exception
when Constraint_Error =>
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
-- TODO: allocate A and B from a non-GC heap.
-- I know that pointers returned by Make_Bigint here are short-lived
-- and not needed after actual operation. non-GC heap is a better choice.
A := Make_Bigint(Interp, Value => G);
B := Make_Bigint(Interp, Value => H);
Pop_Tops (Interp.all, 2);
end;
else
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
if Is_Integer(A) then
A := Make_Bigint(Interp, Value => Pointer_To_Integer(A));
end if;
if Is_Integer(B) then
B := Make_Bigint(Interp, Value => Pointer_To_Integer(B));
end if;
Pop_Tops (Interp.all, 2);
end if;
X := A;
Y := B;
Z := null;
end Plain_Integer_Op;
procedure Add_Integers is new Plain_Integer_Op (Operator => "+");
procedure Subtract_Integers is new Plain_Integer_Op (Operator => "-");
procedure Multiply_Integers is new Plain_Integer_Op (Operator => "*");
procedure Divide_Integers is new Plain_Integer_Op (Operator => "/");
-----------------------------------------------------------------------------
function Add_Unsigned (Interp: access Interpreter_Record; function Add_Unsigned (Interp: access Interpreter_Record;
X: in Object_Pointer; X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer is Y: in Object_Pointer) return Object_Pointer is
--pragma Assert (Is_Integer(X) or else Is_Bigint(X));
--pragma Assert (Is_Integer(Y) or else Is_Bigint(Y));
pragma Assert (Is_Bigint(X)); pragma Assert (Is_Bigint(X));
pragma Assert (Is_Bigint(Y)); pragma Assert (Is_Bigint(Y));
@ -187,14 +264,6 @@ package body Bigint is
end; end;
end if; end if;
declare
package Int_IO is new ada.text_io.modular_IO(object_half_word);
begin
for I in reverse Z.Half_Word_Slot'Range loop
int_io.put (Z.Half_Word_Slot(I), base=>16);
ada.text_io.new_line;
end loop;
end;
Pop_Tops (Interp.all, 3); Pop_Tops (Interp.all, 3);
return Z; return Z;
end Add_Unsigned; end Add_Unsigned;
@ -246,52 +315,75 @@ end;
end if; end if;
end loop; end loop;
ada.text_io.put_line ("------------SUBTRACT-");
declare
package Int_IO is new ada.text_io.modular_IO(object_half_word);
begin
for I in reverse Z.Half_Word_Slot'Range loop
int_io.put (Z.Half_Word_Slot(I), base=>16);
ada.text_io.new_line;
end loop;
end;
return Z; return Z;
end Subtract_Unsigned; end Subtract_Unsigned;
function Multiply_Unsigned (Interp: access Interpreter_Record;
X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer is
A, B, Z: aliased Object_Pointer;
W: Object_Word;
Low, High: Object_Half_Word;
Carry: Object_Half_Word;
Index: Half_Word_Object_Size;
begin
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
Push_Top (Interp.all, Z'Unchecked_Access);
A := X;
B := Y;
Z := Make_Bigint (Interp.Self, A.Size + B.Size);
--for I in B.Half_Word_Slot'Range loop
for I in 1 .. B.Size loop
if B.Half_Word_Slot(I) = 0 then
Z.Half_Word_Slot(A.Size + I) := 0;
else
Carry := 0;
--for J in A.Half_Word_Slot'Range loop
for J in 1 .. A.Size loop
W := Object_Word(A.Half_Word_Slot(J)) * Object_Word(B.Half_Word_Slot(I));
Low := Get_Low(W);
High := Get_High(W);
Low := Low + Carry;
if Low < Carry then
High := High + 1;
end if;
Index := J + I - 1;
Low := Low + Z.Half_Word_Slot(Index);
if Low < Z.Half_Word_SLot(Index) then
High := High + 1;
end if;
Z.Half_Word_Slot(Index) := Low;
Carry := High;
end loop;
Z.Half_Word_Slot(A.Size + I) := Carry;
end if;
end loop;
Pop_Tops (Interp.all, 3);
return Z;
end Multiply_Unsigned;
-----------------------------------------------------------------------------
function Add (Interp: access Interpreter_Record; function Add (Interp: access Interpreter_Record;
X: in Object_Pointer; X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer is Y: in Object_Pointer) return Object_Pointer is
Z: Object_Pointer; Z: Object_Pointer;
A: aliased Object_Pointer; A: Object_Pointer := X;
B: aliased Object_Pointer; B: Object_Pointer := Y;
Sign: Object_Sign;
begin begin
if Is_Integer(X) and then Is_Integer(Y) then Add_Integers (Interp, A, B, Z);
declare if Z /= null then
G: Object_Integer := Pointer_To_Integer(X); return Z;
H: Object_Integer := Pointer_To_Integer(Y);
T: Object_Integer;
begin
T := G + H;
return Integer_To_Pointer(T);
exception
when Constraint_Error =>
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
A := Make_Bigint(Interp, G);
B := Make_Bigint(Interp, H);
end;
else
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
A := X;
B := Y;
if Is_Integer(A) then
A := Make_Bigint(Interp, Pointer_To_Integer(A));
end if;
if Is_Integer(B) then
B := Make_Bigint(Interp, Pointer_To_Integer(B));
end if;
end if; end if;
if A.Sign /= B.Sign then if A.Sign /= B.Sign then
@ -301,75 +393,78 @@ end;
Z := Subtract (Interp, A, B); Z := Subtract (Interp, A, B);
end if; end if;
else else
Sign := A.Sign;
Z := Add_Unsigned (Interp, A, B); Z := Add_Unsigned (Interp, A, B);
Z.Sign := A.Sign; Z.Sign := Sign;
end if; end if;
Pop_Tops (Interp.all, 2); return Normalize(Interp, Z);
return Normalize(Z);
end Add; end Add;
function Subtract (Interp: access Interpreter_Record; function Subtract (Interp: access Interpreter_Record;
X: in Object_Pointer; X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer is Y: in Object_Pointer) return Object_Pointer is
Z: Object_Pointer; Z: Object_Pointer;
A: aliased Object_Pointer; A: Object_Pointer := X;
B: aliased Object_Pointer; B: Object_Pointer := Y;
Sign: Object_Sign;
begin begin
if Is_Integer(X) and then Is_Integer(Y) then Subtract_Integers (Interp, A, B, Z);
declare if Z /= null then
G: Object_Integer := Pointer_To_Integer(X); return Z;
H: Object_Integer := Pointer_To_Integer(Y);
T: Object_Integer;
begin
T := G + H;
return Integer_To_Pointer(T);
exception
when Constraint_Error =>
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
A := Make_Bigint(Interp, G);
B := Make_Bigint(Interp, H);
end;
else
Push_Top (Interp.all, A'Unchecked_Access);
Push_Top (Interp.all, B'Unchecked_Access);
A := X;
B := Y;
if Is_Integer(A) then
A := Make_Bigint(Interp, Pointer_To_Integer(A));
end if;
if Is_Integer(B) then
B := Make_Bigint(Interp, Pointer_To_Integer(B));
end if;
end if; end if;
if A.Sign /= B.Sign then if A.Sign /= B.Sign then
Sign := A.Sign;
Z := Add_Unsigned (Interp, A, B); Z := Add_Unsigned (Interp, A, B);
Z.Sign := A.Sign; Z.Sign := Sign;
--if A.Sign = Negative_Sign then
-- Z.Sign := Negative_Sign;
-- Z.Sign := Negative_Sign;
--else
-- Z := Add_Unsigned (Interp, A, B);
--end if;
else else
if Is_Less_Unsigned(A, B) then if Is_Less_Unsigned(A, B) then
Z := Subtract_Unsigned (Interp, B, A); --Sign := Object_Sign'Val(not Object_Sign'Pos(A.Sign)); -- opposite A.Sign
--Z.Sign := Object_Sign'Val(not Object_Sign'Pos(A.Sign)); -- opposite A.Sign
if A.Sign = Negative_Sign then if A.Sign = Negative_Sign then
Z.Sign := Positive_Sign; Sign := Positive_Sign;
else else
Z.Sign := Negative_Sign; Sign := Negative_Sign;
end if; end if;
Z := Subtract_Unsigned (Interp, B, A);
Z.Sign := Sign;
else else
Sign := A.Sign;
Z := Subtract_Unsigned (Interp, A, B); Z := Subtract_Unsigned (Interp, A, B);
Z.Sign := A.Sign; Z.Sign := Sign;
end if; end if;
end if; end if;
Pop_Tops (Interp.all, 2); return Normalize(Interp, Z);
return Normalize(Z);
end Subtract; end Subtract;
function Multiply (Interp: access Interpreter_Record;
X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer is
Z: Object_Pointer;
A: Object_Pointer := X;
B: Object_Pointer := Y;
Sign: Object_Sign;
begin
Multiply_Integers (Interp, A, B, Z);
if Z /= null then
return Z;
end if;
-- Determine the sign earlier than any object allocation
-- to avoid GC side-effects because A and B are not pushed
-- as temporarry object pointers.
if A.Sign = B.Sign then
Sign := Positive_Sign;
else
Sign := Negative_Sign;
end if;
Z := Multiply_Unsigned (Interp, A, B);
Z.Sign := Sign;
return Normalize(Interp, Z);
end Multiply;
end Bigint; end Bigint;

66
lib/h2-scheme.adb
View File

@ -273,12 +273,12 @@ package body H2.Scheme is
return Get_Pointer_Type(Pointer) = Object_Pointer_Type_Byte; return Get_Pointer_Type(Pointer) = Object_Pointer_Type_Byte;
end Is_Byte; end Is_Byte;
function Integer_To_Pointer (Int: in Object_Integer) return Object_Pointer is function Integer_To_Pointer (Value: in Object_Integer) return Object_Pointer is
Pointer: Object_Pointer; Pointer: Object_Pointer;
Word: Object_Word; Word: Object_Word;
for Word'Address use Pointer'Address; for Word'Address use Pointer'Address;
begin begin
if Int < 0 then if Value < 0 then
-- change the sign of a negative number. -- change the sign of a negative number.
-- '-Int' may violate the range of Object_Integer -- '-Int' may violate the range of Object_Integer
-- if it is Object_Integer'First. So I add 1 to 'Int' -- if it is Object_Integer'First. So I add 1 to 'Int'
@ -287,22 +287,21 @@ package body H2.Scheme is
--Word := Object_Word (-(Int + 1)) + 1; --Word := Object_Word (-(Int + 1)) + 1;
-- Let me use Object_Signed_Word instead of the trick shown above -- Let me use Object_Signed_Word instead of the trick shown above
Word := Object_Word(-Object_Signed_Word(Int)); Word := Object_Word(-Object_Signed_Word(Value));
-- shift the number to the left by 2 and -- shift the number to the left by 2 and
-- set the highest bit on by force. -- set the highest bit on by force.
Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Integer) or (2 ** (Word'Size - 1)); Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Integer) or (2 ** (Word'Size - 1));
else else
Word := Object_Word(Int); Word := Object_Word(Value);
-- Shift 'Word' to the left by 2 and set the integer mark. -- Shift 'Word' to the left by 2 and set the integer mark.
Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Integer); Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Integer);
end if; end if;
--return Object_Label_To_Object_Pointer (Word);
return Pointer; return Pointer;
end Integer_To_Pointer; end Integer_To_Pointer;
function Character_To_Pointer (Char: in Object_Character) return Object_Pointer is function Character_To_Pointer (Value: in Object_Character) return Object_Pointer is
Pointer: Object_Pointer; Pointer: Object_Pointer;
Word: Object_Word; Word: Object_Word;
for Word'Address use Pointer'Address; for Word'Address use Pointer'Address;
@ -313,18 +312,17 @@ package body H2.Scheme is
-- or short. In reality, the last Unicode code point assigned is far -- or short. In reality, the last Unicode code point assigned is far
-- less than #16#7FFFFFFF# as of this writing. So I should not be -- less than #16#7FFFFFFF# as of this writing. So I should not be
-- worried about it for the time being. -- worried about it for the time being.
Word := Object_Character'Pos(Char); Word := Object_Character'Pos(Value);
Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Character); Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Character);
--return Object_Label_To_Object_Pointer (Word);
return Pointer; return Pointer;
end Character_To_Pointer; end Character_To_Pointer;
function Byte_To_Pointer (Byte: in Object_Byte) return Object_Pointer is function Byte_To_Pointer (Value: in Object_Byte) return Object_Pointer is
Pointer: Object_Pointer; Pointer: Object_Pointer;
Word: Object_Word; Word: Object_Word;
for Word'Address use Pointer'Address; for Word'Address use Pointer'Address;
begin begin
Word := Object_Word(Byte); Word := Object_Word(Value);
Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Byte); Word := (Word * (2 ** Object_Pointer_Type_Bits)) or Object_Word(Object_Pointer_Type_Byte);
return Pointer; return Pointer;
end Byte_To_Pointer; end Byte_To_Pointer;
@ -339,7 +337,7 @@ package body H2.Scheme is
--end Pointer_To_Word; --end Pointer_To_Word;
function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer is function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer is
Word: Object_Word := Pointer_To_Word (Pointer); Word: Object_Word := Pointer_To_Word(Pointer);
begin begin
if (Word and (2 ** (Word'Size - 1))) /= 0 then if (Word and (2 ** (Word'Size - 1))) /= 0 then
-- if the highest bit is set, it's a negative number -- if the highest bit is set, it's a negative number
@ -1423,8 +1421,24 @@ end if;
Ptr.Sign := Negative_Sign; Ptr.Sign := Negative_Sign;
end if; end if;
ada.text_io.put_line (Object_Half_Word'image(bigint.get_high(w))); return Ptr;
ada.text_io.put_line (Object_Half_Word'image(bigint.get_low(w))); end Make_Bigint;
function Make_Bigint (Interp: access Interpreter_Record;
Source: in Object_Pointer;
Last: in Half_Word_Object_Size) return Object_Pointer is
pragma Assert (Is_Bigint(Source));
pragma Assert (Last <= Source.Size);
X: aliased Object_Pointer := Source;
Ptr: Object_Pointer;
begin
Push_Top (Interp.all, X'Unchecked_Access);
Ptr := Allocate_Half_Word_Object(Interp, Last);
Ptr.Tag := Bigint_Object;
Ptr.Sign := Source.Sign;
Ptr.Half_Word_Slot := X.Half_Word_Slot(1 .. Last);
Pop_Tops (Interp.all, 1);
return Ptr; return Ptr;
end Make_Bigint; end Make_Bigint;
@ -2260,6 +2274,25 @@ ada.text_io.put_line (Object_Half_Word'image(bigint.get_low(w)));
Ada.Text_IO.Put ("#Array"); Ada.Text_IO.Put ("#Array");
when Bigint_Object =>
Ada.Text_IO.Put ("#Bigint(");
declare
package Int_IO is new ada.text_io.modular_IO(object_half_word);
begin
if Atom.Sign = Negative_Sign then
ada.text_io.put ("-");
else
ada.text_io.put ("+");
end if;
for I in reverse Atom.Half_Word_Slot'Range loop
ada.text_io.put (" ");
int_io.put (Atom.Half_Word_Slot(I), base=>16);
end loop;
end;
Ada.Text_IO.Put(")");
when Others => when Others =>
if Atom.Kind = Character_Object then if Atom.Kind = Character_Object then
Output_Character_Array (Atom.Character_Slot); Output_Character_Array (Atom.Character_Slot);
@ -2659,9 +2692,12 @@ Push_Top (Interp, B'Unchecked_Access);
--A := Bigint.Add (Interp.Self, A, B); --A := Bigint.Add (Interp.Self, A, B);
--end loop; --end loop;
A := Make_Bigint (Interp.Self, Value => 16#FFFF_00000001#); A := Make_Bigint (Interp.Self, Value => 16#FFFF_00000001#);
B := Make_Bigint (Interp.Self, Value => 16#FFFF_0000000F#); --B := Make_Bigint (Interp.Self, Value => 16#FFFF_0000000F#);
B := Make_Bigint (Interp.Self, Value => 16#FFFFFF_00000001#);
B.sign := Negative_Sign;
--A := Bigint.Subtract (Interp.Self, integer_to_pointer(16), B); --A := Bigint.Subtract (Interp.Self, integer_to_pointer(16), B);
A := Bigint.Subtract (Interp.Self, B, integer_to_pointer(16)); --A := Bigint.Multiply (Interp.Self, B, integer_to_pointer(2));
A := Bigint.Add (Interp.Self, integer_to_pointer(object_integer'first), integer_to_pointer(-1));
print (interp, A); print (interp, A);
Pop_tops (Interp, 2); Pop_tops (Interp, 2);
end; end;

17
lib/h2-scheme.ads
View File

@ -113,6 +113,7 @@ package H2.Scheme is
-- ----------------------------------------------------------------------- -- -----------------------------------------------------------------------
-- What is a better choice? TODO: decide what to use -- What is a better choice? TODO: decide what to use
-- ----------------------------------------------------------------------- -- -----------------------------------------------------------------------
-- Let Object_Integer take up as large a space as Object_Pointer -- Let Object_Integer take up as large a space as Object_Pointer
-- despite the actual range of Object_Integer. -- despite the actual range of Object_Integer.
for Object_Integer'Size use Object_Pointer_Bits; for Object_Integer'Size use Object_Pointer_Bits;
@ -289,9 +290,9 @@ package H2.Scheme is
function Is_Character (Pointer: in Object_Pointer) return Standard.Boolean; function Is_Character (Pointer: in Object_Pointer) return Standard.Boolean;
function Is_Byte (Pointer: in Object_Pointer) return Standard.Boolean; function Is_Byte (Pointer: in Object_Pointer) return Standard.Boolean;
function Integer_To_Pointer (Int: in Object_Integer) return Object_Pointer; function Integer_To_Pointer (Value: in Object_Integer) return Object_Pointer;
function Character_To_Pointer (Char: in Object_Character) return Object_Pointer; function Character_To_Pointer (Value: in Object_Character) return Object_Pointer;
function Byte_To_Pointer (Byte: in Object_Byte) return Object_Pointer; function Byte_To_Pointer (Value: in Object_Byte) return Object_Pointer;
function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer; function Pointer_To_Integer (Pointer: in Object_Pointer) return Object_Integer;
function Pointer_To_Character (Pointer: in Object_Pointer) return Object_Character; function Pointer_To_Character (Pointer: in Object_Pointer) return Object_Character;
@ -304,7 +305,7 @@ package H2.Scheme is
pragma Inline (Integer_To_Pointer); pragma Inline (Integer_To_Pointer);
pragma Inline (Character_To_Pointer); pragma Inline (Character_To_Pointer);
pragma Inline (Byte_To_Pointer); pragma Inline (Byte_To_Pointer);
pragma Inline (Pointer_To_Integer); --pragma Inline (Pointer_To_Integer);
pragma Inline (Pointer_To_Character); pragma Inline (Pointer_To_Character);
pragma Inline (Pointer_To_Byte); pragma Inline (Pointer_To_Byte);
@ -470,6 +471,10 @@ package H2.Scheme is
function Make_Bigint (Interp: access Interpreter_Record; function Make_Bigint (Interp: access Interpreter_Record;
Value: Object_Integer) return Object_Pointer; Value: Object_Integer) return Object_Pointer;
function Make_Bigint (Interp: access Interpreter_Record;
Source: in Object_Pointer;
Last: in Half_Word_Object_Size) return Object_Pointer;
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
@ -597,6 +602,10 @@ private
X: in Object_Pointer; X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer; Y: in Object_Pointer) return Object_Pointer;
function Multiply (Interp: access Interpreter_Record;
X: in Object_Pointer;
Y: in Object_Pointer) return Object_Pointer;
end Bigint; end Bigint;
end H2.Scheme; end H2.Scheme;