added partial bigint divide

lib/h2-scheme-bigint.adb

@@ -65,21 +65,30 @@ package body Bigint is
 
 	-----------------------------------------------------------------------------
 
-	function Is_Less_Unsigned (X: in Object_Pointer;
+	function Is_Less_Unsigned_Array (X:  in Object_Half_Word_Array;
-	                           Y: in Object_Pointer) return Standard.Boolean is
+	                                 XS: in Half_Word_Object_Size;
-		pragma Inline (Is_Less_Unsigned);
+	                                 Y:  in Object_Half_Word_Array;
+	                                 YS: in Half_Word_Object_Size) return Standard.Boolean is
+		pragma Inline (Is_Less_Unsigned_Array);
 	begin
-		if X.Size /= Y.Size then
+		if XS /= YS then
-			return X.Size < Y.Size;
+			return XS < YS;
 		end if;
 
-		for I in reverse X.Half_Word_Slot'Range loop
+		for I in reverse X'Range loop
-			if X.Half_Word_Slot(I) /= Y.Half_Word_Slot(I) then
+			if X(I) /= Y(I) then
-				return X.Half_Word_Slot(I) < Y.Half_Word_Slot(I);
+				return X(I) < Y(I);
 			end if;
 		end loop;
 
 		return Standard.False;
+	end Is_Less_Unsigned_Array;
+	
+	function Is_Less_Unsigned (X: in Object_Pointer;
+	                           Y: in Object_Pointer) return Standard.Boolean is
+		pragma Inline (Is_Less_Unsigned);
+	begin
+		return Is_Less_Unsigned_Array (X.Half_Word_Slot, X.Size, Y.Half_Word_Slot, Y.Size);
 	end Is_Less_Unsigned;
 
 	function Is_Less (X: in Object_Pointer;
@@ -100,14 +109,35 @@ package body Bigint is
 	end Is_Equal;
 
 	function Is_Zero (X: in Object_Pointer) return Standard.Boolean is
+		pragma Inline (Is_Zero);
 	begin
 		return X.Size = 1 and then X.Half_Word_Slot(1) = 0;
 	end Is_Zero;
 
-	-----------------------------------------------------------------------------
+	function Is_One_Unsigned (X: in Object_Pointer) return Standard.Boolean is
+		pragma Inline (Is_One_Unsigned);
+	begin
+		return X.Size = 1 and then X.Half_Word_Slot(1) = 1;
+	end Is_One_Unsigned;
 
-	function Normalize (Interp: access Interpreter_Record;
+	-----------------------------------------------------------------------------
-	                    X:      in     Object_Pointer) return Object_Pointer is
+	function Copy_Upto (Interp: access Interpreter_Record;
+	                    X:      in     Object_Pointer;
+	                    Last:   in     Half_Word_Object_Size) return Object_Pointer is
+		pragma Assert (Last < X.Size);
+		A: aliased Object_Pointer := X;
+		Z: Object_Pointer;
+	begin
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Z := Make_Bigint(Interp, Size => Last);	
+		Pop_Tops  (Interp.all, 1);
+		Z.Sign := A.Sign;
+		Z.Half_Word_Slot := A.Half_Word_Slot(1 .. Last);
+		return Z;
+	end Copy_Upto;
+
+	function Count_Effective_Slots (X: in Object_Pointer) return Half_Word_Object_Size is
+		pragma Inline (Count_Effective_Slots);
 		Last: Half_Word_Object_Size := 1;
 	begin
 		for I in reverse 1 .. X.Size loop
@@ -116,6 +146,14 @@ package body Bigint is
 				exit;
 			end if;
 		end loop;
+		return Last;
+	end Count_Effective_Slots;
+	
+	function Normalize (Interp: access Interpreter_Record;
+	                    X:      in     Object_Pointer) return Object_Pointer is
+		Last: Half_Word_Object_Size;
+	begin
+		Last := Count_Effective_Slots(X);
 
 		case Last is
 			when 1 =>
@@ -124,6 +162,7 @@ package body Bigint is
 				else
 					return Integer_To_Pointer(Object_Integer(X.Half_Word_Slot(1)));
 				end if;
+
 			when 2 =>
 				declare
 					W: Object_Word := Make_Word (X.Half_Word_Slot(1), X.Half_Word_Slot(2));
@@ -144,11 +183,12 @@ package body Bigint is
 		end case;
 
 		if X.Size = Last then
+			-- No compaction is needed. return it as it is
 			return X;
-		else
-			return Make_Bigint(Interp, X, Last);
 		end if;
 
+		-- Remove unneeded slots and clone meaningful contents only.
+		return Copy_Upto(Interp, X, Last);
 	end Normalize;
 
 	-----------------------------------------------------------------------------
@@ -215,18 +255,12 @@ package body Bigint is
 	function Add_Unsigned (Interp: access Interpreter_Record;
 	                       X:      in     Object_Pointer;
 	                       Y:      in     Object_Pointer) return Object_Pointer is
-		pragma Assert (Is_Bigint(X));
+		A, B: aliased Object_Pointer;
-		pragma Assert (Is_Bigint(Y));
+		Z: Object_Pointer;
-
-		A, B, Z: aliased Object_Pointer;
 		W: Object_Word;
-		Carry: Object_Half_Word; 
+		Carry: Object_Half_Word := 0;
 		Last: 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);
