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

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

Browse Source 
fixed a bug of not getting a correct number of bytes allocated for an object when scanning a new heap
This commit is contained in:
hyung-hwan 2014-02-07 09:04:46 +00:00
parent 8f8e510970
commit 8b0444593a
3 changed files with 31 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lib/h2-scheme-token.adb
View File

@ -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;
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;
end Append_String;
procedure Append_Character (Interp: in out Interpreter_Record;

20
lib/h2-scheme.adb
View File

@ -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.

2
lib/h2-scheme.ads
View File

@ -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 =>