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

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

From:
kjs
Date:
December 28, 2008 13:53
Subject:
[svn:parrot] r34520 - trunk/compilers/pirc/new
Message ID:
20081228215319.79ED8CB9FA@x12.develooper.com
Author: kjs
Date: Sun Dec 28 13:53:18 2008
New Revision: 34520

Modified:
   trunk/compilers/pirc/new/piremit.c

Log:
[pirc] refactoring + updates for emitting bytecode for keys. Not complete yet, and generated bc doesn't work yet, although it seems correct.

Modified: trunk/compilers/pirc/new/piremit.c
==============================================================================
--- trunk/compilers/pirc/new/piremit.c	(original)
+++ trunk/compilers/pirc/new/piremit.c	Sun Dec 28 13:53:18 2008
@@ -54,6 +54,7 @@
 static void emit_pir_statement(lexer_state * const lexer, subroutine * const sub);
 static void emit_pir_instruction(lexer_state * const lexer, instruction * const instr);
 
+static void emit_pbc_key(lexer_state * const lexer, key * const k);
 
 /* prototype declaration */
 void print_expr(lexer_state * const lexer, expression * const expr);
@@ -380,39 +381,43 @@
 */
 void
 emit_pir_subs(lexer_state * const lexer, char const * const outfile) {
-    if (lexer->subs != NULL) {
-        /* set iterator to first item */
-        subroutine *subiter = lexer->subs->next;
+    subroutine *subiter;
 
-        if (outfile) {
-            lexer->outfile = fopen(outfile, "w");
-        }
-        else {
-            lexer->outfile = stdout;
-        }
+    if (lexer->subs == NULL)
+        return;
 
+    /* set iterator to first item */
+    subiter = lexer->subs->next;
 
-        do {
-            int i;
-            fprintf(out, "\n.namespace ");
-            print_key(lexer, subiter->name_space);
+    if (outfile) {
+        lexer->outfile = fopen(outfile, "w");
+    }
+    else {
+        lexer->outfile = stdout;
+    }
 
-            fprintf(out, "\n.sub %s", subiter->info.subname);
 
-            for (i = 0; i < BIT(i); i++) {
-                if (TEST_FLAG(subiter->flags, BIT(i))) {
-                    fprintf(out, " :%s", subflag_names[i]);
-                }
+    do {
+        int i;
+        fprintf(out, "\n.namespace ");
+        print_key(lexer, subiter->name_space);
+
+        fprintf(out, "\n.sub %s", subiter->info.subname);
+
+        for (i = 0; i < BIT(i); i++) {
+            if (TEST_FLAG(subiter->flags, BIT(i))) {
+                fprintf(out, " :%s", subflag_names[i]);
             }
+        }
 
-            fprintf(out, "\n");
-            emit_pir_statement(lexer, subiter);
-            fprintf(out, ".end\n");
+        fprintf(out, "\n");
+        emit_pir_statement(lexer, subiter);
+        fprintf(out, ".end\n");
 
-            subiter = subiter->next;
-        }
-        while (subiter != lexer->subs->next);
+        subiter = subiter->next;
     }
+    while (subiter != lexer->subs->next);
+
 }
 
 
@@ -484,6 +489,9 @@
     emit_int_arg(lexer->bc, t->info->color);
 }
 
+
+
+
 /*
 
 =item C<static void
@@ -502,7 +510,54 @@
 
 static void
 build_key(lexer_state * const lexer, key * const k) {
+    /* XXX TODO
+     *
+     * who can help? :-)
+     */
+}
 
+
+
+static void
+emit_pbc_expr(lexer_state * const lexer, expression * const operand) {
+    switch (operand->type) {
+        case EXPR_CONSTANT:
+            emit_pbc_const_arg(lexer, operand->expr.c);
+            break;
+        case EXPR_TARGET:
+            emit_pbc_target_arg(lexer, operand->expr.t);
+
+            if (operand->expr.t->key)
+                emit_pbc_key(lexer, operand->expr.t->key);
+
+            break;
+        case EXPR_LABEL:
+            emit_pbc_label_arg(lexer, operand->expr.l);
+            break;
+        /*
+        case EXPR_KEY:
+            fprintf(stderr, "emit pbc isntr key arg\n");
+            break;
+        */
+        default:
+            break;
+    }
+}
+
+/*
+
+=item C<static void
+emit_pbc_key(lexer_state * const lexer, key * const k)>
+
+Emit bytecode for the key C<k>.
+
+=cut
+
+*/
+static void
+emit_pbc_key(lexer_state * const lexer, key * const k) {
+    emit_pbc_expr(lexer, k->expr);
+    /* XXX finish this. */
 }
 
 /*
@@ -522,41 +577,30 @@
 
     /* emit the opcode */
 
-    if (instr->opinfo) {
-        emit_opcode(lexer->bc, instr->opcode);
+    if (instr->opinfo == NULL)
+        return;
+
+    emit_opcode(lexer->bc, instr->opcode);
 
-        /* emit the arguments */
+    /* emit the arguments */
 
-        /* note that opinfo->op_count counts all operands plus the op itself;
-         * so substract 1 for the op itself.
+    /* note that opinfo->op_count counts all operands plus the op itself;
+     * so substract 1 for the op itself.
+     */
+    if (instr->opinfo->op_count > 1) {
+        /* operands are stored in a circular linked list; instr->operands points
+         * to the *last* operand, its next pointer points to the first operand.
          */
-        if (instr->opinfo->op_count > 1) {
-            /* operands are stored in a circular linked list; instr->operands points
-             * to the *last* operand, its next pointer points to the first operand.
-             */
-            operand = instr->operands->next;
-
-            do {
-                switch (operand->type) {
-                    case EXPR_CONSTANT:
-                        emit_pbc_const_arg(lexer, operand->expr.c);
-                        break;
-                    case EXPR_TARGET:
-                        emit_pbc_target_arg(lexer, operand->expr.t);
-                        break;
-                    case EXPR_LABEL:
-                        emit_pbc_label_arg(lexer, operand->expr.l);
-                        break;
-                    default:
-                        break;
-                }
+        operand = instr->operands->next;
 
-                operand = operand->next;
-            }
-            while (operand != instr->operands->next);
+        do {
+            emit_pbc_expr(lexer, operand);
+            operand = operand->next;
         }
+        while (operand != instr->operands->next);
     }
 
+
 }
 
 



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