# New Ticket Created by Steve Fink
# Please include the string: [perl #16414]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=16414 >
Here's a patch that I have been threatening to implement for a while:
it makes a PMC that serves as a wrapper around the interpreter. So
instead of
interpinfo I0, 2
you would say
new P0, .Interp
set I0, P0["COLLECT_RUNS"]
or, if you really like using mysterious numbers,
new P0, .Interp
set I0, P0[2]
works just fine too. This patch doesn't do anything that interpinfo
can't already do. The fun starts when someone starts implementing the
set_*_keyed functions. Or, even without that, it might be kinda fun
(and maybe even useful) to make
set P1, "USER_STACK"
set I0, P1
print "User stack currently has "
print I0
print " entries.\n"
work (it'll require another wrapper PMC, this time for the stack.) And
then it's just a small step to
print "You hear a rumbling, and look behind you just in\n"
print "time to see the ceiling cave in and completely block\n"
print "the entrance. You notice that another passageway\n"
print "has been revealed.\n"
new P0, .Interp
set P1, P0["CONTROL_STACK"]
set_addr I0, DRAGONCAVE
set P1[-1], I0
ret # Get out the ketchup, boys!
Anyway, what do people think? (And who wants to implement clone?)
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/34545/28254/cfe8bf/interp-pmc.patch
? include/parrot/varstacks.h
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.199
diff -p -u -r1.199 MANIFEST
--- MANIFEST 19 Aug 2002 23:14:48 -0000 1.199
+++ MANIFEST 20 Aug 2002 01:31:10 -0000
@@ -22,6 +22,7 @@ classes/coroutine.pmc
classes/csub.pmc
classes/default.pmc
classes/genclass.pl
+classes/interp.pmc
classes/intqueue.pmc
classes/key.pmc
classes/multiarray.pmc
@@ -472,6 +473,7 @@ t/op/time.t
t/op/trans.t
t/pmc/array.t
t/pmc/boolean.t
+t/pmc/interp.t
t/pmc/perlarray.t
t/pmc/perlhash.t
t/pmc/perlstring.t
Index: assemble.pl
===================================================================
RCS file: /cvs/public/parrot/assemble.pl,v
retrieving revision 1.89
diff -p -u -r1.89 assemble.pl
--- assemble.pl 19 Aug 2002 23:14:48 -0000 1.89
+++ assemble.pl 20 Aug 2002 01:31:13 -0000
@@ -174,6 +174,8 @@ sub new {
$self->{constants}{Continuation} = 12;
$self->{constants}{CSub} = 13;
$self->{constants}{MultiArray} = 14;
+ $self->{constants}{Key} = 15;
+ $self->{constants}{Interp} = 16;
$self;
}
Index: global_setup.c
===================================================================
RCS file: /cvs/public/parrot/global_setup.c,v
retrieving revision 1.34
diff -p -u -r1.34 global_setup.c
--- global_setup.c 19 Aug 2002 23:14:48 -0000 1.34
+++ global_setup.c 20 Aug 2002 01:31:13 -0000
@@ -37,6 +37,7 @@ init_world(void)
Parrot_Continuation_class_init(enum_class_Continuation);
Parrot_MultiArray_class_init(enum_class_MultiArray);
Parrot_Key_class_init(enum_class_Key);
+ Parrot_Interp_class_init(enum_class_Interp);
/* Now register the names of the PMCs */
@@ -109,6 +110,10 @@ init_world(void)
key = key_new_string(NULL, Parrot_base_vtables[enum_class_Key].name(NULL, NULL));
Parrot_base_classname_hash->vtable->set_integer_keyed(NULL,
Parrot_base_classname_hash,
key, enum_class_Key);
+
+ key = key_new_string(NULL, Parrot_base_vtables[enum_class_Interp].name(NULL,
+NULL));
+ Parrot_base_classname_hash->vtable->set_integer_keyed(NULL,
+ Parrot_base_classname_hash,
+key, enum_class_Interp);
}
Index: t/pmc/interp.t
===================================================================
RCS file: t/pmc/interp.t
diff -N t/pmc/interp.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/pmc/interp.t 20 Aug 2002 01:31:13 -0000
@@ -0,0 +1,94 @@
+#! perl -w
+
+use Parrot::Test tests => 2;
+
+output_is(<<'CODE', <<'OUTPUT', "interp info indexed lookup");
+ new P1, .Interp
+ set I0, P1[0]
+ set I0, P1[1]
+ set I0, P1[2]
+ set I0, P1[3]
+ set I0, P1[4]
+ set I0, P1[5]
+ set I0, P1[6]
+ set I0, P1[7]
+ set I0, P1[8]
+ set I0, P1[9]
+ print "Got something, who knows what\n"
+ end
+CODE
+Got something, who knows what
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "interp info string lookup");
+ new P1, .Interp
+ set I0, P1["TOTAL_MEM_ALLOC"]
+ set I1, P1[0]
+ gt I0, I1, mismatch
+ print "TOTAL_MEM_ALLOC nondecreasing\n"
+
+ set I0, P1["DOD_RUNS"]
+ set I1, P1[1]
+ gt I0, I1, mismatch
+ print "DOD_RUNS nondecreasing\n"
+
+ set I0, P1["COLLECT_RUNS"]
+ collect
+ set I1, P1[2]
+ ge I0, I1, mismatch
+ print "COLLECT_RUNS increasing\n"
+
+ set I0, P1["ACTIVE_PMCS"]
+ new P2, .Array
+ set I1, P1[3]
+ sub I1, I0
+ ne I1, 1, mismatch
+ print "ACTIVE_PMCS couting\n"
+
+ set I0, P1["ACTIVE_BUFFERS"]
+ set I1, P1[4]
+ gt I0, I1, mismatch
+ print "ACTIVE_BUFFERS nondecreasing\n"
+
+ set I0, P1["TOTAL_PMCS"]
+ set I1, P1[5]
+ print "TOTAL_PMCS ok\n"
+
+ set I0, P1["TOTAL_BUFFERS"]
+ set I1, P1[6]
+ print "TOTAL_BUFFERS ok\n"
+
+ set I0, P1["HEADER_ALLOCS_SINCE_COLLECT"]
+ set I1, P1[7]
+ print "HEADER_ALLOCS_SINCE_COLLECT ok\n"
+
+ set I0, P1["MEM_ALLOCS_SINCE_COLLECT"]
+ set I1, P1[8]
+ print "MEM_ALLOCS_SINCE_COLLECT ok\n"
+
+ set I0, P1["TOTAL_COPIED"]
+ set I1, P1[9]
+ gt I0, I1, mismatch
+ print "TOTAL_COPIED nondecreasing\n"
+
+ print "Done.\n"
+ end
+
+mismatch:
+ print "Something failed\n"
+ end
+CODE
+TOTAL_MEM_ALLOC nondecreasing
+DOD_RUNS nondecreasing
+COLLECT_RUNS increasing
+ACTIVE_PMCS counting
+ACTIVE_BUFFERS nondecreasing
+TOTAL_PMCS ok
+TOTAL_BUFFERS ok
+HEADER_ALLOCS_SINCE_COLLECT ok
+MEM_ALLOCS_SINCE_COLLECT ok
+TOTAL_COPIED nondecreasing
+Done.
+OUTPUT
+
+1;
Index: include/parrot/global_setup.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/global_setup.h,v
retrieving revision 1.12
diff -p -u -r1.12 global_setup.h
--- include/parrot/global_setup.h 19 Aug 2002 23:15:52 -0000 1.12
+++ include/parrot/global_setup.h 20 Aug 2002 01:31:13 -0000
@@ -33,6 +33,7 @@ void Parrot_Continuation_class_init(INTV
void Parrot_CSub_class_init(INTVAL);
void Parrot_MultiArray_class_init(INTVAL);
void Parrot_Key_class_init(INTVAL);
+void Parrot_Interp_class_init(INTVAL);
void init_world(void);
Index: include/parrot/parrot.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/parrot.h,v
retrieving revision 1.47
diff -p -u -r1.47 parrot.h
--- include/parrot/parrot.h 19 Aug 2002 23:15:52 -0000 1.47
+++ include/parrot/parrot.h 20 Aug 2002 01:31:14 -0000
@@ -153,7 +153,7 @@ typedef void (*funcptr_t)(void);
* turning on GC_DEBUG should help make the problem appear with smaller data
* samples by reducing various numbers, and causing DOD and allocation runs
* to occur more frequently. It does significantly reduce performance. */
-#define GC_DEBUG 0
+#define GC_DEBUG 1
#include "parrot/platform.h"
#include "parrot/global_setup.h"
Index: include/parrot/pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.38
diff -p -u -r1.38 pmc.h
--- include/parrot/pmc.h 19 Aug 2002 23:15:52 -0000 1.38
+++ include/parrot/pmc.h 20 Aug 2002 01:31:14 -0000
@@ -30,6 +30,7 @@ enum {
enum_class_CSub,
enum_class_MultiArray,
enum_class_Key,
+ enum_class_Interp,
enum_class_max = 100
};
VAR_SCOPE VTABLE Parrot_base_vtables[enum_class_max];
