added some bigint code

h2/lib/h2-scheme-bigint.adb

@@ -49,20 +49,158 @@ package body Bigint is
 		return R.High;	
 	end Get_High;
 
+	function Is_Less (X: in Object_Pointer;
+	                  Y: in Object_Pointer) return Standard.Boolean is
+	begin
+		if X.Sign /= Y.Sign then
+			return X.Sign = Negative_Sign;
+		end if;
+
+		if X.Size /= Y.Size then
+			return X.Size < Y.Size;
+		end if;
+
+		for I in reverse X.Half_Word_Slot'Range loop
+			if X.Half_Word_Slot(I) /= Y.Half_Word_Slot(I) then
+				return X.Half_Word_Slot(I) < Y.Half_Word_Slot(I);
+			end if;	
+		end loop;
+
+		return Standard.False;
+	end Is_Less;
+
+	function Is_Equal (X: in Object_Pointer;
+	                   Y: in Object_Pointer) return Standard.Boolean is
+	begin
+		return X.Sign = Y.Sign and then 
+		       X.Size = Y.Size and then
+		       X.Half_Word_Slot = Y.Half_Word_Slot;
+	end Is_Equal;
+
 	function Add (Interp: access Interpreter_Record;
 	              X:      in     Object_Pointer;
 	              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_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(Y));
 
-		Z: Object_Pointer;
-		
+		A, B, Z: aliased Object_Pointer;
+		W: Object_Word;
+		Carry: Object_Half_Word; 
+		Last: Half_Word_Object_Size;
 	begin
-		--if X.Size > Y.Size then
-		--end if;
+		Push_Top (Interp.all, A'Unchecked_Access);
+		Push_Top (Interp.all, B'Unchecked_Access);
+		Push_Top (Interp.all, Z'Unchecked_Access);
 
-		--Z := Make_Bigint (Interp,  X.Size
-		return null;
+		if X.Size > Y.Size then
+			A := X;
+			B := Y;
+			Last := X.Size + 1;
+		else
+			A := Y;
+			B := X;	
+			Last := Y.Size + 1;
+		end if;
+			
+		Z := Make_Bigint (Interp.Self, Last);
+		Carry := 0;
+
+		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);
+			Carry := Get_High(W);
+			Z.Half_Word_Slot(I)	:= Get_Low(W);
+		end loop;
+
+		for I in B.Size + 1 .. A.Size loop
+			W := Object_Word(A.Half_Word_Slot(I)) + Object_Word(Carry);
+			Carry := Get_High(W);
+			Z.Half_Word_Slot(I)	:= Get_Low(W);
+		end loop;
+
+		if Carry > 0 then
+			Z.Half_Word_Slot(Last) := Carry;
+		else
+			declare
+				T: Object_Pointer;
+			begin
+				T := Make_Bigint(Interp.Self, Last - 1);
+				T.Half_Word_Slot := Z.Half_Word_Slot(1 .. Last - 1);
+				Z := T;
+			end;
+		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);
+		return Z;
 	end Add;
 
+	function Subtract (Interp: access Interpreter_Record;
+	                   X:      in     Object_Pointer;
+	                   Y:      in     Object_Pointer) return Object_Pointer is
+		A, B, Z: aliased Object_Pointer;
+		Last: Half_Word_Object_Size;
+		Borrow: Object_Signed_Word; 
+		T: Object_Signed_Word;
+	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;
+			Last := X.Size;
+		else
+			A := Y;
+			B := X;	
+			Last := Y.Size;
+		end if;
+			
+		Z := Make_Bigint (Interp.Self, Last);
+		Borrow := 0;
+
+		for I in 1 .. B.Size loop
+			T := Object_Signed_Word(A.Half_Word_Slot(I)) - Object_Signed_Word(B.Half_Word_Slot(I)) - Borrow;
+			if T < 0 then
+				Borrow := 1;
+				Z.Half_Word_Slot(I) := Object_Half_Word(-T);
+			else
+				Borrow := 0;
+				Z.Half_Word_Slot(I) := Object_Half_Word(T);
+			end if;
+		end loop;
+
+		for I in B.Size + 1 .. A.Size loop
+			T := Object_Signed_Word(A.Half_Word_Slot(I)) - Borrow;
+			if T < 0 then
+				Borrow := 1;
+				Z.Half_Word_Slot(I) := Object_Half_Word(-T);
+			else
+				Borrow := 0;
+				Z.Half_Word_Slot(I) := Object_Half_Word(T);
+			end if;
+		end loop;
+		
+ada.text_io.put_line ("-------------");
+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;
+	end Subtract;	
+
 end Bigint;
+