develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35038 - trunk/compilers/pirc/src

From:
kjs
Date:
January 6, 2009 06:29
Subject:
[svn:parrot] r35038 - trunk/compilers/pirc/src
Message ID:
20090106142931.47AF1CB9F9@x12.develooper.com
Author: kjs
Date: Tue Jan  6 06:29:30 2009
New Revision: 35038

Modified:
   trunk/compilers/pirc/src/pircompunit.c
   trunk/compilers/pirc/src/pirpcc.c

Log:
[pirc] refactoring of code, needed for implementing tailcalls.

Modified: trunk/compilers/pirc/src/pircompunit.c
==============================================================================
--- trunk/compilers/pirc/src/pircompunit.c	(original)
+++ trunk/compilers/pirc/src/pircompunit.c	Tue Jan  6 06:29:30 2009
@@ -2417,6 +2417,7 @@
      */
     if (CURRENT_INSTRUCTION(lexer)) {
         switch (CURRENT_INSTRUCTION(lexer)->opcode) {
+            case PARROT_OP_tailcall_p:
             case PARROT_OP_end:
             case PARROT_OP_returncc:
             case PARROT_OP_yield:

Modified: trunk/compilers/pirc/src/pirpcc.c
==============================================================================
--- trunk/compilers/pirc/src/pirpcc.c	(original)
+++ trunk/compilers/pirc/src/pirpcc.c	Tue Jan  6 06:29:30 2009
@@ -390,59 +390,32 @@
 
 /*
 
-=item C<static void
-convert_pcc_call(lexer_state * const lexer, invocation * const inv)>
-
-Generate instructions for a normal invocation using the Parrot Calling
-Conventions (PCC). This is the sequence of the following instructions:
-
-For $P0():
-
- set_args_pc
- get_results_pc
- invokecc_p / invoke_p_p
-
-For "foo"() and foo():
-
- set_args_pc
- set_p_pc / find_sub_not_null_p_sc
- get_results_pc
- invokecc_p
+=item C<static target *
+get_invoked_sub(lexer_state * const lexer, target * const sub)>
 
 =cut
 
 */
-static void
-convert_pcc_call(lexer_state * const lexer, invocation * const inv) {
-    new_sub_instr(lexer, PARROT_OP_set_args_pc, "set_args_pc", inv->num_arguments);
-    arguments_to_operands(lexer, inv->arguments, inv->num_arguments);
-
+static target *
+get_invoked_sub(lexer_state * const lexer, target * const sub) {
+    target *subreg = NULL;
 
     /* if the target is a register, invoke that. */
-    if (TEST_FLAG(inv->sub->flags, TARGET_FLAG_IS_REG)) {
-        target *sub = new_reg(lexer, PMC_TYPE, inv->sub->info->color);
-
-        if (inv->retcc) { /* return continuation present? */
-            new_sub_instr(lexer, PARROT_OP_invoke_p_p, "invoke_p_p", 0);
-            add_operands(lexer, "%T%T", inv->sub, inv->retcc);
-        }
-        else {
-            new_sub_instr(lexer, PARROT_OP_invokecc_p, "invokecc_p", 0);
-            add_operands(lexer, "%T", sub);
-        }
+    if (TEST_FLAG(sub->flags, TARGET_FLAG_IS_REG)) {
+        subreg = new_reg(lexer, PMC_TYPE, sub->info->color);
     }
     else { /* find the global label in the current file, or find it during runtime */
-        target *sub        = generate_unique_pir_reg(lexer, PMC_TYPE);
-        global_label *glob = find_global_label(lexer, inv->sub->info->id.name);
+        global_label *glob = find_global_label(lexer, sub->info->id.name);
+        subreg             = generate_unique_pir_reg(lexer, PMC_TYPE);
 
         if (glob) {
             new_sub_instr(lexer, PARROT_OP_set_p_pc, "set_p_pc", 0);
-            add_operands(lexer, "%T%i", sub, glob->const_table_index);
+            add_operands(lexer, "%T%i", subreg, glob->const_table_index);
         }
         else { /* find it during runtime (hopefully, otherwise exception) */
             new_sub_instr(lexer, PARROT_OP_find_sub_not_null_p_sc, "find_sub_not_null_p_sc", 0);
 
-            add_operands(lexer, "%T%s", sub, inv->sub->info->id.name);
+            add_operands(lexer, "%T%s", subreg, sub->info->id.name);
 
             /* save the current instruction in a list; entries in this list will be
              * fixed up, if possible, after the parsing phase.
@@ -458,16 +431,86 @@
              *
              *   find_sub_not_null_p_sc
              */
-            save_global_reference(lexer, CURRENT_INSTRUCTION(lexer), inv->sub->info->id.name);
+            save_global_reference(lexer, CURRENT_INSTRUCTION(lexer), sub->info->id.name);
         }
 
-        new_sub_instr(lexer, PARROT_OP_get_results_pc, "get_results_pc", inv->num_results);
-        targets_to_operands(lexer, inv->results, inv->num_results);
+    }
+    return subreg;
+
+}
+
+/*
+
+=item C<static void
+convert_pcc_call(lexer_state * const lexer, invocation * const inv)>
+
+Generate instructions for a normal invocation using the Parrot Calling
+Conventions (PCC). This is the sequence of the following instructions:
+
+For $P0():
+
+ set_args_pc
+ get_results_pc
+ invokecc_p / invoke_p_p
+
+For "foo"() and foo():
+
+ set_args_pc
+ set_p_pc / find_sub_not_null_p_sc
+ get_results_pc
+ invokecc_p
+
+=cut
+
+*/
+static void
+convert_pcc_call(lexer_state * const lexer, invocation * const inv) {
+    target *sub;
+
+    new_sub_instr(lexer, PARROT_OP_set_args_pc, "set_args_pc", inv->num_arguments);
+    arguments_to_operands(lexer, inv->arguments, inv->num_arguments);
+
+    new_sub_instr(lexer, PARROT_OP_get_results_pc, "get_results_pc", inv->num_results);
+    targets_to_operands(lexer, inv->results, inv->num_results);
+
+    sub = get_invoked_sub(lexer, inv->sub);
 
+    if (inv->retcc) { /* return continuation present? */
+        new_sub_instr(lexer, PARROT_OP_invoke_p_p, "invoke_p_p", 0);
+        add_operands(lexer, "%T%T", inv->sub, inv->retcc);
+    }
+    else {
         new_sub_instr(lexer, PARROT_OP_invokecc_p, "invokecc_p", 0);
         add_operands(lexer, "%T", sub);
-
     }
+
+}
+
+/*
+
+=item C<static void
+convert_pcc_tailcall(lexer_state * const lexer, invocation * const inv)>
+
+Generate instructions for a tailcall using the Parrot Calling Conventions (PCC).
+The sequence of instructions is:
+
+ set_args_pc
+ tailcall_pc
+
+=cut
+
+*/
+static void
+convert_pcc_tailcall(lexer_state * const lexer, invocation * const inv) {
+    target *sub;
+
+    new_sub_instr(lexer, PARROT_OP_set_args_pc, "set_args_pc", inv->num_arguments);
+    arguments_to_operands(lexer, inv->arguments, inv->num_arguments);
+
+    sub = get_invoked_sub(lexer, inv->sub);
+
+    new_sub_instr(lexer, PARROT_OP_tailcall_p, "tailcall_p", 0);
+    add_operands(lexer, "%T", sub);
 }
 
 /*
@@ -534,30 +577,7 @@
     new_sub_instr(lexer, PARROT_OP_yield, "yield", 0);
 }
 
-/*
-
-=item C<static void
-convert_pcc_tailcall(lexer_state * const lexer, invocation * const inv)>
-
-Generate instructions for a tailcall using the Parrot Calling Conventions (PCC).
-The sequence of instructions is:
 
- set_args_pc
- tailcall_pc
-
-=cut
-
-*/
-static void
-convert_pcc_tailcall(lexer_state * const lexer, invocation * const inv) {
-    new_sub_instr(lexer, PARROT_OP_set_args_pc, "set_args_pc", inv->num_arguments);
-    arguments_to_operands(lexer, inv->arguments, inv->num_arguments);
-
-    /* XXX this needs an argument; possibly refactor PCC_CALL code, so we can re-use
-     * the code to get the sub to invoke.
-     */
-    new_sub_instr(lexer, PARROT_OP_tailcall_p, "tailcall_p", 0);
-}
 
 /*
 



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About