develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34701 - trunk/compilers/pirc/new

From:
kjs
Date:
December 31, 2008 05:20
Subject:
[svn:parrot] r34701 - trunk/compilers/pirc/new
Message ID:
20081231132048.B6861CB9FA@x12.develooper.com
Author: kjs
Date: Wed Dec 31 05:20:47 2008
New Revision: 34701

Modified:
   trunk/compilers/pirc/new/pircompunit.c
   trunk/compilers/pirc/new/piremit.c
   trunk/compilers/pirc/new/pirpcc.c
   trunk/compilers/pirc/new/pirregalloc.c

Log:
[pirc] Even more fixes for :named arguments. They should be working now...

Modified: trunk/compilers/pirc/new/pircompunit.c
==============================================================================
--- trunk/compilers/pirc/new/pircompunit.c	(original)
+++ trunk/compilers/pirc/new/pircompunit.c	Wed Dec 31 05:20:47 2008
@@ -1567,47 +1567,30 @@
     argument *arg_iter;
     unsigned  arg_count = 0;
 
-    inv->arguments = args;
-
-    if (args) {
-
-        arg_iter = args;
-
-        do {
-
-            /* count :named arguments twice, once for the argument,
-             * once for the :named flag value. Also, add an extra
-             * argument holding the :named flag value, which is a
-             * constant string.
-             */
-            if (TEST_FLAG(arg_iter->flags, TARGET_FLAG_NAMED)) {
-                argument *arg = new_argument(lexer, expr_from_string(lexer, arg_iter->alias));
-
-                /* and clear the :named flag on the original argument; XXX is this correct?
-                   a disassemble on a test file generated by Parrot seems to do this.
-                 */
-                CLEAR_FLAG(arg_iter->flags, TARGET_FLAG_NAMED);
-
-                add_arg(arg_iter, arg);
+    if (args == NULL) {
+        inv->arguments     = NULL;
+        inv->num_arguments = 0;
+        return inv;
+    }
 
-                /* set the :named flag on this extra argument. XXX is this correct? */
-                SET_FLAG(arg->flags, TARGET_FLAG_NAMED);
+    inv->arguments = args;
 
-                /* we just inserted an extra argument for the value of :named() flag;
-                 * but it need not be handled here; so skip it now:
-                 */
-                arg_iter = arg_iter->next;
+    arg_iter = args;
 
-                arg_count += 2;
-            }
-            else
-                ++arg_count;
+    do {
+        /* count :named arguments twice, once for the argument,
+         * once for the :named flag value.
+         */
+        if (TEST_FLAG(arg_iter->flags, TARGET_FLAG_NAMED))
+            arg_count += 2;
+        else
+            ++arg_count;
 
-            arg_iter = arg_iter->next;
+        arg_iter = arg_iter->next;
 
-        }
-        while (arg_iter != args);
     }
+    while (arg_iter != args);
+
 
     /* fprintf(stderr, "invocation has %u args\n", arg_count); */
 
@@ -2319,8 +2302,6 @@
 Update register usage for the current subroutine with the register usage
 information in C<reg_usage>.
 
-XXX the passed register usage info is 1 too high for each type.
-
 =cut
 
 */

Modified: trunk/compilers/pirc/new/piremit.c
==============================================================================
--- trunk/compilers/pirc/new/piremit.c	(original)
+++ trunk/compilers/pirc/new/piremit.c	Wed Dec 31 05:20:47 2008
@@ -308,13 +308,13 @@
 
     do {
 
-       /*
+/*
         fprintf(out, "# subroutine '%s' register usage\n", subiter->info.subname);
         fprintf(out, "#   int   : %d\n", subiter->info.regs_used[INT_TYPE]);
         fprintf(out, "#   num   : %d\n", subiter->info.regs_used[NUM_TYPE]);
         fprintf(out, "#   string: %d\n", subiter->info.regs_used[STRING_TYPE]);
         fprintf(out, "#   pmc   : %d\n", subiter->info.regs_used[PMC_TYPE]);
-       */
+*/
 
         fprintf(out, ".namespace ");
         print_key(lexer, subiter->name_space);

Modified: trunk/compilers/pirc/new/pirpcc.c
==============================================================================
--- trunk/compilers/pirc/new/pirpcc.c	(original)
+++ trunk/compilers/pirc/new/pirpcc.c	Wed Dec 31 05:20:47 2008
@@ -155,6 +155,34 @@
 }
 
 
+/*
+
+=item C<void
+emit_sub_epilogue(lexer_state * const lexer)>
+
+Emit final instructions for the current subroutine. In case
+this is a C<:main> sub, the "end" instruction is emitted,
+otherwise it's a standard return sequence.
+
+=cut
+
+*/
+void
+emit_sub_epilogue(lexer_state * const lexer) {
+
+    if (TEST_FLAG(lexer->subs->flags, PIRC_SUB_FLAG_MAIN))
+        new_sub_instr(lexer, PARROT_OP_end, "end", 0);
+    else {
+        /* default sub epilogue; no return values, hence 0 */
+        int array_index = generate_signature_pmc(lexer, 0);
+        new_sub_instr(lexer, PARROT_OP_set_returns_pc, "set_returns_pc", 0);
+        push_operand(lexer, expr_from_const(lexer, new_const(lexer, INT_TYPE, array_index)));
+
+        new_sub_instr(lexer, PARROT_OP_returncc, "returncc", 0);
+    }
+}
+
+
 
 /*
 
@@ -244,52 +272,6 @@
 
 }
 
-/*
-
-=item C<void
-emit_sub_epilogue(lexer_state * const lexer)>
-
-Emit final instructions for the current subroutine. In case
-this is a C<:main> sub, the "end" instruction is emitted,
-otherwise it's a standard return sequence.
-
-=cut
-
-*/
-void
-emit_sub_epilogue(lexer_state * const lexer) {
-
-    if (TEST_FLAG(lexer->subs->flags, PIRC_SUB_FLAG_MAIN))
-        new_sub_instr(lexer, PARROT_OP_end, "end", 0);
-    else {
-        /* default sub epilogue; no return values, hence 0 */
-        int array_index = generate_signature_pmc(lexer, 0);
-        new_sub_instr(lexer, PARROT_OP_set_returns_pc, "set_returns_pc", 0);
-        push_operand(lexer, expr_from_const(lexer, new_const(lexer, INT_TYPE, array_index)));
-
-        new_sub_instr(lexer, PARROT_OP_returncc, "returncc", 0);
-    }
-}
-
-/*
-
-=item C<void
-generate_parameters_instr(lexer_state * const lexer, unsigned num_parameters)>
-
-Generate the "get_params" instruction, taking <num_parameters> variable arguments;
-this is the number of parameters of this function.
-
-=cut
-
-*/
-void
-generate_parameters_instr(lexer_state * const lexer, unsigned num_parameters) {
-    new_sub_instr(lexer, PARROT_OP_get_params_pc, "get_params_pc", num_parameters);
-    /* convert the parameter list into operands. Parameters are stored as target nodes. */
-    targets_to_operands(lexer, CURRENT_SUB(lexer)->parameters, num_parameters);
-}
-
-
 
 /*
 
@@ -331,6 +313,16 @@
     for (i = 0; i < num_arguments; ++i) {
         int flag = calculate_pcc_argument_flags(argiter);
 
+        if (TEST_FLAG(argiter->flags, TARGET_FLAG_NAMED)) {
+
+            VTABLE_set_integer_keyed_int(lexer->interp, signature_array, i,
+                                         PARROT_ARG_NAME | PARROT_ARG_SC);
+
+            push_operand(lexer, expr_from_string(lexer, argiter->alias));
+
+            ++i;
+            CLEAR_FLAG(argiter->flags, TARGET_FLAG_NAMED);
+        }
         /* set the flags for this argument in the right position in the array */
         VTABLE_set_integer_keyed_int(lexer->interp, signature_array, i, flag);
 
@@ -340,6 +332,25 @@
         argiter = argiter->next;
     }
 }
