cvsuser 04/09/24 02:45:54
Modified: . PBC_COMPAT
include/parrot interpreter.h resources.h
ops core.ops ops.num
src inter_create.c inter_misc.c
t/native_pbc integer.t number.t
t/op interp.t
t/pmc nci.t
Log:
stub in extended interpinfo
* interpinfo_p function returns PMC* stuff for
* current sub, cont, object, lexpad, namespace
* invalidate existing PBCs
* disable native PBC tests
* not much functionality yet
Revision Changes Path
1.7 +1 -0 parrot/PBC_COMPAT
Index: PBC_COMPAT
===================================================================
RCS file: /cvs/public/parrot/PBC_COMPAT,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- PBC_COMPAT 29 Feb 2004 13:18:39 -0000 1.6
+++ PBC_COMPAT 24 Sep 2004 09:45:31 -0000 1.7
@@ -24,6 +24,7 @@
# please insert tab separated entries at the top of the list
+2004.09.24 leo insert interpinfo_p opcodes
2004.02.29 leo 0.1.0 release
2003.11.21 leo remove unused size fields in front of PF constants
2003.10.31 leo 0.0.13 release
1.151 +12 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.150
retrieving revision 1.151
diff -u -w -r1.150 -r1.151
--- interpreter.h 14 Aug 2004 08:30:12 -0000 1.150
+++ interpreter.h 24 Sep 2004 09:45:33 -0000 1.151
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.150 2004/08/14 08:30:12 leo Exp $
+ * $Id: interpreter.h,v 1.151 2004/09/24 09:45:33 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -147,6 +147,15 @@
currently found method */
UINTVAL recursion_depth; /* Sub call resursion depth */
int runloop_level; /* for reentering run loop */
+ /*
+ * new call scheme and introspective variables
+ */
+ PMC *current_sub; /* the Sub we are executing */
+ /*
+ * for now use a return continuation PMC
+ */
+ PMC *current_cont; /* the return continuation PMC */
+ PMC *current_object; /* current object if a method call */
} parrot_context_t;
struct _Thread_data; /* in thread.h */
@@ -310,7 +319,9 @@
struct Parrot_Interp *make_interpreter(Parrot_Interp parent, Interp_flags);
void Parrot_init(Parrot_Interp);
void Parrot_destroy(Parrot_Interp);
+
INTVAL interpinfo(struct Parrot_Interp *interpreter, INTVAL what);
+PMC* interpinfo_p(struct Parrot_Interp *interpreter, INTVAL what);
void runops(struct Parrot_Interp *, size_t offset);
void runops_int(struct Parrot_Interp *, size_t offset);
1.55 +24 -15 parrot/include/parrot/resources.h
Index: resources.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/resources.h,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -w -r1.54 -r1.55
--- resources.h 7 Sep 2004 12:18:25 -0000 1.54
+++ resources.h 24 Sep 2004 09:45:33 -0000 1.55
@@ -1,7 +1,7 @@
/* resources.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: resources.h,v 1.54 2004/09/07 12:18:25 leo Exp $
+ * $Id: resources.h,v 1.55 2004/09/24 09:45:33 leo Exp $
* Overview:
* Defines the resource allocation API
* Data Structure and Algorithms:
@@ -117,21 +117,30 @@
struct Stash *parent_stash;
};
-/* &gen_from_def(interpinfo.pasm) prefix(INTERPINFO_) */
+/* &gen_from_enum(interpinfo.pasm) prefix(INTERPINFO_) */
-#define TOTAL_MEM_ALLOC 1
-#define DOD_RUNS 2
-#define COLLECT_RUNS 3
-#define ACTIVE_PMCS 4
-#define ACTIVE_BUFFERS 5
-#define TOTAL_PMCS 6
-#define TOTAL_BUFFERS 7
-#define HEADER_ALLOCS_SINCE_COLLECT 8
-#define MEM_ALLOCS_SINCE_COLLECT 9
-#define TOTAL_COPIED 10
-#define IMPATIENT_PMCS 11
-#define LAZY_DOD_RUNS 12
-#define EXTENDED_PMCS 13
+typedef enum {
+ TOTAL_MEM_ALLOC = 1,
+ DOD_RUNS,
+ COLLECT_RUNS,
+ ACTIVE_PMCS,
+ ACTIVE_BUFFERS,
+ TOTAL_PMCS,
+ TOTAL_BUFFERS,
+ HEADER_ALLOCS_SINCE_COLLECT,
+ MEM_ALLOCS_SINCE_COLLECT,
+ TOTAL_COPIED,
+ IMPATIENT_PMCS,
+ LAZY_DOD_RUNS,
+ EXTENDED_PMCS,
+
+ /* interpinfo_p constants */
+ CURRENT_SUB,
+ CURRENT_CONT,
+ CURRENT_OBJECT,
+ CURRENT_NAMESPACE_ROOT,
+ CURRENT_LEXPAD
+} Interpinfo_enum;
/* &end_gen */
1.369 +8 -28 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.368
retrieving revision 1.369
diff -u -w -r1.368 -r1.369
--- core.ops 30 Aug 2004 12:12:32 -0000 1.368
+++ core.ops 24 Sep 2004 09:45:34 -0000 1.369
@@ -692,35 +692,10 @@
=item B<interpinfo>(out INT, in INT)
-Fetch some piece of information about the interpreter and put it in $1.
-Possible values for $2 are:
-
-=over 4
-
-=item 1 The total amount of allocatable memory allocated. This figure
-does not include memory used for headers or for the interpreter's internal
-structures.
-
-=item 2 The number of dead object detection runs performed.
-
-=item 3 The number of garbage collection runs performed.
-
-=item 4 The number of active PMCs.
-
-=item 5 The number of active buffers.
-
-=item 6 The total number of PMCs allocated.
+=item B<interpinfo>(out PMC, in INT)
-=item 7 The total number of buffers allocated.
-
-=item 8 The number of headers (PMC or buffer) that have been allocated
-since the last DOD run.
-
-=item 9 The number of new blocks of memory allocated since the last GC run.
-
-=item 10 The total amount of memory copied during garbage collections.
-
-=back
+Fetch some piece of information about the interpreter and put it in $1.
+Possible values for $2 are defined in F<runtime/parrot/include/interpinfo.pasm>.
=cut
@@ -729,6 +704,11 @@
goto NEXT();
}
+op interpinfo(out PMC, in INT) {
+ $1 = interpinfo_p(interpreter, $2);
+ goto NEXT();
+}
+
=item B<warningson>(in INT)
Turns on warnings categories. Categories already turned on will
1.40 +2 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- ops.num 26 Aug 2004 10:29:11 -0000 1.39
+++ ops.num 24 Sep 2004 09:45:34 -0000 1.40
@@ -1490,3 +1490,5 @@
fdiv_p_p_nc 1463
fdiv_p_p_p 1464
elements_i_p 1465
+interpinfo_p_i 1466
+interpinfo_p_ic 1467
1.14 +6 -1 parrot/src/inter_create.c
Index: inter_create.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_create.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- inter_create.c 7 Sep 2004 12:18:26 -0000 1.13
+++ inter_create.c 24 Sep 2004 09:45:37 -0000 1.14
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_create.c,v 1.13 2004/09/07 12:18:26 leo Exp $
+$Id: inter_create.c,v 1.14 2004/09/24 09:45:37 leo Exp $
=head1 NAME
@@ -186,6 +186,11 @@
/* A regex stack would be nice too. */
interpreter->ctx.intstack = intstack_new(interpreter);
+ /* clear context introspection vars */
+ SET_NULL_P(interpreter->ctx.current_sub, PMC*);
+ SET_NULL_P(interpreter->ctx.current_cont, PMC*);
+ SET_NULL_P(interpreter->ctx.current_object, PMC*);
+
/* Load the core op func and info tables */
interpreter->op_lib = PARROT_CORE_OPLIB_INIT(1);
interpreter->op_count = interpreter->op_lib->op_count;
1.10 +27 -1 parrot/src/inter_misc.c
Index: inter_misc.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_misc.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- inter_misc.c 9 Sep 2004 18:45:44 -0000 1.9
+++ inter_misc.c 24 Sep 2004 09:45:37 -0000 1.10
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_misc.c,v 1.9 2004/09/09 18:45:44 dan Exp $
+$Id: inter_misc.c,v 1.10 2004/09/24 09:45:37 leo Exp $
=head1 NAME
@@ -150,6 +150,9 @@
=item C<INTVAL
interpinfo(Interp *interpreter, INTVAL what)>
+=item C<PMC*
+interpinfo_p(Interp *interpreter, INTVAL what)>
+
C<what> specifies the type of information you want about the
interpreter.
@@ -222,10 +225,33 @@
case EXTENDED_PMCS:
ret = arena_base->num_extended_PMCs;
break;
+ default: /* or a warning only? */
+ internal_exception(UNIMPLEMENTED,
+ "illegal argument in interpinfo");
}
return ret;
}
+PMC*
+interpinfo_p(Interp *interpreter, INTVAL what)
+{
+ switch (what) {
+ case CURRENT_SUB:
+ return interpreter->ctx.current_sub;
+ case CURRENT_CONT:
+ return interpreter->ctx.current_cont;
+ case CURRENT_OBJECT:
+ return interpreter->ctx.current_object;
+ case CURRENT_NAMESPACE_ROOT: /* XXX */
+ return interpreter->globals->stash_hash;
+ case CURRENT_LEXPAD:
+ return scratchpad_get_current(interpreter);
+ default: /* or a warning only? */
+ internal_exception(UNIMPLEMENTED,
+ "illegal argument in interpinfo");
+ }
+ return PMCNULL;
+}
/*
1.6 +11 -2 parrot/t/native_pbc/integer.t
Index: integer.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/integer.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- integer.t 8 Mar 2004 00:19:53 -0000 1.5
+++ integer.t 24 Sep 2004 09:45:46 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: integer.t,v 1.5 2004/03/08 00:19:53 chromatic Exp $
+# $Id: integer.t,v 1.6 2004/09/24 09:45:46 leo Exp $
=head1 NAME
@@ -31,7 +31,16 @@
EOC
-use Parrot::Test tests => 4;
+use Parrot::Test;
+use Test::More;
+
+if (0) {
+ plan tests => 4;
+}
+else {
+ plan skip_all => "ongoing ops-file cleanup";
+}
+
output_is(<<CODE, '270544960', "i386 32 bit opcode_t, 32 bit intval");
# integer_1.pbc
# HEADER => [
1.22 +10 -2 parrot/t/native_pbc/number.t
Index: number.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/number.t,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- number.t 31 Jul 2004 05:18:24 -0000 1.21
+++ number.t 24 Sep 2004 09:45:46 -0000 1.22
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: number.t,v 1.21 2004/07/31 05:18:24 leo Exp $
+# $Id: number.t,v 1.22 2004/09/24 09:45:46 leo Exp $
=head1 NAME
@@ -37,7 +37,15 @@
EOC
-use Parrot::Test tests => 5;
+use Parrot::Test;
+use Test::More;
+
+if (0) {
+ plan tests => 5;
+}
+else {
+ plan skip_all => "ongoing ops-file cleanup";
+}
output_is(<<CODE, <<OUTPUT, "i386 double float 32 bit opcode_t");
# number_1.pbc
1.36 +16 -3 parrot/t/op/interp.t
Index: interp.t
===================================================================
RCS file: /cvs/public/parrot/t/op/interp.t,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -w -r1.35 -r1.36
--- interp.t 10 Jul 2004 18:45:28 -0000 1.35
+++ interp.t 24 Sep 2004 09:45:51 -0000 1.36
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: interp.t,v 1.35 2004/07/10 18:45:28 nicholas Exp $
+# $Id: interp.t,v 1.36 2004/09/24 09:45:51 leo Exp $
=head1 NAME
@@ -12,11 +12,12 @@
=head1 DESCRIPTION
-Tests the old and new styles of running the Parrot interpreter.
+Tests the old and new styles of running the Parrot interpreter and the
+C<interpinfo> opcode.
=cut
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 12;
output_is(<<'CODE', <<'OUTPUT', "runinterp - new style");
new P0, .ParrotInterpreter
@@ -263,5 +264,17 @@
from 1 interp
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "interpinfo lexpad");
+ .include "interpinfo.pasm"
+ new_pad 0
+ peek_pad P10
+ interpinfo P11, .INTERPINFO_CURRENT_LEXPAD
+ eq_addr P10, P11, ok
+ print "not "
+ok: print "ok\n"
+ end
+CODE
+ok
+OUTPUT
1;
1.51 +20 -20 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -w -r1.50 -r1.51
--- nci.t 16 Sep 2004 20:59:07 -0000 1.50
+++ nci.t 24 Sep 2004 09:45:54 -0000 1.51
@@ -1,7 +1,7 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: nci.t,v 1.50 2004/09/16 20:59:07 jrieks Exp $
+# $Id: nci.t,v 1.51 2004/09/24 09:45:54 leo Exp $
=head1 NAME
@@ -315,7 +315,7 @@
output_is(<<'CODE', <<'OUTPUT', "nci_dd - stress test");
loadlib P1, "libnci"
print "loaded\n"
- set I10, 100000
+ set I10, 10000
print "dlfunced\n"
loop:
dlfunc P0, P1, "nci_dd", "dd"
