fixed a bug that the token buffer points to null if an empty string is the first token scanned.

fixed a bug of not getting a correct number of bytes allocated for an object when scanning a new heap

lib/h2-scheme-token.adb

@@ -108,6 +108,15 @@ package body Token is
 	begin
 		Interp.Token.Kind := Kind;	
 		Clear_Buffer (Interp.Token.Value);
+		if Interp.Token.Value.Ptr = null then
+			declare
+				Tmp: Object_Character_Array(1..1);
+			begin
+				-- Ensure that the buffer is allocated if Set has been
+				-- called at least once.
+				Append_Buffer (Interp, Interp.Token.Value, Tmp(1..0)); 
+			end;
+		end if;
 	end Set;
 
 	procedure Set (Interp: in out Interpreter_Record;
@@ -127,17 +136,13 @@ package body Token is
 	begin
 		Interp.Token.Kind := Kind;	
 		Clear_Buffer (Interp.Token.Value);
-		if Value'Length > 0 then
+		Append_Buffer (Interp, Interp.Token.Value, Value);
-			Append_Buffer (Interp, Interp.Token.Value, Value);
-		end if;
 	end Set;
 
 	procedure Append_String (Interp: in out Interpreter_Record;
 	                         Value:  in     Object_Character_Array) is
 	begin
-		if Value'Length > 0 then
+		Append_Buffer (Interp, Interp.Token.Value, Value);	
-			Append_Buffer (Interp, Interp.Token.Value, Value);	
-		end if;
 	end Append_String;
 
 	procedure Append_Character (Interp: in out Interpreter_Record;

lib/h2-scheme.adb

@@ -500,6 +500,10 @@ package body H2.Scheme is
 			-- Guarantee the minimum object size to be greater than or 
 			-- equal to the size of a moved object for GC to work.
 			Real_Bytes := Moved_Object_Record'Max_Size_In_Storage_Elements;	
+
+			-- Note: Extra attention must be paid when calculating the 
+			-- actual bytes allocated for an object. Scan_New_Heap() also 
+			-- makes similar adjustment to skip actual allocated bytes.
 		end if;
 
 		Avail := Heap.Size - Heap.Bound;
@@ -567,7 +571,8 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
 	procedure Copy_Object_With_Size (Source: in Object_Pointer;
 	                                 Target: in Heap_Element_Pointer;
 	                                 Bytes:  in Heap_Size) is
-		--pragma Inline (Copy_Object_With_Size);
+		pragma Inline (Copy_Object_With_Size);
+		pragma Assert (Bytes > 0);
 		-- This procedure uses a more crude type for copying objects.
 		-- It's the result of an effort to work around some compiler
 		-- issues mentioned above.
@@ -639,6 +644,13 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
 					-- allocate more objects than in the old heap.
 					pragma Assert (Ptr /= null);
 
+					-- This minimum size adjustment is not needed when copying
+					-- an object as it's ok to have garbage in the trailing space.
+					-- See Allocate_Bytes_In_Heap() and Scan_New_Heap() for more info.
+					--if Bytes < Moved_Object_Record'Max_Size_In_Storage_Elements then
+					--	Bytes := Moved_Object_Record'Max_Size_In_Storage_Elements;	
+					--end  if;
+
 					-- Copy the payload to the new object
 					--Copy_Object (Object, Ptr); -- not reliable with some compilers
 					Copy_Object_With_Size (Source, Ptr, Bytes); -- use this instead
@@ -684,6 +696,11 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
 				begin
 					--Bytes := Target_Object_Record'Max_Size_In_Storage_Elements;
 					Bytes := Object.all'Size / System.Storage_Unit;
+					if Bytes < Moved_Object_Record'Max_Size_In_Storage_Elements then
+						-- Allocate_Bytes_In_Heap() guarantee the minimum object size.
+						-- The size must be guaranteed here when scanning a heap.
+						Bytes := Moved_Object_Record'Max_Size_In_Storage_Elements;	
+					end if;
 
 					if Object.Kind = Pointer_Object then
 --Ada.Text_IO.Put_Line (">>> Scanning Obj " & Object_Kind'Image(Object.Kind) & " Size: " & Object_Size'Image(Object.Size) & " At " & Object_Word'Image(Pointer_To_Word(Object)) & " Bytes " & Heap_Size'Image(Bytes));
@@ -1806,6 +1823,7 @@ Ada.Text_IO.Put_Line ("Make_String...");
 		Interp.Base_Input.Stream := null;
 		Interp.Input := Interp.Base_Input'Unchecked_Access;
 		Interp.Token := (End_Token, (null, 0, 0));
+
 		Interp.Top := (Interp.Top.Data'First - 1, (others => null));
 
 -- TODO: disallow garbage collecion during initialization.

lib/h2-scheme.ads

@@ -230,7 +230,7 @@ package H2.Scheme is
 				Pointer_Slot: Object_Pointer_Array(1 .. Size) := (others => null);
 			when Character_Object =>
 				Character_Slot: Object_Character_Array(1 .. Size) := (others => Object_Character'First);
-				Character_Terminator: Object_Character := Object_Character'First; -- TODO: can this guarantee termining NULL? require some attribute for it to work?
+				Character_Terminator: Object_Character := Object_Character'First; -- TODO: can this guarantee terminating NULL? require some attribute for it to work?
 			when Byte_Object =>
 				Byte_Slot: Object_Byte_Array(1 .. Size) := (others => 0);
 			when Word_Object =>