Skip to content
Browse files

merge the op_pmcs branch. This bumps PBC_COMPAT, which is going to re…

…quire a realclean after updating. Also, I haven't regenerated the test PBCs yet, so the packfile tests are failing

git-svn-id: https://svn.parrot.org/parrot/trunk@44047 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
2 parents 0c3ba35 + 787c405 commit 50d61460a8f65a5babebf63f06e441da819affcb @Whiteknight Whiteknight committed
Showing with 185 additions and 1 deletion.
  1. +1 −0 PBC_COMPAT
  2. +67 −0 src/pmc/opcode.pmc
  3. +54 −0 src/pmc/oplib.pmc
  4. +3 −0 src/pmc/pmc.num
  5. +29 −0 t/pmc/opcode.t
  6. +30 −0 t/pmc/oplib.t
  7. +1 −1 t/pmc/pmc.t
View
1 PBC_COMPAT
@@ -27,6 +27,7 @@
# please insert tab separated entries at the top of the list
+6.3 2010.02.16 whiteknight Add OpLib and Opcode PMCs
6.2 2010.01.31 cotto serialization-related changes to ParrotInterpreter
6.1 2010.01.30 whiteknight remove Array PMC
6.0 2010.01.19 chromatic released 2.0.0
View
67 src/pmc/opcode.pmc
@@ -0,0 +1,67 @@
+#include "parrot/parrot.h"
+
+pmclass Opcode auto_attrs {
+ ATTR op_info_t *info;
+ ATTR INTVAL op_number;
+ ATTR STRING *full_name_cache;
+
+ VTABLE void init() {
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Opcode must be created from OpLib.");
+ }
+
+ VTABLE void mark() {
+ Parrot_Opcode_attributes * const attrs = PARROT_OPCODE(SELF);
+ if (attrs->full_name_cache)
+ Parrot_gc_mark_STRING_alive(INTERP, attrs->full_name_cache);
+ }
+
+ VTABLE void set_pointer(void *i) {
+ Parrot_Opcode_attributes * const attrs = PARROT_OPCODE(SELF);
+ if (attrs->info)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Opcode has already been initialized");
+ attrs->info = (op_info_t *)i;
+ }
+
+ VTABLE void set_string_native(STRING *name) {
+ const char * const cstr = Parrot_str_to_cstring(INTERP, name);
+ const INTVAL num = INTERP->op_lib->op_code(cstr, 1);
+ Parrot_str_free_cstring(cstr);
+ if (num == -1)
+ Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
+ "Opcode: Opcode %S not found", name);
+ VTABLE_set_integer_native(INTERP, SELF, num);
+ }
+
+ VTABLE INTVAL get_integer() {
+ Parrot_Opcode_attributes * const attrs = PARROT_OPCODE(SELF);
+ if (!attrs->info)
+ return -1;
+ return attrs->op_number;
+ }
+
+ VTABLE void set_integer_native(INTVAL value) {
+ const INTVAL opcount = INTERP->op_lib->op_count;
+ Parrot_Opcode_attributes * const attrs = PARROT_OPCODE(SELF);
+ if (attrs->info)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Opcode has already been initialized");
+ if (value >= opcount || value < 0)
+ Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
+ "Opcode: Opcode index %d out of bounds", value);
+ attrs->info = &(INTERP->op_info_table[value]);
+ attrs->op_number = value;
+ }
+
+ VTABLE STRING* get_string() {
+ Parrot_Opcode_attributes * const attrs = PARROT_OPCODE(SELF);
+ if (attrs->full_name_cache == NULL) {
+ const char * const name = attrs->info->full_name;
+ const INTVAL len = strlen(name);
+ STRING * const newstr = Parrot_str_new(INTERP, name, len);
+ attrs->full_name_cache = newstr;
+ }
+ return attrs->full_name_cache;
+ }
+}
View
54 src/pmc/oplib.pmc
@@ -0,0 +1,54 @@
+#include "parrot/parrot.h"
+
+/* TODO: Since Opcode PMCs are essentially read-only after initialization
+ here, we should cache them. A FixedPMCArray would be okay, an
+ INTVAL->PMC HASH might be better, since it's unlike that we will
+ need to cache even a majority of the ~1300 ops. */
+static PMC *OPLIB_PMC_INSTANCE;
+pmclass OpLib {
+ void class_init() {
+ OPLIB_PMC_INSTANCE = NULL;
+ }
+
+ VTABLE void *get_pointer() {
+ return OPLIB_PMC_INSTANCE;
+ }
+
+ VTABLE void set_pointer(void *ptr) {
+ OPLIB_PMC_INSTANCE = (PMC *)ptr;
+ }
+
+ /* Look up an opnumber given the name of the op. First we look for the
+ specific name, then the more general short name. */
+ VTABLE INTVAL get_integer_keyed_str(STRING *name) {
+ const char * const cstr = Parrot_str_to_cstring(INTERP, name);
+ INTVAL num = INTERP->op_lib->op_code(cstr, 1);
+ if (num == -1)
+ num = INTERP->op_lib->op_code(cstr, 0);
+ Parrot_str_free_cstring(cstr);
+ return num;
+ }
+
+ VTABLE PMC* get_pmc_keyed_str(STRING *name) {
+ PMC * const op = pmc_new_noinit(INTERP, enum_class_Opcode);
+ VTABLE_set_string_native(INTERP, op, name);
+ PObj_custom_mark_SET(op);
+ return op;
+ }
+
+ VTABLE PMC* get_pmc_keyed(PMC *key) {
+ STRING * const strkey = VTABLE_get_string(INTERP, key);
+ return VTABLE_get_pmc_keyed_str(INTERP, SELF, strkey);
+ }
+
+ VTABLE PMC* get_pmc_keyed_int(INTVAL value) {
+ PMC * const op = pmc_new_noinit(INTERP, enum_class_Opcode);
+ VTABLE_set_integer_native(INTERP, op, value);
+ PObj_custom_mark_SET(op);
+ return op;
+ }
+
+ VTABLE INTVAL get_integer() {
+ return INTERP->op_lib->op_count;
+ }
+}
View
3 src/pmc/pmc.num
@@ -79,3 +79,6 @@ parrotobject.pmc 50
os.pmc 51
file.pmc 52
+
+oplib.pmc 53
+opcode.pmc 54
View
29 t/pmc/opcode.t
@@ -0,0 +1,29 @@
+#! parrot
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id: fixedpmcarray.t 42684 2009-11-21 13:40:19Z jkeenan $
+
+=head1 NAME
+
+t/pmc/opcode.t - Opcode PMC
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/opcode.t
+
+=cut
+
+.sub main :main
+ .include 'test_more.pir'
+ plan(1)
+ cannot_create_directly()
+.end
+
+.sub cannot_create_directly
+ push_eh cannot_create
+ $P0 = new ['Opcode']
+ ok(0, "shouldn't be able to create new opcode")
+ goto create_end
+ cannot_create:
+ ok(1)
+ create_end:
+.end
View
30 t/pmc/oplib.t
@@ -0,0 +1,30 @@
+#! parrot
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id: fixedpmcarray.t 42684 2009-11-21 13:40:19Z jkeenan $
+
+=head1 NAME
+
+t/pmc/oplib.t - OpLib PMC
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/oplib.t
+
+=cut
+
+.sub main :main
+ .include 'test_more.pir'
+ plan(1)
+ get_singleton()
+.end
+
+.sub get_singleton
+ $P0 = new ['OpLib']
+ $I0 = isnull $P0
+ is($I0, 0)
+
+ # TODO: How to test that this is actually a singleton?
+ #$P1 = new ['OpLib']
+ #is($P0, $P1)
+.end
+
View
2 t/pmc/pmc.t
@@ -51,7 +51,7 @@ OUTPUT
my $checkTypes;
my %types_we_cant_test
= map { $_ => 1; } ( # These require initializers.
- qw(default Null Iterator ArrayIterator HashIterator StringIterator OrderedHashIterator Enumerate ParrotObject ParrotThread BigInt LexInfo LexPad Object Handle),
+ qw(default Null Iterator ArrayIterator HashIterator StringIterator OrderedHashIterator Enumerate ParrotObject ParrotThread BigInt LexInfo LexPad Object Handle Opcode),
# Instances of these appear to have other types.
qw(PMCProxy Class) );

0 comments on commit 50d6146

Please sign in to comment.
Something went wrong with that request. Please try again.