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

switched some pointer overlays to unchecked conversion for the buggy gnat 3.15p

Browse Source
This commit is contained in:
hyung-hwan 2014-02-07 05:22:41 +00:00
parent b16c78fc03
commit 8f8e510970
2 changed files with 58 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -24,9 +24,16 @@ package body Token is
package Pool is new H2.Pool (New_String, New_String_Pointer, Interp.Storage_Pool); package Pool is new H2.Pool (New_String, New_String_Pointer, Interp.Storage_Pool);
Tmp: New_String_Pointer; -- Pointer overlay doesn't work well in gnat-3.15p
for Tmp'Address use Buffer.Ptr'Address; -- The pointer is initialized to null despite pragma Import.
pragma Import (Ada, Tmp); --Tmp: New_String_Pointer;
--for Tmp'Address use Buffer.Ptr'Address;
--pragma Import (Ada, Tmp);
-- So let me use unchecked conversion instead.
function Conv1 is new Ada.Unchecked_Conversion (Thin_Object_Character_Array_Pointer, New_String_Pointer);
Tmp: New_String_Pointer := Conv1(Buffer.Ptr);
begin begin
Pool.Deallocate (Tmp); Pool.Deallocate (Tmp);
end; end;
@ -58,16 +65,26 @@ package body Token is
package Pool is new H2.Pool (New_String, New_String_Pointer, Interp.Storage_Pool); package Pool is new H2.Pool (New_String, New_String_Pointer, Interp.Storage_Pool);
T1: New_String_Pointer; T1: New_String_Pointer;
T2: New_String_Pointer;
for T2'Address use Buffer.Ptr'Address; -- Pointer overlay doesn't work well in gnat-3.15p
pragma Import (Ada, T2); -- The pointer is initialized to null despite pragma Import.
--T2: New_String_Pointer;
--for T2'Address use Buffer.Ptr'Address;
--pragma Import (Ada, T2);
-- So let me use unchecked conversion instead.
function Conv1 is new Ada.Unchecked_Conversion (Thin_Object_Character_Array_Pointer, New_String_Pointer);
function Conv2 is new Ada.Unchecked_Conversion (New_String_Pointer, Thin_Object_Character_Array_Pointer);
T2: New_String_Pointer := Conv1(Buffer.Ptr);
begin begin
T1 := Pool.Allocate; T1 := Pool.Allocate;
if Buffer.Last > 0 then if Buffer.Last > 0 then
T1(1 .. Buffer.Last) := Buffer.Ptr(1 .. Buffer.Last); T1(1 .. Buffer.Last) := T2(1 .. Buffer.Last);
end if; end if;
Pool.Deallocate (T2); Pool.Deallocate (T2);
T2 := T1;
--T2 := T1; -- uncomment this line if using overlay.
Buffer.Ptr := Conv2(T1); -- uncomment this line if using unchecked conversion.
end; end;
Buffer.Len := Buffer.Len + Incr; Buffer.Len := Buffer.Len + Incr;

79
lib/h2-scheme.adb
View File

