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

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

From:
kjs
Date:
December 2, 2008 10:45
Subject:
[svn:parrot] r33444 - trunk/compilers/pirc/new
Message ID:
20081202184503.AB141CB9AF@x12.develooper.com
Author: kjs
Date: Tue Dec  2 10:45:02 2008
New Revision: 33444

Modified:
   trunk/compilers/pirc/new/bcgen.c
   trunk/compilers/pirc/new/bcgen.h

Log:
[pirc] moving bctest stuff into bcgen.c.

Modified: trunk/compilers/pirc/new/bcgen.c
==============================================================================
--- trunk/compilers/pirc/new/bcgen.c	(original)
+++ trunk/compilers/pirc/new/bcgen.c	Tue Dec  2 10:45:02 2008
@@ -2,8 +2,13 @@
  * $Id$
  * Copyright (C) 2008, The Perl Foundation.
  */
-
+#include <stdio.h>
+#include <assert.h>
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+/*
 #include "bcgen.h"
+*/
 
 /* private bits of the bytecode generator */
 
@@ -13,18 +18,18 @@
     BC_STR_CONST_TYPE,
     BC_PMC_CONST_TYPE
 
-} bc_type;
+} bc_const_type;
 
 typedef union const_value {
-    INTVAL  ival;
-    NUMVAL  nval;
-    STRING *sval;
-    PMC    *pval;
+    INTVAL    ival;
+    FLOATVAL  nval;
+    STRING   *sval;
+    PMC      *pval;
 
 } const_value;
 
 typedef struct bc_const {
-    bc_type           type;  /* type of constant */
+    bc_const_type     type;  /* type of constant */
     int               index; /* index into constant table */
     const_value       value; /* this constant's value */
 
@@ -38,9 +43,253 @@
 struct bytecode {
     int          num_constants;
     bc_const    *constants;
+    PackFile    *packfile;
+    opcode_t    *opcursor;
+    Interp      *interp;
 
 };
 
+typedef struct bytecode bytecode;
+
+static bc_const * new_const(bytecode * const bc);
+
+/*
+
+=head1 FUNCTIONS
+
+=over 4
+
+=cut
+
+*/
+
+static bc_const *
+new_const(bytecode * const bc) {
+    bc_const *bcc = (bc_const *)mem_sys_allocate(sizeof (bc_const));
+    bcc->index    = bc->num_constants++;
+    bcc->next     = bc->constants;
+    bc->constants = bcc;
+    return bcc;
+}
+
+bc_const *
+add_pmc_const(bytecode * const bc, PMC * pmc) {
+    bc_const *bcc   = new_const(bc);
+    bcc->type       = BC_PMC_CONST_TYPE;
+    bcc->value.pval = pmc;
+    return bcc;
+}
+
+bc_const *
+add_string_const(bytecode * const bc, char const * const str) {
+    bc_const *bcc   = new_const(bc);
+    bcc->type       = BC_STR_CONST_TYPE;
+    bcc->value.sval = string_make(bc->interp, str, strlen(str), "ascii", PObj_constant_FLAG);
+    return bcc;
+}
+
+/*
+
+=item new_bytecode
+
+Create a new bytecode struct and return a pointer to it.
+
+=cut
+
+*/
+bytecode *
+new_bytecode(Interp *interp, char const * const filename) {
+    PMC      *self;
+    bytecode *bc      = (bytecode *)mem_sys_allocate(sizeof (bytecode));
+    int bytes         = 12;
+
+    bc->packfile      = PackFile_new(interp, 0);
+    bc->constants     = NULL;
+    bc->interp        = interp;
+    bc->num_constants = 0;
+
+    Parrot_loadbc(interp, bc->packfile);
+
+    interp->code      = PF_create_default_segs(interp, filename, 1);
+    self              = VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_INTERPRETER);
+
+    add_pmc_const(bc, self);
+
+    interp->code->base.data = (opcode_t *)mem_sys_realloc(interp->code->base.data, bytes);
+    interp->code->base.size = 3;
+
+    bc->opcursor   = (opcode_t *)interp->code->base.data;
+
+    return bc;
+}
+
+void
+emit_opcode(bytecode * const bc, opcode_t op) {
+    *bc->opcursor++ = op;
+}
+
+void
+emit_int_arg(bytecode * const bc, int intval) {
+    *bc->opcursor++ = intval;
+}
+
+void
+emit_op_by_name(bytecode * const bc, char const * const opname) {
+    int op = bc->interp->op_lib->op_code(opname, 1);
+    if (op < 0) {
+        /* error */
+        fprintf(stderr, "'%s' is not an op", opname);
+    }
+    else
+        emit_opcode(bc, op);
+}
+
+
+static void
+add_sub_pmc(bytecode * const bc, char const * const subname) {
+    Interp     *interp    = bc->interp;
+    PMC        *sub_pmc   = pmc_new(bc->interp, enum_class_Sub);
+    Parrot_sub *sub       = PMC_sub(sub_pmc);
+    bc_const   *subconst;
+
+    int i;
+    bc_const *subid       = add_string_const(bc, subname);
+
+    sub->start_offs       = 0;
+    sub->end_offs         = 3;
+    sub->namespace_name   = NULL;
+    sub->HLL_id           = CONTEXT(interp)->current_HLL;
+
+    sub->lex_info         = NULL;
+    sub->outer_sub        = NULL;
+    sub->vtable_index     = -1;
+    sub->multi_signature  = NULL;
+
+    for (i = 0; i < 4; ++i)
+        sub->n_regs_used[i] = 0;
+
+    sub->name          = subid->value.sval;
+    sub->ns_entry_name = subid->value.sval;
+    sub->subid         = subid->value.sval;
+
+    subconst = add_pmc_const(bc, sub_pmc);
+
+    Parrot_store_sub_in_namespace(bc->interp, sub_pmc);
+    /* PackFile_FixupTable_new_entry(bc->interp, subname, enum_fixup_sub, subconst->index);
+    */                                                           /* doesn't work?? */
+}
+
+static void
+emit_constants(bytecode * const bc) {
+    bc_const *iter = bc->constants;
+
+    /* allocate enough space */
+
+    fprintf(stderr, "allocating space for %d constants\n", bc->num_constants);
+    bc->interp->code->const_table->constants
+                                   = mem_allocate_n_typed(bc->num_constants, PackFile_Constant *);
+
+    /* walk the list and put all of them into the constant table. */
+    while (iter) {
+        fprintf(stderr, "constant (%d)...\n", iter->index);
+
+
+        bc->interp->code->const_table->constants[iter->index] = PackFile_Constant_new(bc->interp);
+
+        assert(bc->interp->code->const_table->constants[iter->index]);
+        switch (iter->type) {
+            /*
+            case BC_NUM_CONST_TYPE:
+                bc->interp->code->const_table->constants[iter->index]->type  = 0;;
+                bc->interp->code->const_table->constants[iter->index]->u.key = iter->value.nval;
+                break;
+                */
+            case BC_STR_CONST_TYPE:
+                bc->interp->code->const_table->constants[iter->index]->type     = PFC_STRING;
+                bc->interp->code->const_table->constants[iter->index]->u.string = iter->value.sval;
+                break;
+            case BC_PMC_CONST_TYPE:
+                bc->interp->code->const_table->constants[iter->index]->type  = PFC_PMC;
+                bc->interp->code->const_table->constants[iter->index]->u.key = iter->value.pval;
+                break;
+            /*
+            case BC_INT_CONST_TYPE:
+                break;
+            */
+            default:
+                /* error */
+                fprintf(stderr, "wrong constant type!\n");
+                break;
+        }
+        iter = iter->next;
+    }
+}
+
+/*
+
+Write the bytecode to the file C<filename>.
+
+*/
+void
+write_pbc_file(bytecode * const bc, char const * const filename) {
+    size_t    size;
+    opcode_t *packed;
+    FILE     *fp;
+    int       result;
+
+    assert(bc->interp->code->base.pf);
+
+    emit_constants(bc);
+
+    fprintf(stderr, "constants written...\n");
+    size   = PackFile_pack_size(bc->interp, bc->interp->code->base.pf) * sizeof (opcode_t);
+    packed = (opcode_t*) mem_sys_allocate(size);
+
+    PackFile_pack(bc->interp, bc->interp->code->base.pf, packed);
+
+    fp = fopen(filename, "wb");
+
+    if (fp == NULL)
+        fprintf(stderr, "Couldn't open %s\n", filename);
+
+    result = fwrite(packed, size, 1, fp);
+
+    if (result != 1)
+        fprintf(stderr, "Couldn't write %s\n", filename);
+
+    fclose(fp);
+}
+
+
+/*
+
+Test driver.
+
+*/
+int
+main(int argc, char **argv) {
+    Interp *interp = Parrot_new(NULL);
+    bytecode *bc   = new_bytecode(interp, "test.pir");
+
+
+    emit_op_by_name(bc, "print_ic");
+    emit_int_arg(bc, 42);
+    emit_op_by_name(bc, "end");
+    add_sub_pmc(bc, "main");
+
+    fprintf(stderr, "writing pbc...");
+    write_pbc_file(bc, "test.pbc");
+    fprintf(stderr, "written pbc file\n");
+}
+
+
+/*
+
+=back
+
+=cut
+
+*/
 
 /*
  * Local variables:

Modified: trunk/compilers/pirc/new/bcgen.h
==============================================================================
--- trunk/compilers/pirc/new/bcgen.h	(original)
+++ trunk/compilers/pirc/new/bcgen.h	Tue Dec  2 10:45:02 2008
@@ -6,11 +6,7 @@
 #ifndef PARROT_BCGEN_H_GUARD
 #define PARROT_BCGEN_H_GUARD
 
-/* temporary */
-#define INTVAL  int
-#define NUMVAL  double
-#define STRING  char
-#define PMC     void
+
 
 /* the type name is exported, but not its private bits */
 struct bytecode;



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