-
 		if X.Size >= Y.Size then
 			A := X;
 			B := Y;
@@ -237,8 +271,10 @@ package body Bigint is
 			Last := Y.Size + 1;
 		end if;
 			
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Push_Top (Interp.all, B'Unchecked_Access);
 		Z := Make_Bigint (Interp.Self, Last);
-		Carry := 0;
+		Pop_Tops (Interp.all, 2);
 
 		for I in 1 .. B.Size loop
 			W := Object_Word(A.Half_Word_Slot(I)) + Object_Word(B.Half_Word_Slot(I)) + Object_Word(Carry);
@@ -253,81 +289,84 @@ package body Bigint is
 		end loop;
 
 		Z.Half_Word_Slot(Last) := Carry;
-
-		Pop_Tops (Interp.all, 3);
 		return Z;
 	end Add_Unsigned;
 	
-	function Subtract_Unsigned (Interp: access Interpreter_Record;
+	procedure Subtract_Unsigned_Array (X:      in     Object_Half_Word_Array;
-	                            X:      in     Object_Pointer;
+	                                   XS:     in     Half_Word_Object_Size;
-	                            Y:      in     Object_Pointer) return Object_Pointer is
+	                                   Y:      in     Object_Half_Word_Array;
-		A, B, Z: aliased Object_Pointer;
+	                                   YS:     in     Half_Word_Object_Size;
-		T: Object_Word;
+	                                   Z:      in out Object_Half_Word_Array) is
+		W: Object_Word;
 		Borrowed_Word: constant Object_Word := Object_Word(Object_Half_Word'Last) + 1;
 		Borrow: Object_Half_Word := 0;
 	begin
-		Push_Top (Interp.all, A'Unchecked_Access);
+		for I in 1 .. YS loop
-		Push_Top (Interp.all, B'Unchecked_Access);
+			W := Object_Word(Y(I)) + Object_Word(Borrow);
-		Push_Top (Interp.all, Z'Unchecked_Access);
+			if Object_Word(X(I)) >= W then
-
+				Z(I) := X(I) - Object_Half_Word(W);
-		A := X;
-		B := Y;
-		pragma Assert (not Is_Less_Unsigned(A, B)); -- The caller must ensure that X >= Y
-			
-		Z := Make_Bigint (Interp.Self, A.Size); -- Assume X.Size >= Y.Size.
-
-		for I in 1 .. B.Size loop
-			T := Object_Word(B.Half_Word_Slot(I)) + Object_Word(Borrow);
-			if Object_Word(A.Half_Word_Slot(I)) >= T then
-				Z.Half_Word_Slot(I) := A.Half_Word_Slot(I) - Object_Half_Word(T);
 				Borrow := 0;
 			else
-				Z.Half_Word_Slot(I) := Object_Half_Word(Borrowed_Word + Object_Word(A.Half_Word_Slot(I)) - T);
+				Z(I) := Object_Half_Word(Borrowed_Word + Object_Word(X(I)) - W);
 				Borrow := 1;
 			end if;
 		end loop;
 
-		for I in B.Size + 1 .. A.Size loop
+		for I in YS + 1 .. XS loop
-			if A.Half_Word_Slot(I) >= Borrow then
+			if X(I) >= Borrow then
-				Z.Half_Word_Slot(I) := A.Half_Word_Slot(I) - Object_Half_Word(Borrow);
+				Z(I) := X(I) - Object_Half_Word(Borrow);
 				Borrow := 0;
 			else
-				Z.Half_Word_Slot(I) := Object_Half_Word(Borrowed_Word + Object_Word(A.Half_Word_Slot(I)) - Object_Word(Borrow));
+				Z(I) := Object_Half_Word(Borrowed_Word + Object_Word(X(I)) - Object_Word(Borrow));
 				Borrow := 1;
 			end if;
 		end loop;
 
 		pragma Assert (Borrow = 0);
+	end Subtract_Unsigned_Array;
+
+
+	function Subtract_Unsigned (Interp: access Interpreter_Record;
+	                            X:      in     Object_Pointer;
+	                            Y:      in     Object_Pointer) return Object_Pointer is
+		pragma Inline (Subtract_Unsigned);
+
+		A: aliased Object_Pointer := X;
+		B: aliased Object_Pointer := Y;
+		Z: Object_Pointer;
+		W: Object_Word;
+		Borrowed_Word: constant Object_Word := Object_Word(Object_Half_Word'Last) + 1;
+		Borrow: Object_Half_Word := 0; 
+	begin
+		pragma Assert (not Is_Less_Unsigned(A, B)); -- The caller must ensure that X >= Y
+
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Push_Top (Interp.all, B'Unchecked_Access);
+		Z := Make_Bigint (Interp.Self, A.Size); -- Assume X.Size >= Y.Size.
+		Pop_Tops (Interp.all, 2);
+		
+		Subtract_Unsigned_Array (A.Half_Word_Slot, A.Size, B.Half_Word_SLot, B.Size, Z.Half_Word_Slot);
 		return Z;
 	end Subtract_Unsigned;
 
-	function Multiply_Unsigned (Interp: access Interpreter_Record;
+	procedure Multiply_Unsigned_Array (X:      in     Object_Half_Word_Array;
-	                            X:      in     Object_Pointer;
+	                                   XS:     in     Half_Word_Object_Size;
-	                            Y:      in     Object_Pointer) return Object_Pointer is
+	                                   Y:      in     Object_Half_Word_Array;
-		A, B, Z: aliased Object_Pointer;
+	                                   YS:     in     Half_Word_Object_Size;
+	                                   Z:      in out Object_Half_Word_Array) is
 		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);
+		for I in 1 .. YS loop
-		Push_Top (Interp.all, B'Unchecked_Access);
+			if Y(I) = 0 then
-		Push_Top (Interp.all, Z'Unchecked_Access);
+				Z(XS + I) := 0;
-
-		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 .. XS loop
-				for J in 1 .. A.Size loop
+					W := Object_Word(X(J)) * Object_Word(Y(I));
-					W := Object_Word(A.Half_Word_Slot(J)) * Object_Word(B.Half_Word_Slot(I));
 					Low := Get_Low(W);
 					High := Get_High(W);
 
@@ -337,29 +376,138 @@ package body Bigint is
 					end if;
 
 					Index := J + I - 1;
-					Low := Low + Z.Half_Word_Slot(Index);
+					Low := Low + Z(Index);
-					if Low < Z.Half_Word_SLot(Index) then
+					if Low < Z(Index) then
 						High := High + 1;
 					end if;
-					Z.Half_Word_Slot(Index) := Low;
+					Z(Index) := Low;
 
 					Carry := High;
 				end loop;
 
-				Z.Half_Word_Slot(A.Size + I) := Carry;
+				Z(XS + I) := Carry;
 			end if;
 		end loop;
+	end Multiply_Unsigned_Array;
 	
-		Pop_Tops (Interp.all, 3);
+	function Multiply_Unsigned (Interp: access Interpreter_Record;
+	                            X:      in     Object_Pointer;
+	                            Y:      in     Object_Pointer) return Object_Pointer is
+		pragma Inline (Multiply_Unsigned);
+		
+		A: aliased Object_Pointer := X;
+		B: aliased Object_Pointer := Y;
+		Z: Object_Pointer;
+	begin
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Push_Top (Interp.all, B'Unchecked_Access);
+		Z := Make_Bigint (Interp.Self, A.Size + B.Size);
+		Pop_Tops (Interp.all, 2);
+
+		Multiply_Unsigned_Array (A.Half_Word_Slot, A.Size, B.Half_Word_Slot, B.Size, Z.Half_Word_Slot);
 		return Z;
 	end Multiply_Unsigned;
 
-	function Divide_Unsigned (Interp: access Interpreter_Record;
+	procedure Divide_Unsigned (Interp: access Interpreter_Record;
 	                           X:      in     Object_Pointer;
-	                          Y:      in     Object_Pointer) return Object_Pointer is
+	                           Y:      in     Object_Pointer;
+	                           Q:      out    Object_Pointer;
+	                           R:      out    Object_Pointer) is
+		A: aliased Object_Pointer := X;
+		B: aliased Object_Pointer := Y;
+
+		Quo: aliased Object_Pointer;
+		Remn: aliased Object_Pointer;
+		Dend: aliased Object_Pointer; -- Dividend
+		Sor: aliased Object_Pointer; -- Divisor
+		Tmp: Object_Pointer;
+
+		Diff: Half_Word_Object_Size;
+		Dend_Size: Half_Word_Object_Size;
+		Sor_Size: Half_Word_Object_Size;
+		Tmp_Size: Half_Word_Object_Size;
+		Cand_Size: Half_Word_Object_Size;
+		
+		Cand_W: Object_Word;
+		Cand: Object_Half_Word_Array (1 .. 2);
 	begin
-		return null;
+		pragma Assert (not Is_Less_Unsigned(A, B)); -- The caller must ensure that X >= Y
+
+
+		-- 823456 / 93
+
+		-- 823456  930000 : (8 / 9) => 0,
+		-- 823456   93000 : (82 / 9) => 9, 
+		--                  9 * 93000 => 837000
+	     --                  837000 > 823456
+		--                  8 * 93000 => 664000
+		--                  664000 <= 823456
+
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Push_Top (Interp.all, B'Unchecked_Access);
+		Push_Top (Interp.all, Quo'Unchecked_Access);
+		Push_Top (Interp.all, Remn'Unchecked_Access);
+		Push_Top (Interp.all, Dend'Unchecked_Access);
+		Push_Top (Interp.all, Sor'Unchecked_Access);
+		Quo := Make_Bigint (Interp.Self, A.Size);
+		Remn := Make_Bigint (Interp.Self, A.Size);
+		Dend := Make_Bigint (Interp.Self, A.Size);
+		Sor := Make_Bigint (Interp.Self, A.Size);
+		Tmp := Make_Bigint (Interp.Self, A.Size + B.Size);
+		Pop_Tops (Interp.all, 6);
+
+		Dend_Size := A.Size;
+		Sor_Size := A.Size;
+		Diff := A.Size - B.Size;
+		Dend.Half_Word_Slot := A.Half_Word_Slot;
+		Sor.Half_Word_Slot(1 + Diff .. B.Size + Diff) := B.Half_Word_Slot;
+
+		for I in reverse B.Size .. A.Size loop
+			if Is_Less_Unsigned_Array(Dend.Half_Word_Slot, Dend_Size, Sor.Half_Word_Slot, Sor_Size) then
+				Quo.Half_Word_Slot(I) := 0;
+			else
+				if Dend_Size > Sor_Size then
+					Cand_W := Make_Word(Dend.Half_Word_Slot(Dend_Size - 1), Dend.Half_Word_Slot(Dend_Size));
+					Cand_W := Cand_W / Object_Word(Sor.Half_Word_Slot(Sor_Size));
+					Cand(1) := Get_Low(Cand_W);
+					Cand(2) := Get_High(Cand_W);
+					if Cand(2) > 0 then
+						Cand_Size := 2;
+					else
+						Cand_Size := 1;
+					end if;
+				else
+					Cand(1) := Dend.Half_Word_Slot(Dend_Size) / Sor.Half_Word_Slot(Sor_Size);
+					Cand_Size := 1;
+				end if;
+
+				Tmp.Half_Word_Slot := (others => 0);
+				Multiply_Unsigned_Array (Cand, Cand_Size, Sor.Half_Word_Slot, Sor_Size, Tmp.Half_Word_Slot);
+				Tmp_Size := Count_Effective_Slots(Tmp);
+				if Is_Less_Unsigned_Array(Dend.Half_Word_Slot, Dend_Size, Tmp.Half_Word_Slot, Tmp_Size) then
+					Quo.Half_Word_Slot(I) := Cand(1) - 1;
+					Subtract_Unsigned_Array (Dend.Half_Word_Slot, Dend_Size, Tmp.Half_Word_Slot, Tmp_Size, Dend.Half_Word_Slot);
+					Dend_Size := Count_Effective_Slots(Dend);
+					Subtract_Unsigned_Array (Dend.Half_Word_Slot, Dend_Size, Sor.Half_Word_Slot, Sor_Size, Dend.Half_Word_Slot);
+					Dend_Size := Count_Effective_Slots(Dend);
+				else
+					Quo.Half_Word_Slot(I) := Cand(1);
+					Subtract_Unsigned_Array (Dend.Half_Word_Slot, Dend_Size, Tmp.Half_Word_Slot, Tmp_Size, Dend.Half_Word_Slot);
+					Dend_Size := Count_Effective_Slots(Dend);
+				end if;
+			end if;
+			
+			-- Shift the divisor right by 1 slot
+			pragma Assert (I = Sor_Size);
+			Sor_Size := Sor_Size - 1;
+			Sor.Half_Word_Slot(1 .. Sor_Size) := Sor.Half_Word_Slot(2 .. I);
+			Sor.Half_Word_Slot(I) := 0;
+		end loop;
+		
+		Q := Quo;
+		R := Remn;
 	end Divide_Unsigned;
+
 	-----------------------------------------------------------------------------
 
 	function Add (Interp: access Interpreter_Record;
@@ -394,9 +542,9 @@ package body Bigint is
 	function Subtract (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;
+		Z: Object_Pointer;
 		Sign: Object_Sign;
 	begin
 		Subtract_Integers (Interp, A, B, Z);
@@ -432,9 +580,9 @@ package body Bigint is
 	                   X:      in     Object_Pointer;
 	                   Y:      in     Object_Pointer) return Object_Pointer is
 
-		Z: Object_Pointer;
 		A: Object_Pointer := X;
 		B: Object_Pointer := Y;
+		Z: Object_Pointer;
 		Sign: Object_Sign;
 	begin
 		Multiply_Integers (Interp, A, B, Z);
@@ -456,17 +604,37 @@ package body Bigint is
 		return Normalize(Interp, Z);
 	end Multiply;
 
-	function Divide (Interp: access Interpreter_Record;
+	procedure Divide (Interp: access Interpreter_Record;
 	                  X:      in     Object_Pointer;
-	                 Y:      in     Object_Pointer) return Object_Pointer is
+	                  Y:      in     Object_Pointer;
-		Z: Object_Pointer;
+	                  Q:      out    Object_Pointer;
+	                  R:      out    Object_Pointer) is
 		A: Object_Pointer := X;
 		B: Object_Pointer := Y;
+		C: aliased Object_Pointer;
+		D: aliased Object_Pointer;
 		Sign: Object_Sign;
 	begin
-		Divide_Integers (Interp, A, B, Z);
+		if (Is_Integer(Y) and then Pointer_To_Integer(Y) = 0) or else
-		if Z /= null then
+		   (Is_Bigint(Y) and then Is_Zero(Y)) then
-			return Z;
+			raise Divide_By_Zero_Error;
+		end if;
+
+		Divide_Integers (Interp, A, B, Q);
+		if Q /= null then
+			-- remainder operation must succeed if division was ok.
+			R :=  Integer_To_Pointer(Pointer_To_Integer(A) rem Pointer_To_Integer(B));
+			return;
+		end if;
+
+		if Is_Equal(A, B) then
+			Q := Integer_To_Pointer(1);
+			R := Integer_To_Pointer(0);
+			return;
+		elsif Is_Less_Unsigned(A, B) then
+			Q := Integer_To_Pointer(0);
+			R := A;
+			return;
 		end if;
 
 		-- Determine the sign earlier than any object allocation
@@ -477,10 +645,18 @@ package body Bigint is
 		else
 			Sign := Negative_Sign;
 		end if;
-		Z := Divide_Unsigned (Interp, A, B);
+		Divide_Unsigned (Interp, A, B, C, D);
-		Z.Sign := Sign;
+		C.Sign := Sign;
+		D.Sign := Sign;
 
-		return Normalize(Interp, Z);
+		Push_Top (Interp.all, C'Unchecked_Access);
+		Push_Top (Interp.all, D'Unchecked_Access);
+		C := Normalize(Interp, C);
+		D := Normalize(Interp, D);
+		Pop_Tops (Interp.all, 2);
+
+		Q := C;
+		R := D;
 	end Divide;
 
 end Bigint;

lib/h2-scheme.adb

@@ -121,14 +121,8 @@ package body H2.Scheme is
 	Label_Else:       constant Object_Character_Array := (Ch.LC_E, Ch.LC_L, Ch.LC_S, Ch.LC_E); -- "else"
 
 	-----------------------------------------------------------------------------
-	-- EXCEPTIONS
+	-- INTERNAL EXCEPTIONS
 	-----------------------------------------------------------------------------
-	Allocation_Error: exception;
-	Size_Error: exception;
-	Syntax_Error: exception;
-	Evaluation_Error: exception;
-	Internal_Error: exception;
-	IO_Error: exception;
 	Stream_End_Error: exception;
 
 	-----------------------------------------------------------------------------
@@ -200,7 +194,6 @@ package body H2.Scheme is
 	Closure_Object_Size: constant Pointer_Object_Size := 2;
 	Closure_Code_Index: constant Pointer_Object_Size := 1;
 	Closure_Environment_Index: constant Pointer_Object_Size := 2;
-
 	Continuation_Object_Size: constant Pointer_Object_Size := 1;
 	Continuation_Frame_Index: constant Pointer_Object_Size := 1;
 
@@ -1424,24 +1417,6 @@ end if;
 		return Ptr;
 	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;
-	end Make_Bigint;
-
 	function Is_Bigint (Source: in Object_Pointer) return Standard.Boolean is
 		pragma Inline (Is_Bigint);
 	begin
@@ -2698,10 +2673,21 @@ B.sign := Negative_Sign;
 
 A := Make_Bigint (Interp.Self, Size => 10);
 A.Half_Word_Slot(10) := 16#FFFFFFFF#;
---A := Bigint.Multiply (Interp.Self, A, integer_to_pointer(2));
+A := Bigint.Multiply (Interp.Self, A, integer_to_pointer(2));
 A := Bigint.Add (Interp.Self, A, A);
 
+--A := Bigint.Divide (Interp.Self, A, integer_to_pointer(0));
+
 print (interp, A);
+
+declare
+q, r: object_Pointer;
+begin
+	--Bigint.Divide (Interp.Self, integer_to_pointer(-10), integer_to_pointer(6), Q, R);
+	Bigint.Divide (Interp.Self, A, integer_to_pointer(-2), Q, R);
+print (interp, Q);
+print (interp, R);
+end;
 Pop_tops (Interp, 2);
 end;
 			Ada.Text_IO.Put_LINE ("=== BYE ===");

lib/h2-scheme.ads

@@ -43,6 +43,17 @@ generic
 	type Character_Type is (<>);
 package H2.Scheme is
 
+	-----------------------------------------------------------------------------
+	-- EXCEPTIONS
+	-----------------------------------------------------------------------------
+	Allocation_Error: exception;
+	Size_Error: exception;
+	Syntax_Error: exception;
+	Evaluation_Error: exception;
+	Internal_Error: exception;
+	IO_Error: exception;
+	Divide_By_Zero_Error: exception;
+
 	type Interpreter_Record is limited private;
 	type Interpreter_Pointer is access all Interpreter_Record;
 
@@ -475,12 +486,6 @@ package H2.Scheme is
 	function Make_Bigint (Interp: access Interpreter_Record;
 	                      Value:  in     Object_Integer) return Object_Pointer;
 
-	-- Copy as many Half_Word_Slots as Last from the Source 
-	-- and create a Bigint object.
-	function Make_Bigint (Interp:  access Interpreter_Record;
-	                      Source:  in     Object_Pointer;
-	                      Last:    in     Half_Word_Object_Size) return Object_Pointer;
-
 	-- -----------------------------------------------------------------------------
 
 
@@ -612,6 +617,12 @@ private
 		                   X:      in     Object_Pointer;
 		                   Y:      in     Object_Pointer) return Object_Pointer;
 
+		procedure Divide (Interp: access Interpreter_Record;
+		                  X:      in     Object_Pointer;
+		                  Y:      in     Object_Pointer;
+		                  Q:      out    Object_Pointer;
+		                  R:      out    Object_Pointer);
+
 	end Bigint;
 
 end H2.Scheme;