James --
> We're going to have to think about assigning static opcode numbers,
> instead of the current order-defined. For one thing, we're looking at
> perpetual bytecode compatablity (no?). This isn't really a Big Deal, but we
> need to:
> 1) Define an ordering on things like open(i, s|sc, i|ic, i|ic).
> 2) Define the notation for setting the opcode number in the .ops file.
> 3) Define what the correct behavor is for when you have holes in the opcode
> numbering.
None of these are issues with the approach I've been working on /
advocating. I'm hoping we can avoid these altogether.
Let me try to illustrate what I'm thinking a little more clearly. The
program:
.use core
set I0, 5
set I1, 37
add I2, I0, I1
print I2
print "\n"
end
would have an opcode_table in the packfile:
5 # Number of opcodes
core, set_i_ic # Opcode 0
core, add_i_i_i # Opcode 1
core, print_i # Opcode 2
core, print_sc # Opcode 3
core, end # Opcode 4
NOTE: This is a logical view. The constant table would be:
7 # Number of constants
"\n" # Constant 0, STRING
"core" # Constant 1, STRING
"set_i_ic" # Constant 2, STRING
"add_i_i_i" # Constant 3, STRING
"print_i" # Constant 4, STRING
"print_sc" # Constant 5, STRING
"end" # Constant 6, STRING
Which means the opcode_table would look more like this:
5
1, 2
1, 3
1, 4
1, 5
1, 6
(nice and compact). So, the byte code would look like this:
0, 0, 5
0, 1, 37
1, 2, 0, 1
2, 2
3, 0
4
I like this because it is very flexible and compact. Its easy to
imagine how this would work with multiple oplibs, again only
paying the cost for the ops *used* not the total number of ops
in the oplibs.
Oplibs are loaded in the interpreter by (the equivalent of)
dlopen() and dlsym() calls to get the init function, which
returns the pointer to the oplib structure, which contains
pointers to the opfunc and opinfo arrays. Since we do lookups
by name, these can be indexed by name (and in fact if we want
to be really clever, we should be able to emit code via ops2c.pl
that lays out a binary search tree or whatever right in the
file). Then, we construct the custom opfunc and opinfo tables
for a program by using its opcode table info to go get the
struct and function pointers and put them together. We don't
pay this cost at run time, but we do pay it at load time.
The fortunate thing is that small programs pay a small cost
and large programs pay a cost proportional to their complexity
(assuming number of oplibs and number of ops used is a measure
of complexity). This sounds appropriate to me.
I have some parts of this working today, including the beginnings
of the opcode_table addition to the packfile. The dynamic loading
of the core oplib (only that one for now) is working totally fine.
I haven't spent any time working on the code to handle multiple
oplibs and optable merging yet. If you want to work together on
this stuff, we could figure out a way to split things up.
I've attached a patch for my current work-in-progress, which is
actually broken right now (I've got family here from out of town
so I can't dig in and find the problem right now). But, you can
use it to see the current state of my thinking (just use it in
a fresh sandbox, please). It was working fine a while ago, but
the new opcode_table stuff is in its *very* early stages of
coding, and there are still lots of holes left. Anyway, check it
out, but please be kind given that it isn't intended to work
yet... :) I've also attached a version of the patch from
2001-10-20 (which I think I posted once before) that worked
at the time. That one only does dynamic loading, though, and
doesn't have the starter code for the opcode_table segment of
the packfile.
Of course, if we don't go this way, then you are right about the
issues. :)
Regards,
-- Gregor
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.35
diff -a -u -r1.35 Makefile.in
--- Makefile.in 2001/10/18 11:33:47 1.35
+++ Makefile.in 2001/10/20 20:08:26
@@ -6,13 +6,15 @@
H_FILES = $(INC)/config.h $(INC)/exceptions.h $(INC)/io.h $(INC)/op.h \
$(INC)/register.h $(INC)/string.h $(INC)/events.h $(INC)/interpreter.h \
$(INC)/memory.h $(INC)/parrot.h $(INC)/stacks.h $(INC)/packfile.h \
-$(INC)/global_setup.h $(INC)/vtable.h $(INC)/oplib/core_ops.h \
-$(INC)/runops_cores.h $(INC)/trace.h $(INC)/oplib/vtable_ops.h
+$(INC)/global_setup.h $(INC)/vtable.h \
+$(INC)/runops_cores.h $(INC)/trace.h
+STRING_OBJS=string$(O) strnative$(O) strutf8$(O) strutf16$(O) strutf32$(O) \
+transcode$(O)
+
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) \
-core_ops$(O) memory$(O) packfile$(O) stacks$(O) string$(O) strnative$(O) \
-strutf8$(O) strutf16$(O) strutf32$(O) transcode$(O) runops_cores$(O) \
-trace$(O) vtable_ops$(O)
+memory$(O) packfile$(O) stacks$(O) runops_cores$(O) \
+trace$(O) $(STRING_OBJS)
#DO NOT ADD C COMPILER FLAGS HERE
#Add them in Configure.pl--look for the
@@ -38,9 +40,18 @@
libparrot.so: $(O_FILES)
$(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
+
+libcore_ops.so: core_ops$(O)
+ $(CC) -shared -o $@ core_ops$(O)
+
+libvtable_ops.so: vtable_ops$(O)
+ $(CC) -shared -o $@ vtable_ops$(O)
+
+libparrot_string.so: $(STRING_OBJS)
+ $(CC) -shared -o $@ $(STRING_OBJS)
-$(TEST_PROG): test_main$(O) $(O_FILES) Parrot/OpLib/core.pm
- $(CC) $(CFLAGS) -o $(TEST_PROG) $(O_FILES) test_main$(O) $(C_LIBS)
+$(TEST_PROG): test_main$(O) $(O_FILES) Parrot/OpLib/core.pm libcore_ops.so
+ $(CC) -rdynamic $(CFLAGS) -o $(TEST_PROG) $(O_FILES) test_main$(O) $(C_LIBS)
+-ldl
$(PDUMP): pdump$(O) packfile$(O) memory$(O) global_setup$(O) string$(O) strnative$(O)
strutf8$(O) strutf16$(O) strutf32$(O) transcode$(O)
$(CC) $(CFLAGS) -o $(PDUMP) pdump$(O) packfile$(O) memory$(O) global_setup$(O)
string$(O) strnative$(O) strutf8$(O) strutf16$(O) strutf32$(O) transcode$(O) $(C_LIBS)
@@ -119,6 +130,7 @@
$(RM_F) examples/assembly/mops$(EXE) examples/assembly/mops.c
$(RM_F) examples/assembly/mops$(O) examples/assembly/mops.pbc
$(RM_F) Parrot/OpLib/core.pm
+ $(RM_F) libcore_ops.so libvtable_ops.so
cd docs; make clean
test: $(TEST_PROG) assemble.pl .test_dummy
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.32
diff -a -u -r1.32 interpreter.c
--- interpreter.c 2001/10/18 01:15:11 1.32
+++ interpreter.c 2001/10/20 20:08:26
@@ -12,10 +12,15 @@
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
-#include "parrot/oplib/core_ops.h"
+/* #include "parrot/oplib/core_ops.h" */
#include "parrot/runops_cores.h"
+#include "parrot/op.h"
+#include <dlfcn.h>
+#define OP_LIB "core_ops"
+
+
/*=for api interpreter check_fingerprint
* TODO: Not really part of the API, but here's the docs.
* Check the bytecode's opcode table fingerprint.
@@ -100,10 +105,10 @@
int i;
if (interpreter->profile == NULL) {
- interpreter->profile = (INTVAL *)mem_sys_allocate(core_numops *
sizeof(INTVAL));
+ interpreter->profile = (INTVAL
+*)mem_sys_allocate(interpreter->op_count * sizeof(INTVAL));
}
- for (i = 0; i < core_numops; i++) {
+ for (i = 0; i < interpreter->op_count; i++) {
interpreter->profile[i] = 0;
}
}
@@ -117,7 +122,10 @@
*/
struct Parrot_Interp *
make_interpreter() {
- struct Parrot_Interp *interpreter;
+ struct Parrot_Interp * interpreter;
+ void * oplib_handle;
+ op_lib_t * (*op_lib_init)(void);
+
/* Get an empty interpreter from system memory */
interpreter = mem_sys_allocate((INTVAL)sizeof(struct Parrot_Interp));
/* Set up the memory allocation system */
@@ -179,10 +187,33 @@
/* Need an empty stash */
interpreter->perl_stash = mem_allocate_new_stash();
- /* Load the core op func and info tables */
+ /* Load the oplib */
+
+ oplib_handle = dlopen("libcore_ops.so", RTLD_LAZY);
+ if (oplib_handle == NULL) {
+ fprintf(stderr, "parrot: Unable to open 'libcore_ops.so' library: %s.\n",
+dlerror());
+ exit(1);
+ }
+
+ op_lib_init = dlsym(oplib_handle, "op_lib_init");
+
+ if (op_lib_init == NULL) {
+ fprintf(stderr, "parrot: Unable to locate 'op_lib_init' member: %s.\n",
+dlerror());
+ dlclose(oplib_handle);
+ exit(1);
+ }
+
+ interpreter->op_lib = (*op_lib_init)();
+
+ if (interpreter->op_lib == NULL) {
+ fprintf(stderr, "parrot: Failed to initialize op lib!\n");
+ dlclose(oplib_handle);
+ exit(1);
+ }
- interpreter->opcode_funcs = core_opfunc;
- interpreter->opcode_info = core_opinfo;
+ interpreter->op_count = interpreter->op_lib->op_count;
+ interpreter->op_info = interpreter->op_lib->op_info;
+ interpreter->op_func = interpreter->op_lib->op_func;
/* In case the I/O system needs something */
Init_IO(interpreter);
Index: ops2c.pl
===================================================================
RCS file: /home/perlcvs/parrot/ops2c.pl,v
retrieving revision 1.3
diff -a -u -r1.3 ops2c.pl
--- ops2c.pl 2001/10/18 00:21:03 1.3
+++ ops2c.pl 2001/10/20 20:08:26
@@ -73,12 +73,10 @@
print HEADER $preamble;
print HEADER <<END_C;
#include "parrot/parrot.h"
+#include "parrot/oplib.h"
-extern INTVAL ${base}_numops;
+/* Do we really need this header file anymore? */
-extern op_func_t ${base}_opfunc[$num_entries];
-extern op_info_t ${base}_opinfo[$num_entries];
-
END_C
print SOURCE $preamble;
@@ -91,13 +89,11 @@
print SOURCE <<END_C;
-INTVAL ${base}_numops = $num_ops;
-
/*
** Op Function Table:
*/
-op_func_t ${base}_opfunc[$num_entries] = {
+op_func_t op_func[$num_entries] = {
END_C
@@ -150,7 +146,7 @@
** Op Info Table:
*/
-op_info_t ${base}_opinfo[$num_entries] = {
+op_info_t op_info[$num_entries] = {
END_C
$index = 0;
@@ -181,6 +177,23 @@
print SOURCE <<END_C;
};
+
+
+/*
+** op lib descriptor
+*/
+
+op_lib_t op_lib = {
+ "$base",
+ $num_ops,
+ op_info,
+ op_func
+};
+
+
+op_lib_t * op_lib_init(void) {
+ return &op_lib;
+}
END_C
Index: test_main.c
===================================================================
RCS file: /home/perlcvs/parrot/test_main.c,v
retrieving revision 1.17
diff -a -u -r1.17 test_main.c
--- test_main.c 2001/10/14 23:47:39 1.17
+++ test_main.c 2001/10/20 20:08:26
@@ -12,8 +12,6 @@
#include "parrot/parrot.h"
-#include "parrot/oplib/core_ops.h"
-
int
main(int argc, char **argv) {
int i;
@@ -167,12 +165,12 @@
printf(" CODE OP FULL NAME CALLS\n");
printf(" ----- ------------ ------------\n");
- for (i = 0; i < core_numops; i++) {
+ for (i = 0; i < interpreter->op_count; i++) {
if(interpreter->profile[i] > 0) {
op_count++;
call_count += interpreter->profile[i];
- printf(" %5d %-12s %12d\n", i, core_opinfo[i].full_name,
+ printf(" %5d %-12s %12d\n", i,
+interpreter->op_info[i].full_name,
interpreter->profile[i]);
}
Index: trace.c
===================================================================
RCS file: /home/perlcvs/parrot/trace.c,v
retrieving revision 1.1
diff -a -u -r1.1 trace.c
--- trace.c 2001/10/18 01:15:11 1.1
+++ trace.c 2001/10/20 20:08:26
@@ -23,13 +23,13 @@
INTVAL i;
fprintf(stderr, "PC=%ld; OP=%ld (%s)", (long)(pc - code_start), *pc,
- interpreter->opcode_info[*pc].full_name);
+ interpreter->op_info[*pc].full_name);
- if (interpreter->opcode_info[*pc].arg_count > 1) {
+ if (interpreter->op_info[*pc].arg_count > 1) {
fprintf(stderr, "; ARGS=(");
- for(i = 1; i < interpreter->opcode_info[*pc].arg_count; i++) {
+ for(i = 1; i < interpreter->op_info[*pc].arg_count; i++) {
if (i > 1) { fprintf(stderr, ", "); }
- switch(interpreter->opcode_info[*pc].types[i]) {
+ switch(interpreter->op_info[*pc].types[i]) {
case PARROT_ARG_IC:
fprintf(stderr, "%ld", (long) *(pc + i));
break;
Index: include/parrot/interp_guts.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interp_guts.h,v
retrieving revision 1.1
diff -a -u -r1.1 interp_guts.h
--- include/parrot/interp_guts.h 2001/10/14 00:43:50 1.1
+++ include/parrot/interp_guts.h 2001/10/20 20:08:26
@@ -5,7 +5,7 @@
#ifndef INTERP_GUTS_H
#define INTERP_GUTS_H
-#define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+#define DO_OP(PC,INTERP) PC = ((INTERP->op_func)[*PC])(PC,INTERP);
#endif /* INTERP_GUTS_H */
Index: include/parrot/interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.12
diff -a -u -r1.12 interpreter.h
--- include/parrot/interpreter.h 2001/10/18 01:15:11 1.12
+++ include/parrot/interpreter.h 2001/10/20 20:08:26
@@ -16,6 +16,7 @@
#include "parrot/parrot.h"
#include "parrot/op.h"
+#include "parrot/oplib.h"
struct Parrot_Interp {
struct IReg *int_reg; /* Current top of int reg stack */
@@ -33,8 +34,11 @@
struct Arenas *arena_base; /* Pointer to this */
/* interpreter's arena */
- op_info_t * opcode_info; /* Opcode info table (name, nargs, arg
types) */
- opcode_t *(**opcode_funcs)(); /* Opcode function table */
+ op_lib_t * op_lib; /* The opcode library */
+ INTVAL op_count; /* The number of opcodes */
+ op_info_t * op_info; /* Opcode info table (name, nargs, arg
+types) */
+ opcode_t *(**op_func)(); /* Opcode function table */
+
STRING_FUNCS *(**string_funcs)(); /* String function table */
INTVAL flags; /* Various interpreter flags
that signal that runops
Index: include/parrot/oplib.h
===================================================================
RCS file: oplib.h
diff -N oplib.h
--- /dev/null Sat Oct 20 04:18:21 2001
+++ oplib.h Sat Oct 20 13:08:26 2001
@@ -0,0 +1,42 @@
+/* oplib.h
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: $
+ * Overview:
+ * Header file for op libraries.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#if !defined(PARROT_OPLIB_H_GUARD)
+#define PARROT_OPLIB_H_GUARD
+
+#include "parrot/config.h"
+#include "parrot/op.h"
+
+
+/*
+** op_lib_t
+*/
+
+typedef struct {
+ char * name;
+ INTVAL op_count;
+ op_info_t * op_info;
+ op_func_t * op_func;
+} op_lib_t;
+
+
+#endif
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
? mops.pbc
? t/op/basic3.pasm
? t/op/basic2.out
? t/op/basic1.pbc
? t/op/basic4.pasm
? t/op/basic3.out
? t/op/basic1.out
? t/op/basic2.pbc
? t/op/basic1.pasm
? t/op/basic3.pbc
? t/op/basic4.out
? t/op/basic2.pasm
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.43
diff -a -u -r1.43 Makefile.in
--- Makefile.in 2001/11/02 12:11:15 1.43
+++ Makefile.in 2001/11/04 02:34:22
@@ -6,12 +6,15 @@
H_FILES = $(INC)/config.h $(INC)/exceptions.h $(INC)/io.h $(INC)/op.h \
$(INC)/register.h $(INC)/string.h $(INC)/events.h $(INC)/interpreter.h \
$(INC)/memory.h $(INC)/parrot.h $(INC)/stacks.h $(INC)/packfile.h \
-$(INC)/global_setup.h $(INC)/vtable.h $(INC)/oplib/core_ops.h \
+$(INC)/global_setup.h $(INC)/vtable.h \
$(INC)/runops_cores.h $(INC)/trace.h $(INC)/oplib/vtable_ops.h \
$(INC)/pmc.h $(INC)/resources.h $(INC)/platform.h
+STRING_OBJS=string$(O) strnative$(O) strutf8$(O) strutf16$(O) strutf32$(O) \
+transcode$(O)
+
O_FILES = global_setup$(O) interpreter$(O) parrot$(O) register$(O) \
-core_ops$(O) memory$(O) packfile$(O) stacks$(O) string$(O) encoding$(O) \
+memory$(O) packfile$(O) stacks$(O) string$(O) encoding$(O) \
chartype$(O) runops_cores$(O) trace$(O) vtable_ops$(O) classes/intclass$(O) \
encodings/singlebyte$(O) encodings/utf8$(O) encodings/utf16$(O) \
encodings/utf32$(O) chartypes/unicode$(O) chartypes/usascii$(O) resources$(O) \
@@ -33,7 +36,7 @@
.c$(O):
$(CC) $(CFLAGS) ${ld_out}$@ -c $<
-all : $(TEST_PROG) $(PDUMP) examples/assembly/mops${exe}
+all : $(TEST_PROG) examples/assembly/mops${exe}
#XXX This target is not portable to Win32
@@ -41,9 +44,18 @@
libparrot.so: $(O_FILES)
$(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
+
+libcore_ops.so: core_ops$(O)
+ $(CC) -shared -o $@ core_ops$(O)
+
+libvtable_ops.so: vtable_ops$(O)
+ $(CC) -shared -o $@ vtable_ops$(O)
+
+libparrot_string.so: $(STRING_OBJS)
+ $(CC) -shared -o $@ $(STRING_OBJS)
-$(TEST_PROG): test_main$(O) $(O_FILES) Parrot/OpLib/core.pm
- $(CC) $(CFLAGS) -o $(TEST_PROG) $(O_FILES) test_main$(O) $(C_LIBS)
+$(TEST_PROG): test_main$(O) $(O_FILES) Parrot/OpLib/core.pm libcore_ops.so
+Parrot/OpLib/vtable.pm libvtable_ops.so
+ $(CC) -rdynamic $(CFLAGS) -o $(TEST_PROG) $(O_FILES) test_main$(O) $(C_LIBS)
+-ldl
$(PDUMP): pdump$(O) $(O_FILES)
$(CC) $(CFLAGS) -o $(PDUMP) $(O_FILES) pdump$(O) $(C_LIBS)
@@ -57,7 +69,7 @@
$(PERL) ops2pm.pl core.ops
Parrot/OpLib/vtable.pm: vtable.ops ops2pm.pl
- $(PERL) ops2pm.pl vtabls.ops
+ $(PERL) ops2pm.pl vtable.ops
examples/assembly/mops.c: examples/assembly/mops.pbc pbc2c.pl
$(PERL) pbc2c.pl examples/assembly/mops.pbc > examples/assembly/mops.c
@@ -138,6 +150,7 @@
$(RM_F) examples/assembly/mops$(EXE) examples/assembly/mops.c
$(RM_F) examples/assembly/mops$(O) examples/assembly/mops.pbc
$(RM_F) Parrot/OpLib/core.pm
+ $(RM_F) libcore_ops.so libvtable_ops.so
cd docs; make clean
distclean:
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.33
diff -a -u -r1.33 interpreter.c
--- interpreter.c 2001/10/26 18:58:02 1.33
+++ interpreter.c 2001/11/04 02:34:22
@@ -12,10 +12,15 @@
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
-#include "parrot/oplib/core_ops.h"
+/* #include "parrot/oplib/core_ops.h" */
#include "parrot/runops_cores.h"
+#include "parrot/op.h"
+#include <dlfcn.h>
+#define OP_LIB "core_ops"
+
+
/*=for api interpreter check_fingerprint
* TODO: Not really part of the API, but here's the docs.
* Check the bytecode's opcode table fingerprint.
@@ -100,10 +105,10 @@
int i;
if (interpreter->profile == NULL) {
- interpreter->profile = (INTVAL *)mem_sys_allocate(core_numops *
sizeof(INTVAL));
+ interpreter->profile = (INTVAL
+*)mem_sys_allocate(interpreter->op_count * sizeof(INTVAL));
}
- for (i = 0; i < core_numops; i++) {
+ for (i = 0; i < interpreter->op_count; i++) {
interpreter->profile[i] = 0;
}
}
@@ -117,7 +122,10 @@
*/
struct Parrot_Interp *
make_interpreter() {
- struct Parrot_Interp *interpreter;
+ struct Parrot_Interp * interpreter;
+ void * oplib_handle;
+ op_lib_t * (*op_lib_init)(void);
+
/* Get an empty interpreter from system memory */
interpreter = mem_sys_allocate((INTVAL)sizeof(struct Parrot_Interp));
/* Set up the memory allocation system */
@@ -188,10 +196,33 @@
/* Need an empty stash */
interpreter->perl_stash = mem_allocate_new_stash();
- /* Load the core op func and info tables */
+ /* Load the oplib */
+
+ oplib_handle = dlopen("libcore_ops.so", RTLD_LAZY);
+ if (oplib_handle == NULL) {
+ fprintf(stderr, "parrot: Unable to open 'libcore_ops.so' library: %s.\n",
+dlerror());
+ exit(1);
+ }
+
+ op_lib_init = dlsym(oplib_handle, "op_lib_init");
+
+ if (op_lib_init == NULL) {
+ fprintf(stderr, "parrot: Unable to locate 'op_lib_init' member: %s.\n",
+dlerror());
+ dlclose(oplib_handle);
+ exit(1);
+ }
+
+ interpreter->op_lib = (*op_lib_init)();
+
+ if (interpreter->op_lib == NULL) {
+ fprintf(stderr, "parrot: Failed to initialize op lib!\n");
+ dlclose(oplib_handle);
+ exit(1);
+ }
- interpreter->opcode_funcs = core_opfunc;
- interpreter->opcode_info = core_opinfo;
+ interpreter->op_count = interpreter->op_lib->op_count;
+ interpreter->op_info = interpreter->op_lib->op_info;
+ interpreter->op_func = interpreter->op_lib->op_func;
/* In case the I/O system needs something */
Init_IO(interpreter);
Index: ops2c.pl
===================================================================
RCS file: /home/perlcvs/parrot/ops2c.pl,v
retrieving revision 1.3
diff -a -u -r1.3 ops2c.pl
--- ops2c.pl 2001/10/18 00:21:03 1.3
+++ ops2c.pl 2001/11/04 02:34:22
@@ -73,12 +73,10 @@
print HEADER $preamble;
print HEADER <<END_C;
#include "parrot/parrot.h"
+#include "parrot/oplib.h"
-extern INTVAL ${base}_numops;
+/* Do we really need this header file anymore? */
-extern op_func_t ${base}_opfunc[$num_entries];
-extern op_info_t ${base}_opinfo[$num_entries];
-
END_C
print SOURCE $preamble;
@@ -91,13 +89,11 @@
print SOURCE <<END_C;
-INTVAL ${base}_numops = $num_ops;
-
/*
** Op Function Table:
*/
-op_func_t ${base}_opfunc[$num_entries] = {
+op_func_t op_func[$num_entries] = {
END_C
@@ -150,7 +146,7 @@
** Op Info Table:
*/
-op_info_t ${base}_opinfo[$num_entries] = {
+op_info_t op_info[$num_entries] = {
END_C
$index = 0;
@@ -181,6 +177,23 @@
print SOURCE <<END_C;
};
+
+
+/*
+** op lib descriptor
+*/
+
+op_lib_t op_lib = {
+ "$base",
+ $num_ops,
+ op_info,
+ op_func
+};
+
+
+op_lib_t * op_lib_init(void) {
+ return &op_lib;
+}
END_C
Index: packfile.c
===================================================================
RCS file: /home/perlcvs/parrot/packfile.c,v
retrieving revision 1.15
diff -a -u -r1.15 packfile.c
--- packfile.c 2001/10/31 22:51:31 1.15
+++ packfile.c 2001/11/04 02:34:22
@@ -391,10 +391,41 @@
self->byte_code_size = 0;
return 0;
}
-
+
mem_sys_memcopy(self->byte_code, cursor, self->byte_code_size);
}
+ /*
+ ** Unpack the (optional) Opcode Table Segment:
+ */
+
+ if (cursor - packed == packed_size) {
+ self->opcode_table = NULL /* TODO: Clone core op table */;
+ return 1;
+ }
+
+ op_ptr = (opcode_t *)cursor;
+ segment_size = *op_ptr;
+ cursor += sizeof(opcode_t);
+
+#if TRACE_PACKFILE
+ printf("PackFile_unpack(): Unpacking %ld bytes for opcode table...\n",
+segment_size);
+#endif
+
+ if (segment_size % sizeof(opcode_t)) {
+ fprintf(stderr, "PackFile_unpack: Illegal opcode table segment size %d (must
+be multiple of %d)!\n",
+ segment_size, sizeof(opcode_t));
+ return 0;
+ }
+
+ if (!PackFile_OpcodeTable_unpack(interpreter, self->opcode_table, cursor,
+segment_size)) {
+ fprintf(stderr, "PackFile_unpack: Error reading opcode table segment!\n");
+ return 0;
+ }
+
+ cursor += segment_size;
+
+
return 1;
}
@@ -1739,6 +1770,337 @@
=cut
*/
+
+
+/******************************************************************************
+
+=head2 PackFile Opcode Table Structure Functions
+
+=over 4
+
+=cut
+
+******************************************************************************
+
+
+/***************************************
+
+=item new
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+struct PackFile_OpcodeTable *
+PackFile_OpcodeTable_new(void) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item DELETE
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_OpcodeTable_DELETE(struct PackFile_OpcodeTable * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item clear
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_OpcodeTable_clear(struct PackFile_OpcodeTable * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item get_opcode_count
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+opcode_t
+PackFile_OpcodeTable_get_opcode_count(struct PackFile_OpcodeTable * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item push_opcode
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_OpcodeTable_push_opcode(struct PackFile_OpcodeTable * self, struct
+PackFile_Opcode * opcode) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item opcode
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+struct PackFile_Opcode *
+PackFile_ConstTable_opcode(struct PackFile_OpcodeTable * self, opcode_t index) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item unpack
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+opcode_t
+PackFile_OpcodeTable_unpack(struct Parrot_Interp *interpreter, struct
+PackFile_OpcodeTable * self, char * packed, opcode_t packed_size) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item pack_size
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+opcode_t
+PackFile_OpcodeTable_pack_size(struct PackFile_ConstTable * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item pack
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_OpcodeTable_pack(struct PackFile_OpcodeTable * self, char * packed) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item dump
+
+Dump the PackFile Opcode Table to standard output.
+
+=cut
+
+***************************************/
+
+void
+PackFile_OpcodeTable_dump(struct PackFile_OpcodeTable * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/*
+
+=back
+
+=cut
+
+*/
+
+
+/******************************************************************************
+
+=head2 PackFile Opcode Structure Functions
+
+=over 4
+
+=cut
+
+******************************************************************************
+
+
+/***************************************
+
+=item new
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+struct PackFile_Opcode *
+PackFile_Opcode_new(opcode_t op_lib_name, opcode_t op_full_name) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item DELETE
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_Opcode_DELETE(struct PackFile_Opcode * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item clear
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_Opcode_clear(struct PackFile_Opcode * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item unpack
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+opcode_t
+PackFile_Opcode_unpack(struct Parrot_Interp *interpreter, struct PackFile_Opcode *
+self, char * packed, opcode_t packed_size) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item pack_size
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+opcode_t
+PackFile_Opcode_pack_size(struct PackFile_Opcode * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item pack
+
+TODO: Document this.
+
+=cut
+
+***************************************/
+
+void
+PackFile_Opcode_pack(struct PackFile_Opcode * self, char * packed) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/***************************************
+
+=item dump
+
+Dump the PackFile Opcode to standard output.
+
+=cut
+
+***************************************/
+
+void
+PackFile_Opcode_dump(struct PackFile_Opcode * self) {
+ fprintf(stderr, "TODO: Unimplemented.\n");
+ exit(1);
+}
+
+
+/*
+
+=back
+
+=cut
+
+*/
+
+
/*
* Local variables:
Index: pdump.c
===================================================================
RCS file: /home/perlcvs/parrot/pdump.c,v
retrieving revision 1.5
diff -a -u -r1.5 pdump.c
--- pdump.c 2001/10/24 19:23:04 1.5
+++ pdump.c 2001/11/04 02:34:22
@@ -14,12 +14,12 @@
int
main(int argc, char **argv) {
- struct stat file_stat;
- int fd;
- char * packed;
- long packed_size;
- struct PackFile * pf;
- struct Parrot_Interp *interpreter = make_interpreter();
+ struct stat file_stat;
+ int fd;
+ char * packed;
+ long packed_size;
+ struct Parrot_Interp * interpreter;
+ struct PackFile * pf;
if (argc != 2) {
fprintf(stderr, "pdump: usage: pdump FILE\n");
@@ -35,9 +35,9 @@
printf("Can't open, error %i\n", errno);
return 1;
}
-
+
init_world();
-
+
interpreter = make_interpreter();
packed_size = file_stat.st_size;
Index: test_main.c
===================================================================
RCS file: /home/perlcvs/parrot/test_main.c,v
retrieving revision 1.18
diff -a -u -r1.18 test_main.c
--- test_main.c 2001/10/22 21:43:25 1.18
+++ test_main.c 2001/11/04 02:34:22
@@ -12,8 +12,6 @@
#include "parrot/parrot.h"
-#include "parrot/oplib/core_ops.h"
-
int
main(int argc, char **argv) {
int i;
@@ -137,12 +135,12 @@
printf(" CODE OP FULL NAME CALLS\n");
printf(" ----- ------------ ------------\n");
- for (i = 0; i < core_numops; i++) {
+ for (i = 0; i < interpreter->op_count; i++) {
if(interpreter->profile[i] > 0) {
op_count++;
call_count += interpreter->profile[i];
- printf(" %5d %-12s %12d\n", i, core_opinfo[i].full_name,
+ printf(" %5d %-12s %12d\n", i,
+interpreter->op_info[i].full_name,
interpreter->profile[i]);
}
Index: trace.c
===================================================================
RCS file: /home/perlcvs/parrot/trace.c,v
retrieving revision 1.1
diff -a -u -r1.1 trace.c
--- trace.c 2001/10/18 01:15:11 1.1
+++ trace.c 2001/11/04 02:34:22
@@ -23,13 +23,13 @@
INTVAL i;
fprintf(stderr, "PC=%ld; OP=%ld (%s)", (long)(pc - code_start), *pc,
- interpreter->opcode_info[*pc].full_name);
+ interpreter->op_info[*pc].full_name);
- if (interpreter->opcode_info[*pc].arg_count > 1) {
+ if (interpreter->op_info[*pc].arg_count > 1) {
fprintf(stderr, "; ARGS=(");
- for(i = 1; i < interpreter->opcode_info[*pc].arg_count; i++) {
+ for(i = 1; i < interpreter->op_info[*pc].arg_count; i++) {
if (i > 1) { fprintf(stderr, ", "); }
- switch(interpreter->opcode_info[*pc].types[i]) {
+ switch(interpreter->op_info[*pc].types[i]) {
case PARROT_ARG_IC:
fprintf(stderr, "%ld", (long) *(pc + i));
break;
Index: Parrot/Assembler.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/Assembler.pm,v
retrieving revision 1.13
diff -a -u -r1.13 Assembler.pm
--- Parrot/Assembler.pm 2001/11/04 00:04:08 1.13
+++ Parrot/Assembler.pm 2001/11/04 02:34:23
@@ -45,6 +45,7 @@
use Parrot::PackFile::ConstTable;
#use Parrot::PackFile::Constant;
#use Parrot::String;
+use Parrot::PackFile::OpcodeTable;
use Symbol;
use Carp;
@@ -881,20 +882,31 @@
=cut
+my $opcode_count = 0;
+my %op_assignments = ( );
+my @ op_table = ( );
+
sub find_correct_opcode {
- my ($opcode,@args) = @_;
+ my ($op_name, @args) = @_;
my ($found_op, $ambiguous) = (0,0);
my $match_level_2;
- my ($old_op) = $opcode;
+ my ($old_op) = $op_name;
my @tests;
- $opcode=lc($opcode);
+ $op_name = lc($op_name);
#
# Return immediately if the opcode is found:
#
- return $opcode if exists $opcodes{$opcode};
+ if (exists $opcodes{$op_name}) {
+ if (!exists $op_assignments{$op_name}) {
+ $op_assignments{$op_name} = { CODE => $opcode_count++, OBJECT =>
+$opcodes{$op_name} };
+ $op_table[$opcode_count - 1] = $opcodes{$op_name};
+ }
+ return $op_assignments{$op_name};
+ }
+ return $op_name if exists $opcodes{$op_name};
#
# Otherwise, scan the arguments to determine their types:
@@ -944,7 +956,7 @@
# can be any of (i n s p ic nc sc).
#
- my @grep_ops = grep($_ =~ /^$opcode(?:_(?:(?:[ins]c?)|p))+$/, keys(%opcodes));
+ my @grep_ops = grep($_ =~ /^$op_name(?:_(?:(?:[ins]c?)|p))+$/, keys(%opcodes));
foreach my $op (@grep_ops) {
push( @tests, $op ); # remember what you have examined.
@@ -979,7 +991,7 @@
if ($match == 1) {
$ambiguous = 0;
- $opcode = $op;
+ $op_name = $op;
$found_op = 1;
last;
}
@@ -992,26 +1004,31 @@
#
if ($match == 2) {
- $ambiguous = 1 if $match_level_2;
+ $ambiguous = 1 if $match_level_2;
$match_level_2 = $op if !$ambiguous;
- $opcode = $op;
- $found_op = 1;
+ $op_name = $op;
+ $found_op = 1;
}
}
- error("Ambiguous operator $old_op matches $opcode and $match_level_2\n",
+ error("Ambiguous operator $old_op matches $op_name and $match_level_2\n",
$file, $line )
if $ambiguous;
- error("No opcode $opcode ( tried " . join(', ', @tests) . ") in <$pline>",
+ error("No opcode $op_name ( tried " . join(', ', @tests) . ") in <$pline>",
$file, $line)
unless $found_op;
- log_message("substituting $opcode for $old_op"
+ log_message("substituting $op_name for $old_op"
. (scalar(@tests) ? (" ( tried " . join(', ', @tests) . ")") : ''),
$file, $line);
- return $opcode;
+ if (!exists $op_assignments{$op_name}) {
+ $op_assignments{$op_name} = { CODE => $opcode_count++, OBJECT =>
+$opcodes{$op_name} };
+ $op_table[$opcode_count - 1] = $opcodes{$op_name};
+ }
+
+ return $op_assignments{$op_name};
}
@@ -1025,24 +1042,38 @@
=cut
sub handle_operator {
- my ($code, $opcode, @args) = @_;
+ my ($asm_code, $op_name, @args) = @_;
- $opcode = lc $opcode;
+ $op_name = lc $op_name;
- if (!exists $opcodes{$opcode}) {
- $opcode = find_correct_opcode($opcode, @args);
+ my $op_full_name = $op_name;
+
+ if (!exists $opcodes{$op_name}) {
+ my $op_entry = find_correct_opcode($op_name, @args);
+ if (! defined $op_entry) {
+ error("Could not assemble op '$op_name'!");
+ }
+
+ my $op_info = $op_entry->{OBJECT};
+ my $op_code = $op_entry->{CODE};
+
+ $op_full_name = $op_info->full_name;
+
+ if (! defined $opcodes{$op_full_name}) {
+ error("Could not assemble op '$op_name'!");
+ }
}
- if (@args != scalar($opcodes{$opcode}->arg_types) - 1) {
- error("Wrong arg count for op '$opcode'--got " . scalar(@args) . " needed "
- . scalar($opcodes{$opcode}->arg_types - 1) . " in <$code>", $file, $line );
+ if (@args != scalar($opcodes{$op_full_name}->arg_types) - 1) {
+ error("Wrong arg count for op '$op_full_name'--got " . scalar(@args) . " needed "
+ . scalar($opcodes{$op_full_name}->arg_types - 1) . " in <$asm_code>", $file,
+$line );
}
- $bytecode .= pack_op($opcodes{$opcode}->code);
+ $bytecode .= pack_op($opcodes{$op_full_name}->code);
$op_pc = $pc;
$pc += sizeof('op');
- return $opcode;
+ return $op_full_name;
}
@@ -1228,7 +1259,9 @@
sub error {
my ($message, $file, $line) = @_;
- $message="Something went wrong" unless defined $message;
+ confess("\$message undefined!") unless defined $message;
+ confess("\$file undefined!") unless defined $file;
+ confess("\$line undefined!") unless defined $line;
if(defined $file and defined $line) {
warn "Error ($file:$line) $message\n";
Index: Parrot/PackFile.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/PackFile.pm,v
retrieving revision 1.10
diff -a -u -r1.10 PackFile.pm
--- Parrot/PackFile.pm 2001/10/06 01:04:47 1.10
+++ Parrot/PackFile.pm 2001/11/04 02:34:23
@@ -25,6 +25,7 @@
use Parrot::PackFile::FixupTable;
use Parrot::PackFile::ConstTable;
+use Parrot::PackFile::OpcodeTable;
use Parrot::Types;
use FileHandle;
@@ -43,10 +44,11 @@
my $class = shift;
my $self = bless {
- MAGIC => $PARROT_MAGIC,
- FIXUP => Parrot::PackFile::FixupTable->new(),
- CONST => Parrot::PackFile::ConstTable->new(),
- PROG => '',
+ MAGIC => $PARROT_MAGIC,
+ FIXUP => Parrot::PackFile::FixupTable->new(),
+ CONST => Parrot::PackFile::ConstTable->new(),
+ OPCODES => Parrot::PackFile::OpcodeTable->new(),
+ PROG => '',
}, $class;
return $self;
@@ -100,12 +102,25 @@
#
+# opcode_table()
+#
+
+sub opcode_table
+{
+ my $self = shift;
+
+ return $self->{OPCODES};
+}
+
+
+#
# unpack()
#
-# Magic: 4-byte signed integer
-# Fixup: 4-byte length N + N bytes
-# Const: 4-byte length N + N bytes
-# BCode: N bytes
+# Magic: 4-byte signed integer
+# Fixup: 4-byte length N + N bytes
+# Const: 4-byte length N + N bytes
+# BCode: 4-byte length N + N bytes
+# Opcodes: 4-byte length N + N bytes
#
sub unpack
@@ -167,22 +182,22 @@
$string = substr($string, $byte_code_length);
#
- # Report on what we found:
+ # Read the (optional) opcode table:
#
+
+ $self->{OPCODES}->clear;
-# printf " * %6d bytes magic\n", 4;
-# printf " * %6d bytes fixup segment header\n", 4;
-# printf " * %6d bytes fixup\n", length($fixup);
-# printf " * %6d bytes const segment header\n", 4;
-# printf " * %6d bytes const\n", length($const);
-# printf " * %6d bytes bcode segment header\n", 4;
-# printf " * %6d bytes bcode\n", length($byte_code);
+ return $self unless $string ne '';
-# printf "Parsed string with %d bytes of fixup, %d bytes of const and %d bytes of
prog.\n", length($fixup), length($const), length($prog);
+ my $opcodes = '';
-# my $packed = pack($template, $magic, $fixup, $const, $bcode);
+ my $opcodes_length = shift_op($string);
-# printf "Packed is %d bytes long\n", length($packed);
+ if($opcodes_length) {
+ $opcodes = unpack("a$opcodes_length", $opcodes);
+ $self->{OPCODES}->unpack($opcodes);
+ }
+ $string = substr($string, $opcodes_length);
return $self;
}
@@ -235,8 +250,9 @@
$string .= pack_op($self->magic);
- my $fixup = $self->fixup_table->pack;
- my $const = $self->const_table->pack;
+ my $fixup = $self->fixup_table->pack;
+ my $const = $self->const_table->pack;
+ my $opcodes = $self->opcode_table->pack;
$string .= pack_op(length($fixup));
$string .= $fixup;
@@ -247,6 +263,9 @@
$string .= pack_op(length($self->byte_code));
$string .= $self->byte_code;
+ $string .= pack_op(length($opcodes));
+ $string .= $opcodes;
+
return $string;
}
@@ -306,12 +325,12 @@
=head2 const_table
-Get the constant table, and instance of the L<Parrot::PackFile::ConstTable>
+Get the constant table, an instance of the L<Parrot::PackFile::ConstTable>
class.
=head2 fixup_table
-Get the fixup table, and instance of the L<Parrot::PackFile::FixupTable>
+Get the fixup table, an instance of the L<Parrot::PackFile::FixupTable>
class.
=head2 magic
@@ -322,6 +341,11 @@
Make a new instance.
+=head2 opcode_table
+
+Get the opcode table, an instance of the L<Parrot::PackFile::OpcodeTable>
+class.
+
=head2 pack
Pack the contents to a string.
@@ -365,9 +389,10 @@
| |
+----------+----------+----------+----------+
-Currently there are three segment types defined, and they must occur
-in precisely the order: FIXUP, CONSTANT TABLE, BYTE CODE. Every
-segment must be present, even if empty.
+Currently there are four segment types defined, and they must occur
+in precisely the order: FIXUP, CONSTANT TABLE, BYTE CODE, OPCODE
+TABLE. Every segment except OPCODE TABLE must be present, even if
+empty.
=head2 FIXUP SEGMENT
@@ -470,6 +495,22 @@
The number and types for each argument can be determined by
consulting Parrot::Opcode.
+
+
+=head2 OPCODE TABLE SEGMENT
+
+ 0 (relative)
+ +----------+----------+----------+----------+
+ | Opcode Count (N) |
+ +----------+----------+----------+----------+
+
+For each opcode:
+
+ +----------+----------+----------+----------+
+ | Opcode Lib Name (L) |
+ +----------+----------+----------+----------+
+ | Opcode Full Name (N) |
+ +----------+----------+----------+----------+
=head2 SOURCE CODE SEGMENT
Index: Parrot/OpLib/.cvsignore
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/OpLib/.cvsignore,v
retrieving revision 1.1
diff -a -u -r1.1 .cvsignore
--- Parrot/OpLib/.cvsignore 2001/10/14 00:43:49 1.1
+++ Parrot/OpLib/.cvsignore 2001/11/04 02:34:23
@@ -1 +1,2 @@
core.pm
+vtable.pm
Index: Parrot/PackFile/OpcodeTable.pm
===================================================================
RCS file: OpcodeTable.pm
diff -N OpcodeTable.pm
--- /dev/null Sat Nov 3 13:17:24 2001
+++ OpcodeTable.pm Sat Nov 3 18:34:23 2001
@@ -0,0 +1,205 @@
+#!/usr/bin/perl -w
+#
+# OpcodeTable.pm
+#
+# Parrot::PackFile::OpcodeTable Perl package. Functions for manipulating
+# Parrot Pack File Opcode Tables.
+#
+# Copyright (C) 2001 Gregor N. Purdy. All rights reserved.
+# This program is free software. It is subject to the same
+# license as Perl itself.
+#
+# $Id: $
+#
+
+use strict;
+
+package Parrot::PackFile::OpcodeTable;
+
+use Parrot::Types;
+use Carp;
+
+
+#
+# new()
+#
+
+sub new
+{
+ my $class = shift;
+ my $self = bless { OPCODES => [ ] }, $class;
+
+ if (@_) {
+ $self->unpack(shift);
+ }
+
+ return $self;
+}
+
+
+#
+# clear()
+#
+
+sub clear
+{
+ my $self = shift;
+
+ $self->{OPCODES} = [ ];
+
+ return;
+}
+
+
+#
+# unpack()
+#
+
+sub unpack
+{
+ my ($self, $string) = @_;
+
+ my $count = shift_op($string);
+ my $total_used = 0;
+
+ for (1..$count) {
+ my $op_lib_name = shift_op($string);
+ my $op_full_name = shift_op($string);
+
+ my $used = 2 * sizeof('op');
+
+ $string = substr($string, $used);
+ $total_used += $used;
+
+ push @{$self->{CONST}}, [ $op_lib_name, $op_full_name ];
+ }
+
+ return $total_used + sizeof('op');
+}
+
+
+#
+# packed_size()
+#
+
+sub packed_size
+{
+ my $self = shift;
+
+ return sizeof('op') + (2 * sizeof('op')) * scalar(@{$self->{OPCODES}});
+}
+
+
+#
+# pack()
+#
+
+sub pack
+{
+ my $self = shift;
+ my $packed = '';
+
+ $packed .= pack_op($self->opcode_count);
+
+ foreach (@{$self->{OPCODES}}) {
+ $packed .= pack_op($_->[0]);
+ $packed .= pack_op($_->[1]);
+ }
+
+ return $packed;
+}
+
+
+#
+# opcode_count()
+#
+
+sub opcode_count
+{
+ my $self = shift;
+
+ return scalar(@{$self->{OPCODES}});
+}
+
+
+#
+# opcode()
+#
+
+sub opcode
+{
+ my ($self, $index) = @_;
+
+ return $self->{OPCODES}[$index];
+}
+
+
+#
+# opcodes()
+#
+
+sub opcodes
+{
+ my $self = shift;
+
+ return @{$self->{OPCODES}};
+}
+
+
+#
+# add()
+#
+
+sub add
+{
+ my ($self, $op_lib_name, $op_full_name) = @_;
+ push @{$self->{OPCODES}}, [ $op_lib_name, $op_full_name ];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parrot::PackFile::OpcodeTable
+
+=head1 SYNOPSIS
+
+ use Parrot::PackFile::OpcodeTable
+
+=head1 DESCRIPTION
+
+Opcode tables from Parrot pack files.
+
+=head2 add
+
+=head2 clear
+
+=head2 opcode_count
+
+=head2 opcode
+
+=head2 opcodes
+
+=head2 new
+
+=head2 pack
+
+=head2 packed_size
+
+=head2 unpack STRING
+
+=head1 AUTHOR
+
+Gregor N. Purdy E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Gregor N. Purdy. All rights reserved.
+
+=head1 LICENSE
+
+This program is free software. It is subject to the same
+license as Perl itself.
+
Index: include/parrot/interp_guts.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interp_guts.h,v
retrieving revision 1.1
diff -a -u -r1.1 interp_guts.h
--- include/parrot/interp_guts.h 2001/10/14 00:43:50 1.1
+++ include/parrot/interp_guts.h 2001/11/04 02:34:23
@@ -5,7 +5,7 @@
#ifndef INTERP_GUTS_H
#define INTERP_GUTS_H
-#define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+#define DO_OP(PC,INTERP) PC = ((INTERP->op_func)[*PC])(PC,INTERP);
#endif /* INTERP_GUTS_H */
Index: include/parrot/interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.13
diff -a -u -r1.13 interpreter.h
--- include/parrot/interpreter.h 2001/10/26 18:58:02 1.13
+++ include/parrot/interpreter.h 2001/11/04 02:34:23
@@ -16,6 +16,7 @@
#include "parrot/parrot.h"
#include "parrot/op.h"
+#include "parrot/oplib.h"
struct Parrot_Interp {
struct IReg *int_reg; /* Current top of int reg stack */
@@ -35,8 +36,11 @@
struct Arenas *arena_base; /* Pointer to this */
/* interpreter's arena */
- op_info_t * opcode_info; /* Opcode info table (name, nargs, arg
types) */
- opcode_t *(**opcode_funcs)(); /* Opcode function table */
+ op_lib_t * op_lib; /* The opcode library */
+ INTVAL op_count; /* The number of opcodes */
+ op_info_t * op_info; /* Opcode info table (name, nargs, arg
+types) */
+ opcode_t *(**op_func)(); /* Opcode function table */
+
STRING_FUNCS *(**string_funcs)(); /* String function table */
INTVAL flags; /* Various interpreter flags
that signal that runops
Index: include/parrot/oplib.h
===================================================================
RCS file: oplib.h
diff -N oplib.h
--- /dev/null Sat Nov 3 13:17:24 2001
+++ oplib.h Sat Nov 3 18:34:23 2001
@@ -0,0 +1,42 @@
+/* oplib.h
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: $
+ * Overview:
+ * Header file for op libraries.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#if !defined(PARROT_OPLIB_H_GUARD)
+#define PARROT_OPLIB_H_GUARD
+
+#include "parrot/config.h"
+#include "parrot/op.h"
+
+
+/*
+** op_lib_t
+*/
+
+typedef struct {
+ char * name;
+ INTVAL op_count;
+ op_info_t * op_info;
+ op_func_t * op_func;
+} op_lib_t;
+
+
+#endif
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
Index: include/parrot/packfile.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/packfile.h,v
retrieving revision 1.9
diff -a -u -r1.9 packfile.h
--- include/parrot/packfile.h 2001/10/22 21:43:25 1.9
+++ include/parrot/packfile.h 2001/11/04 02:34:23
@@ -17,7 +17,7 @@
*/
struct PackFile_FixupTable {
- opcode_t dummy;
+ opcode_t dummy;
};
#define PFC_NONE '\0'
@@ -26,25 +26,35 @@
#define PFC_STRING 's'
struct PackFile_Constant {
- opcode_t type;
- opcode_t integer;
- FLOATVAL number;
- STRING * string;
+ opcode_t type;
+ opcode_t integer;
+ FLOATVAL number;
+ STRING * string;
};
struct PackFile_ConstTable {
- opcode_t const_count;
- struct PackFile_Constant ** constants;
+ opcode_t const_count;
+ struct PackFile_Constant ** constants;
};
+struct PackFile_Opcode {
+ opcode_t op_lib_name;
+ opcode_t op_full_name;
+};
+
+struct PackFile_OpcodeTable {
+ opcode_t opcode_count;
+ struct PackFile_Opcode ** opcodes;
+};
struct PackFile {
- opcode_t magic;
- struct PackFile_FixupTable * fixup_table;
- struct PackFile_ConstTable * const_table;
- opcode_t byte_code_size;
- char * byte_code;
+ opcode_t magic;
+ struct PackFile_FixupTable * fixup_table;
+ struct PackFile_ConstTable * const_table;
+ opcode_t byte_code_size;
+ char * byte_code;
+ struct PackFile_OpcodeTable * opcode_table;
};
@@ -204,6 +214,68 @@
void
PackFile_Constant_dump(struct PackFile_Constant * self);
+
+
+/*
+** PackFile_OpcodeTable Functions:
+*/
+
+struct PackFile_OpcodeTable *
+PackFile_OpcodeTable_new(void);
+
+void
+PackFile_OpcodeTable_DELETE(struct PackFile_OpcodeTable * self);
+
+void
+PackFile_OpcodeTable_clear(struct PackFile_OpcodeTable * self);
+
+opcode_t
+PackFile_OpcodeTable_get_opcode_count(struct PackFile_OpcodeTable * self);
+
+void
+PackFile_OpcodeTable_push_opcode(struct PackFile_OpcodeTable * self, struct
+PackFile_Opcode * opcode);
+
+struct PackFile_Opcode *
+PackFile_ConstTable_opcode(struct PackFile_OpcodeTable * self, opcode_t index);
+
+opcode_t
+PackFile_OpcodeTable_unpack(struct Parrot_Interp *interpreter, struct
+PackFile_OpcodeTable * self, char * packed, opcode_t packed_size);
+
+opcode_t
+PackFile_OpcodeTable_pack_size(struct PackFile_ConstTable * self);
+
+void
+PackFile_OpcodeTable_pack(struct PackFile_OpcodeTable * self, char * packed);
+
+void
+PackFile_OpcodeTable_dump(struct PackFile_OpcodeTable * self);
+
+
+/*
+** PackFile_Opcode Functions:
+*/
+
+struct PackFile_Opcode *
+PackFile_Opcode_new(opcode_t op_lib_name, opcode_t op_full_name);
+
+void
+PackFile_Opcode_DELETE(struct PackFile_Opcode * self);
+
+void
+PackFile_Opcode_clear(struct PackFile_Opcode * self);
+
+opcode_t
+PackFile_Opcode_unpack(struct Parrot_Interp *interpreter, struct PackFile_Opcode *
+self, char * packed, opcode_t packed_size);
+
+opcode_t
+PackFile_Opcode_pack_size(struct PackFile_Opcode * self);
+
+void
+PackFile_Opcode_pack(struct PackFile_Opcode * self, char * packed);
+
+void
+PackFile_Opcode_dump(struct PackFile_Opcode * self);
+
#endif /* PACKFILE_H */
