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

added No_Optimization

Browse Source
This commit is contained in:
hyung-hwan 2013-12-19 14:42:14 +00:00
parent 29b7183205
commit 228a5d09db
2 changed files with 38 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lib/h2-scheme.adb
View File

@ -1925,13 +1925,16 @@ end Make_Test_Object;
Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Group); Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Group);
Set_Frame_Operand (Interp.Stack, Operand); Set_Frame_Operand (Interp.Stack, Operand);
-- I call Evaluate_Group for optimizatio here.
if (Interp.Trait.Trait_Bits and No_Optimization) = 0 then
-- I call Evaluate_Group for optimization here.
Evaluate_Group; -- for optimization only. not really needed. Evaluate_Group; -- for optimization only. not really needed.
-- I can jump to Start_Over because Evaluate_Group called -- I can jump to Start_Over because Evaluate_Group called
-- above pushes an Opcode_Evaluate_Object frame. -- above pushes an Opcode_Evaluate_Object frame.
pragma Assert (Get_Frame_Opcode(Interp.Stack) = Opcode_Evaluate_Object); pragma Assert (Get_Frame_Opcode(Interp.Stack) = Opcode_Evaluate_Object);
goto Start_Over; -- for optimization only. not really needed. goto Start_Over; -- for optimization only. not really needed.
end if; end if;
end if;
when Define_Syntax => when Define_Syntax =>
Text_IO.Put_Line ("define syntax"); Text_IO.Put_Line ("define syntax");
Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Syntax); -- switch to syntax evaluation Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Syntax); -- switch to syntax evaluation
@ -1940,6 +1943,7 @@ end Make_Test_Object;
Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Syntax); -- switch to syntax evaluation Set_Frame_Opcode (Interp.Stack, Opcode_Evaluate_Syntax); -- switch to syntax evaluation
end case; end case;
else else
if (Interp.Trait.Trait_Bits and No_Optimization) = 0 then
while not Is_Normal_Pointer(Car) loop while not Is_Normal_Pointer(Car) loop
-- This while block is for optimization only. It's not really needed. -- This while block is for optimization only. It's not really needed.
-- If I know that the next object to evaluate is a literal object, -- If I know that the next object to evaluate is a literal object,
@ -1961,6 +1965,7 @@ end Make_Test_Object;
return; return;
end if; end if;
end loop; end loop;
end if;
if Is_Cons(Cdr) then if Is_Cons(Cdr) then
-- Not the last cons cell yet -- Not the last cons cell yet
@ -1980,9 +1985,11 @@ end Make_Test_Object;
end if; end if;
-- Arrange to evaluate the car object -- Arrange to evaluate the car object
if (Interp.Trait.Trait_Bits and No_Optimization) = 0 then
Push_Frame (Opcode_Evaluate_Object, Car); Push_Frame (Opcode_Evaluate_Object, Car);
goto Start_Over; -- for optimization only. not really needed. goto Start_Over; -- for optimization only. not really needed.
end if; end if;
end if;
when Mark_Object => when Mark_Object =>
-- TODO: you can use the mark context to differentiate context -- TODO: you can use the mark context to differentiate context

3
lib/h2-scheme.ads
View File

@ -257,7 +257,8 @@ package H2.Scheme is
type Memory_Size is range 0 .. (2 ** (System.Word_Size - 1)) - 1; type Memory_Size is range 0 .. (2 ** (System.Word_Size - 1)) - 1;
type Trait_Mask is mod 2 ** System.Word_Size; type Trait_Mask is mod 2 ** System.Word_Size;
No_Garbage_Collection: constant Trait_Mask := 2 ** 0; No_Garbage_Collection: constant Trait_Mask := 2#0000_0000_0000_0001#;
No_Optimization: constant Trait_Mask := 2#0000_0000_0000_0010#;
type Option_Kind is (Trait_Option); type Option_Kind is (Trait_Option);
type Option_Record (Kind: Option_Kind) is record type Option_Record (Kind: Option_Kind) is record