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

removed unneeded lines

Browse Source
This commit is contained in:
hyung-hwan 2014-02-06 13:36:56 +00:00
parent 2262591205
commit b16c78fc03
3 changed files with 47 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,6 @@ separate (H2.Scheme.Execute)
procedure Apply is procedure Apply is
--pragma Inline (Apply); --pragma Inline (Apply);
Operand: aliased Object_Pointer;
Func: aliased Object_Pointer; Func: aliased Object_Pointer;
Args: aliased Object_Pointer; Args: aliased Object_Pointer;
@ -394,16 +393,7 @@ Ada.Text_IO.Put_line ("TOO FEW ARGUMETNS FOR COMPARISON");
Push_Top (Interp, C'Unchecked_Access); -- this is not needed. TOOD: remove this Push_Top (Interp, C'Unchecked_Access); -- this is not needed. TOOD: remove this
C := Make_Continuation (Interp.Self, Get_Frame_Parent(Interp.Stack)); C := Make_Continuation (Interp.Self, Get_Frame_Parent(Interp.Stack));
declare
p: object_Pointer := get_frame_parent(interp.stack);
w: object_word;
for w'address use p'address;
begin
ada.text_io.put_line ("making continuatination to " & object_word'image(w) & " opcode " & opcode_type'image(get_frame_opcode(p)));
print (interp, get_Frame_operand(p));
print (interp, get_Frame_intermediate(p));
ada.text_io.put_line ("-----------------");
end;
Set_Frame_Opcode (Interp.Stack, Opcode_Apply); Set_Frame_Opcode (Interp.Stack, Opcode_Apply);
Set_Frame_Operand (Interp.Stack, Get_Car(Args)); -- (call/cc xxx), xxx becomes this. Set_Frame_Operand (Interp.Stack, Get_Car(Args)); -- (call/cc xxx), xxx becomes this.
Set_Frame_Intermediate (Interp.Stack, Nil_Pointer); -- pass the continuation object Set_Frame_Intermediate (Interp.Stack, Nil_Pointer); -- pass the continuation object
@ -415,19 +405,19 @@ end;
procedure Apply_Continuation is procedure Apply_Continuation is
begin begin
declare --declare
w: object_word; --w: object_word;
for w'address use func'address; --for w'address use func'address;
f: object_word; --f: object_word;
for f'address use interp.stack'address; --for f'address use interp.stack'address;
begin --begin
ada.text_io.put_line ("Frame" & object_word'image(f) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack))); --ada.text_io.put_line ("Frame" & object_word'image(f) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
ada.text_io.put (" POPPING ... APPLY CONTINUATION -->> "); --ada.text_io.put (" POPPING ... APPLY CONTINUATION -->> ");
ada.text_io.put (object_word'image(w) & " "); --ada.text_io.put (object_word'image(w) & " ");
end; --end;
Print (Interp, Args); --Print (Interp, Args);
ada.text_io.put (" CURRENT FREME RESULT " ); --ada.text_io.put (" CURRENT FREME RESULT " );
Print (Interp, get_Frame_result(interp.stack)); --Print (Interp, get_Frame_result(interp.stack));
if not Is_Cons(Args) or else Get_Cdr(Args) /= Nil_Pointer then if not Is_Cons(Args) or else Get_Cdr(Args) /= Nil_Pointer then
Ada.Text_IO.Put_Line ("WRONG NUMBER OF ARGUMETNS FOR CONTINUATION"); Ada.Text_IO.Put_Line ("WRONG NUMBER OF ARGUMETNS FOR CONTINUATION");
raise Syntax_Error; raise Syntax_Error;
@ -436,54 +426,52 @@ Print (Interp, get_Frame_result(interp.stack));
-- Restore the frame to the remembered one -- Restore the frame to the remembered one
Interp.Stack := Get_Continuation_Frame(Func); Interp.Stack := Get_Continuation_Frame(Func);
declare --declare
f: object_word; --f: object_word;
for f'address use interp.stack'address; --for f'address use interp.stack'address;
begin --begin
ada.text_io.put_line (" SWITCHED STACK TO FREME " & object_word'image(f) ); --ada.text_io.put_line (" SWITCHED STACK TO FREME " & object_word'image(f) );
ada.text_io.put (" CURRENT RESULT " ); --ada.text_io.put (" CURRENT RESULT " );
print (interp, get_Frame_result(interp.stack)); --print (interp, get_Frame_result(interp.stack));
ada.text_io.put (" CURRENT OPERAND " ); --ada.text_io.put (" CURRENT OPERAND " );
print (interp, get_Frame_operand(interp.stack)); --print (interp, get_Frame_operand(interp.stack));
ada.text_io.put (" CURRENT INTERMEDIATE " ); --ada.text_io.put (" CURRENT INTERMEDIATE " );
print (interp, get_Frame_intermediate(interp.stack)); --print (interp, get_Frame_intermediate(interp.stack));
ada.text_io.put_line (" CURRENT OPCODE " & opcode_type'image(get_Frame_opcode(interp.stack))); --ada.text_io.put_line (" CURRENT OPCODE " & opcode_type'image(get_Frame_opcode(interp.stack)));
end; --end;
Set_Frame_Result (Interp.Stack, Get_Car(Args)); Set_Frame_Result (Interp.Stack, Get_Car(Args));
ada.text_io.put (" FINAL RESULT "); --ada.text_io.put (" FINAL RESULT ");
print (interp, get_Frame_result(interp.stack)); --print (interp, get_Frame_result(interp.stack));
end Apply_Continuation; end Apply_Continuation;
begin begin
Push_Top (Interp, Operand'Unchecked_Access);
Push_Top (Interp, Func'Unchecked_Access); Push_Top (Interp, Func'Unchecked_Access);
Push_Top (Interp, Args'Unchecked_Access); Push_Top (Interp, Args'Unchecked_Access);
Operand := Get_Frame_Operand(Interp.Stack); Func := Get_Frame_Operand(Interp.Stack);
-- pragma Assert (Is_Cons(Operand));
declare
w: object_word;
for w'address use interp.stack'address;
begin
ada.text_io.put_line ("Frame" & object_word'image(w) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
ada.text_io.put (" OPERAND TO APPLY => ");
print (Interp, Operand);
ada.text_io.put (" CURRENT RESULT => ");
print (Interp, get_frame_result(interp.stack));
end;
-- Func := Get_Car(Operand);
Func := Get_Frame_Operand(Interp.Stack);
if not Is_Normal_Pointer(Func) then if not Is_Normal_Pointer(Func) then
Ada.Text_IO.Put_Line ("INVALID FUNCTION TYPE"); Ada.Text_IO.Put_Line ("INVALID FUNCTION TYPE");
raise Evaluation_Error; raise Evaluation_Error;
end if; end if;
-- Args := Get_Cdr(Operand); Args := Get_Frame_Intermediate(Interp.Stack);
Args := Get_Frame_Intermediate(Interp.Stack);
--declare
--w: object_word;
--for w'address use interp.stack'address;
--begin
--ada.text_io.put_line ("Frame" & object_word'image(w) & " " & Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
--ada.text_io.put (" FUNCTION => ");
--print (Interp, Func);
--ada.text_io.put (" ARGUMENTS => ");
--print (Interp, Args);
--ada.text_io.put (" CURRENT RESULT => ");
--print (Interp, get_frame_result(interp.stack));
--end;
case Func.Tag is case Func.Tag is
when Procedure_Object => when Procedure_Object =>
@ -539,5 +527,5 @@ Args := Get_Frame_Intermediate(Interp.Stack);
end case; end case;
Pop_Tops (Interp, 3); Pop_Tops (Interp, 2);
end Apply; end Apply;

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

@ -911,11 +911,8 @@ begin
-- The caller must push some frames before calling this procedure -- The caller must push some frames before calling this procedure
pragma Assert (Interp.Stack /= Nil_Pointer); pragma Assert (Interp.Stack /= Nil_Pointer);
-- The caller must ensure there are no temporary object pointers.
--pragma Assert (Interp.Top.Last < Interp.Top.Data'First);
loop loop
ada.text_io.put_line (Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack))); --ada.text_io.put_line (Opcode_Type'Image(Get_Frame_Opcode(Interp.Stack)));
case Get_Frame_Opcode(Interp.Stack) is case Get_Frame_Opcode(Interp.Stack) is
when Opcode_Exit => when Opcode_Exit =>
exit; exit;

1
lib/h2-scheme.adb
View File

@ -754,7 +754,6 @@ ada.text_io.put_line ("HEAP SOURCE IS NIL");
begin begin
Ada.Text_IO.Put_LINE ("GC RUNNING");
--declare --declare
--Avail: Heap_Size; --Avail: Heap_Size;
--begin --begin