[svn:parrot] r44692 - in branches/ops_pct/compilers/opsc: src/Ops src/Ops/Trans t
bacek at svn.parrot.org
bacek at svn.parrot.org
Sat Mar 6 11:48:32 UTC 2010
Author: bacek
Date: Sat Mar 6 11:48:31 2010
New Revision: 44692
URL: https://trac.parrot.org/parrot/changeset/44692
Log:
Add emiting op_lookup
Modified:
branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm
branches/ops_pct/compilers/opsc/src/Ops/Trans.pm
branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
branches/ops_pct/compilers/opsc/t/06-emitter.t
Modified: branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm Sat Mar 6 11:48:04 2010 (r44691)
+++ branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm Sat Mar 6 11:48:31 2010 (r44692)
@@ -24,7 +24,7 @@
self<base> := $base;
self<suffix> := $suffix;
- self<bs> := $base ~ $suffix;
+ self<bs> := $base ~ $suffix ~ '_';
self<include> := "parrot/oplib/$base_ops_h";
self<header> := (~%flags<dir>) ~ "include/" ~ self<include>;
@@ -94,6 +94,8 @@
self.trans.emit_source_part($fh);
+ self.trans.emit_op_lookup(self, $fh);
+
self._emit_init_func($fh);
self._emit_dymanic_lib_load($fh);
self._emit_coda($fh);
Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans.pm Sat Mar 6 11:48:04 2010 (r44691)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans.pm Sat Mar 6 11:48:31 2010 (r44692)
@@ -28,7 +28,13 @@
method emit_source_part($fh) { die('...') }
+# Default op lookup do nothing. But op_deinit referenced anyway.
+method emit_op_lookup($fh) {
+ $fh.print(q|static void hop_deinit(SHIM_INTERP) {}|);
+}
+
method init_func_init1() { '' }
method init_func_disaptch() { '' }
+
# vim: expandtab shiftwidth=4 ft=perl6:
Modified: branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm Sat Mar 6 11:48:04 2010 (r44691)
+++ branches/ops_pct/compilers/opsc/src/Ops/Trans/C.pm Sat Mar 6 11:48:31 2010 (r44692)
@@ -81,4 +81,125 @@
method emit_source_part($fh) {
}
+
+method emit_op_lookup($emitter, $fh) {
+
+ if $emitter.flags<dynamic> {
+ return;
+ }
+
+ my $hash_size := 3041;
+# my $tot := $self->{index} + scalar keys( %{ $self->{names} } );
+# if ( $hash_size < $tot * 1.2 ) {
+# print STDERR "please increase hash_size ($hash_size) in lib/Parrot/Ops2c/Utils.pm "
+# . "to a prime number > ", $tot * 1.2, "\n";
+# }
+ # Due bug in NQP do it in two passes.
+ my $res := q|
+/*
+** Op lookup function:
+*/
+
+#define OP_HASH_SIZE 3041
+
+/* we could calculate a prime somewhat bigger than
+ * n of fullnames + n of names
+ * for now this should be ok
+ *
+ * look up an op_code: at first call to op_code() a hash
+ * of short and full opcode names is created
+ * hash functions are from imcc, thanks to Melvin.
+ */
+
+
+typedef struct hop {
+ op_info_t * info;
+ struct hop *next;
+} HOP;
+static HOP **hop;
+
+static void hop_init(PARROT_INTERP);
+static size_t hash_str(const char *str);
+static void store_op(PARROT_INTERP, op_info_t *info, int full);
+
+/* XXX on changing interpreters, this should be called,
+ through a hook */
+
+static void hop_deinit(PARROT_INTERP);
+
+/*
+ * find a short or full opcode
+ * usage:
+ *
+ * interp->op_lib->op_code("set", 0)
+ * interp->op_lib->op_code("set_i_i", 1)
+ *
+ * returns >= 0 (found idx into info_table), -1 if not
+ */
+
+static size_t hash_str(const char *str) {
+ size_t key = 0;
+ const char *s = str;
+
+ while (*s) {
+ key *= 65599;
+ key += *s++;
+ }
+
+ return key;
+}
+
+static void store_op(PARROT_INTERP, op_info_t *info, int full) {
+ HOP * const p = mem_gc_allocate_zeroed_typed(interp, HOP);
+ const size_t hidx =
+ hash_str(full ? info->full_name : info->name) % OP_HASH_SIZE;
+
+ p->info = info;
+ p->next = hop[hidx];
+ hop[hidx] = p;
+}
+static int get_op(PARROT_INTERP, const char * name, int full) {
+ const HOP * p;
+ const size_t hidx = hash_str(name) % OP_HASH_SIZE;
+ if (!hop) {
+ hop = mem_gc_allocate_n_zeroed_typed(interp, OP_HASH_SIZE,HOP *);
+ hop_init(interp);
+ }
+ for (p = hop[hidx]; p; p = p->next) {
+ if(STREQ(name, full ? p->info->full_name : p->info->name))
+ return p->info - [[BS]]op_lib.op_info_table;
+ }
+ return -1;
+}
+static void hop_init(PARROT_INTERP) {
+ size_t i;
+ op_info_t * const info = [[BS]]op_lib.op_info_table;
+ /* store full names */
+ for (i = 0; i < [[BS]]op_lib.op_count; i++)
+ store_op(interp, info + i, 1);
+ /* plus one short name */
+ for (i = 0; i < [[BS]]op_lib.op_count; i++)
+ if (get_op(interp, info[i].name, 0) == -1)
+ store_op(interp, info + i, 0);
+}
+static void hop_deinit(PARROT_INTERP)
+{
+ if (hop) {
+ size_t i;
+ for (i = 0; i < OP_HASH_SIZE; i++) {
+ HOP *p = hop[i];
+ while (p) {
+ HOP * const next = p->next;
+ mem_gc_free(interp, p);
+ p = next;
+ }
+ }
+ mem_sys_free(hop);
+ hop = NULL;
+ }
+}|;
+
+ $fh.print(subst($res, /'[[' BS ']]'/, $emitter.bs));
+}
+
# vim: expandtab shiftwidth=4 ft=perl6:
Modified: branches/ops_pct/compilers/opsc/t/06-emitter.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/06-emitter.t Sat Mar 6 11:48:04 2010 (r44691)
+++ branches/ops_pct/compilers/opsc/t/06-emitter.t Sat Mar 6 11:48:31 2010 (r44692)
@@ -3,7 +3,7 @@
pir::load_bytecode("compilers/opsc/opsc.pbc");
pir::load_bytecode("nqp-settings.pbc");
-plan(11);
+plan(12);
my $trans := Ops::Trans::C.new();
@@ -56,6 +56,9 @@
ok($source ~~ /static \s int \s get_op/, 'Trans::C preamble generated');
-say($source);
+
+ok($source ~~ /static \s size_t \s hash_str/, 'Trans::C op_lookup preserved');
+
+#say($source);
# vim: expandtab shiftwidth=4 ft=perl6:
More information about the parrot-commits
mailing list