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

deleted unneeded functions

Browse Source
This commit is contained in:
hyung-hwan 2014-02-01 15:59:36 +00:00
parent f7aad3350c
commit 804ce67fdd
3 changed files with 7 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
lib/h2-scheme-execute-apply.adb
View File

@ -406,28 +406,22 @@ Ada.Text_IO.Put_line ("TOO FEW ARGUMETNS FOR COMPARISON");
Push_Top (Interp, C'Unchecked_Access);
C := Get_Frame_Parent(Interp.Stack);
if Get_Frame_Parent(C) = Nil_Pointer then
C := Make_Continuation (Interp.Self, C, Nil_Pointer, Nil_Pointer);
else
declare
w: object_word;
for w'address use c'address;
f: object_word;
for f'address use interp.stack'address;
r: object_pointer := get_frame_result(c);
rw: object_word;
for rw'address use r'address;
begin
ada.text_io.put_line ("Frame" & object_word'image(f) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
ada.text_io.put (" CURRENT RESULT ");
print (interp, r);
ada.text_io.put_line (" PARENT FRAME " & object_word'image(w));
end;
--C := Make_Continuation (Interp.Self, C, Get_Frame_Result(Get_Frame_Parent(C)), Get_Frame_Operand(Get_Frame_Parent(C)));
C := Make_Continuation (Interp.Self, C, Get_Frame_Result(Get_Frame_Parent(C)), Get_Frame_Result(C));
end if;
C := Make_Continuation (Interp.Self, C);
C := Make_Cons (Interp.Self, C, Nil_Pointer);
C := Make_Cons (Interp.Self, Get_Car(Args), C);
declare
@ -444,6 +438,7 @@ end;
Set_Frame_Opcode (Interp.Stack, Opcode_Apply);
Set_Frame_Operand (Interp.Stack, C);
Clear_Frame_Result (Interp.Stack);
ada.text_io.put_line (" CLEARED RESULT BEFORE APPLYING");
Pop_Tops (Interp, 1);
@ -489,16 +484,6 @@ ada.text_io.put_line (" CURRENT OPCODE " & opcode_type'imag
end;
declare
k: object_pointer := get_continuation_save2(func);
w: object_word;
for w'address use k'address;
begin
ada.text_io.put (" RESTORE FREME RESULT TO " & object_word'image(w) & " --> ");
print (interp, k);
end;
--Set_Frame_Result (Interp.Stack, Get_Continuation_Save2(Func));
ada.text_io.put (" CHAIN NEW RESULT, TAKING THE FIRST ONLY FROM ");
print (interp, args);
Put_Frame_Result (Interp, Interp.Stack, Get_Car(Args));

1
lib/h2-scheme-execute.adb
View File

@ -1036,6 +1036,7 @@ begin
Do_Grouped_Call;
when Opcode_Grouped_Call_Finish =>
Do_Grouped_Call_Finish;
when Opcode_Let_Binding =>
Do_Let_Binding;
when Opcode_Letast_Binding =>

26
lib/h2-scheme.adb
View File

@ -147,10 +147,8 @@ package body H2.Scheme is
Closure_Code_Index: constant Pointer_Object_Size := 1;
Closure_Environment_Index: constant Pointer_Object_Size := 2;
Continuation_Object_Size: constant Pointer_Object_Size := 3;
Continuation_Object_Size: constant Pointer_Object_Size := 1;
Continuation_Frame_Index: constant Pointer_Object_Size := 1;
Continuation_Save_Index: constant Pointer_Object_Size := 2;
Continuation_Save2_Index: constant Pointer_Object_Size := 3;
procedure Set_New_Location (Object: in Object_Pointer;
Ptr: in Heap_Element_Pointer);
@ -1572,20 +1570,14 @@ Ada.Text_IO.Put_Line ("Make_String...");
-----------------------------------------------------------------------------
function Make_Continuation (Interp: access Interpreter_Record;
Frame: in Object_Pointer;
Save: in Object_Pointer;
Save2: in Object_Pointer) return Object_Pointer is
Frame: in Object_Pointer) return Object_Pointer is
Cont: Object_Pointer;
Aliased_Frame: aliased Object_Pointer := Frame;
Aliased_Save: aliased Object_Pointer := Save;
Aliased_Save2: aliased Object_Pointer := Save2;
begin
Push_Top (Interp.all, Aliased_Frame'Unchecked_Access);
Cont := Allocate_Pointer_Object (Interp, Continuation_Object_Size, Nil_Pointer);
Cont.Tag := Continuation_Object;
Cont.Pointer_Slot(Continuation_Frame_Index) := Aliased_Frame;
Cont.Pointer_Slot(Continuation_Save_Index) := Aliased_Save;
Cont.Pointer_Slot(Continuation_Save2_Index) := Aliased_Save2;
Pop_Tops (Interp.all, 1);
return Cont;
end Make_Continuation;
@ -1604,20 +1596,6 @@ Ada.Text_IO.Put_Line ("Make_String...");
return Cont.Pointer_Slot(Continuation_Frame_Index);
end Get_Continuation_Frame;
function Get_Continuation_Save (Cont: in Object_Pointer) return Object_Pointer is
pragma Inline (Get_Continuation_Save);
pragma Assert (Is_Continuation(Cont));
begin
return Cont.Pointer_Slot(Continuation_Save_Index);
end Get_Continuation_Save;
function Get_Continuation_Save2 (Cont: in Object_Pointer) return Object_Pointer is
pragma Inline (Get_Continuation_Save2);
pragma Assert (Is_Continuation(Cont));
begin
return Cont.Pointer_Slot(Continuation_Save2_Index);
end Get_Continuation_Save2;
-----------------------------------------------------------------------------
procedure Deinitialize_Heap (Interp: in out Interpreter_Record) is
begin