From 8b0444593a7d0c0214b935c3e3022e5594bb6474 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Fri, 7 Feb 2014 09:04:46 +0000 Subject: [PATCH] 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 | 17 +++++++++++------ lib/h2-scheme.adb | 20 +++++++++++++++++++- lib/h2-scheme.ads | 2 +- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/lib/h2-scheme-token.adb b/lib/h2-scheme-token.adb index 549cd21..82a3912 100644 --- a/lib/h2-scheme-token.adb +++ b/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); - end if; + Append_Buffer (Interp, Interp.Token.Value, Value); 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); - end if; + Append_Buffer (Interp, Interp.Token.Value, Value); end Append_String; procedure Append_Character (Interp: in out Interpreter_Record; diff --git a/lib/h2-scheme.adb b/lib/h2-scheme.adb index 7f04e2e..662f11f 100644 --- a/lib/h2-scheme.adb +++ b/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. diff --git a/lib/h2-scheme.ads b/lib/h2-scheme.ads index 8beba4f..11dea3e 100644 --- a/lib/h2-scheme.ads +++ b/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 =>