@ -308,37 +308,6 @@ package body H2.Scheme is
return Object_Byte(Word / (2 ** Object_Pointer_Type_Bits)); return Object_Byte(Word / (2 ** Object_Pointer_Type_Bits));
end Pointer_To_Byte; end Pointer_To_Byte;
-- TODO: move away these utilities routines
--function To_Thin_Object_String_Pointer (Source: in Object_Pointer) return Thin_Object_String_Pointer is
-- type Character_Pointer is access all Object_Character;
-- Ptr: Thin_Object_String_Pointer;
-- X: Character_Pointer;
-- for X'Address use Ptr'Address;
-- pragma Import (Ada, X);
--begin
-- this method requires Object_Character_Array to have aliased Object_Character.
-- So i've commented out this function and turn to a different method below.
-- X := Source.Character_Slot(Source.Character_Slot'First)'Access;
-- return Ptr;
--end To_Thin_Object_String_Pointer;
--function To_Thin_Object_String_Pointer (Source: in Object_Pointer) return Thin_Object_String_Pointer is
-- function To_Thin_Pointer is new Ada.Unchecked_Conversion (System.Address, Thin_Object_String_Pointer);
--begin
-- return To_Thin_Pointer(Source.Character_Slot'Address);
--end To_Thin_Object_String_Pointer;
--function To_Thin_Object_String_Pointer (Source: in Object_Pointer) return Thin_Object_String_Pointer is
-- X: aliased Thin_Object_String;
-- for X'Address use Source.Character_Slot'Address;
--begin
-- return X'Unchecked_Access;
--end To_Thin_Object_String_Pointer;
--procedure Put_String (TS: in Thin_Object_String_Pointer);
--pragma Import (C, Put_String, "puts");
-- TODO: delete this procedure -- TODO: delete this procedure
procedure Print_Object_Pointer (Msg: in Standard.String; Source: in Object_Pointer) is procedure Print_Object_Pointer (Msg: in Standard.String; Source: in Object_Pointer) is
W: Object_Word; W: Object_Word;
@ -595,22 +564,32 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
pragma Assert (Source.all'Size = Target_Object.all'Size); pragma Assert (Source.all'Size = Target_Object.all'Size);
end Copy_Object; end Copy_Object;
procedure Copy_Object_With_Size (Source: in Object_Pointer; procedure Copy_Object_With_Size (Source: in Object_Pointer;
Target: in out Heap_Element_Pointer; Target: in Heap_Element_Pointer;
Bytes: in Heap_Size) is Bytes: in Heap_Size) is
pragma Inline (Copy_Object_With_Size); --pragma Inline (Copy_Object_With_Size);
-- This procedure uses a more crude type for copying objects. -- This procedure uses a more crude type for copying objects.
-- It's the result of an effort to work around some compiler -- It's the result of an effort to work around some compiler
-- issues mentioned above. -- issues mentioned above.
Tgt: Thin_Heap_Element_Array_Pointer;
for Tgt'Address use Target'Address;
pragma Import (Ada, Tgt);
Src: Thin_Heap_Element_Array_Pointer;
for Src'Address use Source'Address; -- The work around, however, still didn't work well with gnat-3.15p.
pragma Import (Ada, Src); -- The overlaying(thus overlaid) pointer is initialized to null
-- despite pragma Import.
--Tgt: Thin_Heap_Element_Array_Pointer;
--for Tgt'Address use Target'Address;
--pragma Import (Ada, Tgt);
--Src: Thin_Heap_Element_Array_Pointer;
--for Src'Address use Source'Address;
--pragma Import (Ada, Src);
-- So let me turn to unchecked conversion instead.
function Conv1 is new Ada.Unchecked_Conversion (Object_Pointer, Thin_Heap_Element_Array_Pointer);
function Conv2 is new Ada.Unchecked_Conversion (Heap_Element_Pointer, Thin_Heap_Element_Array_Pointer);
Src: Thin_Heap_Element_Array_Pointer := Conv1(Source);
Tgt: Thin_Heap_Element_Array_Pointer := Conv2(Target);
begin begin
Tgt(Tgt'First .. Tgt'First + Bytes) := Src(Src'First .. Src'First + Bytes); Tgt(Tgt'First .. Tgt'First + Bytes - 1) := Src(Src'First .. Src'First + Bytes - 1);
end Copy_Object_With_Size; end Copy_Object_With_Size;
procedure Collect_Garbage (Interp: in out Interpreter_Record) is procedure Collect_Garbage (Interp: in out Interpreter_Record) is
@ -690,9 +669,15 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
Ptr := Interp.Heap(New_Heap).Space(Position)'Unchecked_Access; Ptr := Interp.Heap(New_Heap).Space(Position)'Unchecked_Access;
declare declare
Object: Object_Pointer; -- There is a overlaid pointer initialization problem despite
for Object'Address use Ptr'Address; -- "pragma Import()" in gnat-3.15p.
pragma Import (Ada, Object); -- not really needed --Object: Object_Pointer;
--for Object'Address use Ptr'Address;
--pragma Import (Ada, Object);
-- So let me turn to unchecked conversion.
function Conv1 is new Ada.Unchecked_Conversion (Heap_Element_Pointer, Object_Pointer);
Object: Object_Pointer := Conv1(Ptr);
--subtype Target_Object_Record is Object_Record (Object.Kind, Object.Size); --subtype Target_Object_Record is Object_Record (Object.Kind, Object.Size);
Bytes: Heap_Size; Bytes: Heap_Size;
@ -754,6 +739,7 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
begin begin
ada.text_io.put_line ("[GC BEGIN]");
--declare --declare
--Avail: Heap_Size; --Avail: Heap_Size;
--begin --begin
@ -835,6 +821,7 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
--Ada.Text_IO.Put_Line (">>> [GC DONE] BOUND: " & Heap_Size'Image(Interp.Heap(Interp.Current_Heap).Bound) & " AVAIL: " & Heap_Size'Image(Avail)); --Ada.Text_IO.Put_Line (">>> [GC DONE] BOUND: " & Heap_Size'Image(Interp.Heap(Interp.Current_Heap).Bound) & " AVAIL: " & Heap_Size'Image(Avail));
--Ada.Text_IO.Put_Line (">>> [GC DONE] ----------------------------------------------------------"); --Ada.Text_IO.Put_Line (">>> [GC DONE] ----------------------------------------------------------");
--end; --end;
ada.text_io.put_line ("[GC END]");
end Collect_Garbage; end Collect_Garbage;
function Allocate_Bytes (Interp: access Interpreter_Record; function Allocate_Bytes (Interp: access Interpreter_Record;
@ -2137,7 +2124,7 @@ end if;
Operand: in Object_Pointer) is Operand: in Object_Pointer) is
pragma Inline (Push_Frame); pragma Inline (Push_Frame);
begin begin
Interp.Stack :=Insert_Frame(Interp.Self, Interp.Stack, Opcode, Operand, Get_Frame_Environment(Interp.Stack), Nil_Pointer); Interp.Stack := Insert_Frame(Interp.Self, Interp.Stack, Opcode, Operand, Get_Frame_Environment(Interp.Stack), Nil_Pointer);
end Push_Frame; end Push_Frame;
procedure Push_Frame_With_Environment (Interp: in out Interpreter_Record; procedure Push_Frame_With_Environment (Interp: in out Interpreter_Record;