+
+
+/*
+
+=item C<void
+generate_parameters_instr(lexer_state * const lexer, unsigned num_parameters)>
+
+Generate the "get_params" instruction, taking <num_parameters> variable arguments;
+this is the number of parameters of this function.
+
+=cut
+
+*/
+void
+generate_parameters_instr(lexer_state * const lexer, unsigned num_parameters) {
+    new_sub_instr(lexer, PARROT_OP_get_params_pc, "get_params_pc", num_parameters);
+    /* convert the parameter list into operands. Parameters are stored as target nodes. */
+    targets_to_operands(lexer, CURRENT_SUB(lexer)->parameters, num_parameters);
+}
 /*
 
 =item C<static void

Modified: trunk/compilers/pirc/new/pirregalloc.c
==============================================================================
--- trunk/compilers/pirc/new/pirregalloc.c	(original)
+++ trunk/compilers/pirc/new/pirregalloc.c	Wed Dec 31 05:20:47 2008
@@ -505,9 +505,6 @@
         */
         for (i = lsr->intervals[type]; i != NULL; i = i->nexti) {
 
-            /* XXX temp. hack */
-            extern char const pir_register_types[5];
-
             /* expire all intervals whose endpoint is smaller than i's start
              * point; that means that i can be mapped to a register that was
              * previously assigned to one of the expired intervals; that one
@@ -519,11 +516,6 @@
             i->realreg = get_free_reg(lsr, type);
 
 
-            /*
-            fprintf(stderr, "Vanilla register %c%u (symbol %s) is mapped to %u\n",
-                     pir_register_types[type], *i->color, i->info->id.name, i->realreg);
-            */
-
             /* update the symbol/pir_reg with this newly allocated reg */
             *i->color = i->realreg;
 
@@ -537,8 +529,15 @@
 
         /* clear list of intervals */
         lsr->intervals[type] = NULL;
+
+        /* lsr->r is 1 too high w.r.t. the actual register usage, subtract now,
+         * this is safe, because lsr->r[type] will no longer be used, as type will
+         * be incremented.
+         */
+        --lsr->r[type];
     }
 
+
     /* update the register usage in the current subroutine structure. */
     update_sub_register_usage(lsr->lexer, lsr->r);
 



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