Simon --
> What's an IV?
That was a slip of the keyboard. The C-based disassembler is (as is
now obvious) not ready for prime time. I've moved it to its own
sandbox (since it doesn't have anything to do with the doop patch
anyway).
Here's an updated patch:
Regards,
-- Gregor
_____________________________________________________________________
/ perl -e 'srand(-2091643526); print chr rand 90 for (0..4)' \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
? doop.patch
? t/inc.pasm
? t/jumpoob.pasm
? t/jumpsub.pasm
? t/substr.pasm
? t/jump2.pasm
? t/jump3.pasm
? t/jump4.pasm
? t/runoob.pasm
Index: .cvsignore
===================================================================
RCS file: /home/perlcvs/parrot/.cvsignore,v
retrieving revision 1.4
diff -a -u -r1.4 .cvsignore
--- .cvsignore 2001/09/19 16:48:28 1.4
+++ .cvsignore 2001/10/03 14:14:35
@@ -1,5 +1,8 @@
basic_opcodes.c
-test_prog
-pdump
+interp_guts.c
Makefile
+op_info.c
Parrot/
+pdisasm
+pdump
+test_prog
Index: Makefile.in
===================================================================
RCS file: /home/perlcvs/parrot/Makefile.in,v
retrieving revision 1.15
diff -a -u -r1.15 Makefile.in
--- Makefile.in 2001/10/01 22:00:23 1.15
+++ Makefile.in 2001/10/03 14:14:36
@@ -29,21 +29,21 @@
libparrot.so: $(O_FILES)
$(CC) -shared $(C_LIBS) -o $@ $(O_FILES)
-$(TEST_PROG): test_main$(O) $(O_FILES)
- $(CC) $(CFLAGS) -o $(TEST_PROG) $(O_FILES) test_main$(O) $(C_LIBS)
+$(TEST_PROG): test_main$(O) $(O_FILES) interp_guts$(O) op_info$(O)
+ $(CC) $(CFLAGS) -o $(TEST_PROG) $(O_FILES) interp_guts$(O) op_info$(O)
+test_main$(O) $(C_LIBS)
+
+$(PDUMP): pdump$(O) packfile$(O) memory$(O) global_setup$(O) string$(O) strnative$(O)
+ $(CC) $(CFLAGS) -o $(PDUMP) pdump$(O) packfile$(O) memory$(O) global_setup$(O)
+string$(O) strnative$(O) $(C_LIBS)
-$(PDUMP): pdump$(O) $(O_FILES)
- $(CC) $(CFLAGS) -o $(PDUMP) $(O_FILES) pdump$(O) $(C_LIBS)
+test_main$(O): $(H_FILES) $(INC)/interp_guts.h
-test_main$(O): $(H_FILES)
-
global_setup$(O): $(H_FILES)
string$(O): $(H_FILES)
strnative$(O): $(H_FILES)
-$(INC)/interp_guts.h: opcode_table build_interp_starter.pl
+$(INC)/interp_guts.h interp_guts.c $(INC)/op_info.h op_info.c: opcode_table
+build_interp_starter.pl
$(PERL) build_interp_starter.pl
interpreter$(O): interpreter.c $(H_FILES) $(INC)/interp_guts.h
@@ -68,7 +68,7 @@
$(PERL) Configure.pl
clean:
- $(RM_F) *$(O) *.s basic_opcodes.c $(INC)/interp_guts.h $(INC)/op.h $(TEST_PROG)
+ $(RM_F) *$(O) *.s basic_opcodes.c interp_guts.c $(INC)/interp_guts.h
+$(INC)/op.h op_info.c $(INC)op_info.h $(TEST_PROG) $(PDISASM) $(PDUMP)
test:
$(PERL) t/harness
Index: build_interp_starter.pl
===================================================================
RCS file: /home/perlcvs/parrot/build_interp_starter.pl,v
retrieving revision 1.12
diff -a -u -r1.12 build_interp_starter.pl
--- build_interp_starter.pl 2001/09/24 17:19:47 1.12
+++ build_interp_starter.pl 2001/10/03 14:14:36
@@ -1,10 +1,23 @@
# !/usr/bin/perl -w
+#
+# build_interp_starter.pl
+#
+# $Id: $
+#
+
use strict;
use Parrot::Opcode;
+
+my %opcodes = Parrot::Opcode::read_ops();
+my $opcode_fingerprint = Parrot::Opcode::fingerprint();
+
+open INTERP_GUTS_H, "> include/parrot/interp_guts.h" or die "Can't open
+include/parrot/interp_guts.h, $!/$^E";
+open INTERP_GUTS_C, "> interp_guts.c" or die "Can't open interp_guts.c, $!/$^E";
-open INTERP, "> include/parrot/interp_guts.h" or die "Can't open
include/parrot/interp_guts.h, $!/$^E";
+open OP_INFO_H, "> include/parrot/op_info.h" or die "Can't open
+include/parrot/op_info.h, $!/$^E";
+open OP_INFO_C, "> op_info.c" or die "Can't open op_info.c, $!/$^E";
-print INTERP <<CONST;
+print INTERP_GUTS_H <<CONST;
/*
*
* interp_guts.h
@@ -13,62 +26,115 @@
*
* Best not edit it
*/
+
+#ifndef INTERP_GUTS_H
+#define INTERP_GUTS_H
+
+#include "parrot/config.h"
+
+typedef opcode_t *(*op_func_t)(); /* NOTE: Sure wish we could put the types here... */
+typedef op_func_t op_func_table_t[2048];
+
+extern op_func_table_t builtin_op_func_table;
+
+
+/*
+ * DO_OP macro:
+ *
+ * w = code
+ * z = interpreter
+ */
+
+#define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+#define OPCODE_FINGERPRINT "$opcode_fingerprint"
+
+#endif /* INTERP_GUTS_H */
-#define BUILD_TABLE(x) do { \\
CONST
-my %opcodes = Parrot::Opcode::read_ops();
-my $opcode_fingerprint = Parrot::Opcode::fingerprint();
-for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
- print INTERP "\tx[$opcodes{$name}{CODE}] = $name; \\\n";
-}
-print INTERP "} while (0);\n";
+###############################################################################
+print OP_INFO_H <<CONST;
+/*
+ *
+ * op_info.h
+ *
+ * this file is autogenerated by build_interp_starter.pl
+ *
+ * Best not edit it
+ */
-#
-# BUILD_NAME_TABLE macro:
-#
+#ifndef OP_INFO_H
+#define OP_INFO_H
+
+#include "parrot/config.h"
+
+typedef struct {
+ char * name;
+ INTVAL nargs;
+ char types[5];
+} op_info_t;
+
+typedef op_info_t op_info_table_t[2048];
-print INTERP <<CONST;
-#define BUILD_NAME_TABLE(x) do { \\
+extern op_info_table_t builtin_op_info_table;
+
+#endif /* OP_INFO_H */
+
CONST
-for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
- print INTERP "\tx[$opcodes{$name}{CODE}] = \"$name\"; \\\n";
-}
-print INTERP "} while (0);\n";
+###############################################################################
+print INTERP_GUTS_C <<CONST;
+/*
+ * interp_guts.c
+ *
+ * this file is autogenerated by build_interp_starter.pl
+ *
+ * Best not edit it
+ */
-#
-# BUILD_ARG_TABLE macro:
-#
+#include "parrot/interp_guts.h"
+#include "parrot/parrot.h"
-print INTERP <<CONST;
-#define BUILD_ARG_TABLE(x) do { \\
+op_func_table_t builtin_op_func_table = {
+ /* TODO: (void *) casting here sucks! */
CONST
for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
- print INTERP "\tx[$opcodes{$name}{CODE}] = $opcodes{$name}{ARGS}; \\\n";
+ printf INTERP_GUTS_C " (void *)%-12s, /* %4d */\n", $name,
+$opcodes{$name}{CODE};
}
-print INTERP "} while (0);\n";
+print INTERP_GUTS_C "};\n\n";
-#
-# Spit out the DO_OP function
-#
+###############################################################################
-print INTERP <<EOI;
+print OP_INFO_C <<CONST;
+/*
+ * op_info.c
+ *
+ * this file is autogenerated by build_interp_starter.pl
+ *
+ * Best not edit it
+ */
-#define DO_OP(w,x,y,z) do { \\
- x = z->opcode_funcs; \\
- y = x[*w]; \\
- w = (y)(w,z); \\
- } while (0);
-EOI
+#include "parrot/op_info.h"
-# Spit out the OPCODE_FINGERPRINT macro
-print INTERP <<EOI
+op_info_table_t builtin_op_info_table = {
+CONST
-#define OPCODE_FINGERPRINT "$opcode_fingerprint"
-EOI
+for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
+ printf OP_INFO_C " { %-14s, %d, { ",
+ "\"$name\"", $opcodes{$name}{ARGS};
+
+ if ($opcodes{$name}{ARGS}) {
+ printf OP_INFO_C " %-18s }", join(", ", map { "'$_'" }
+@{$opcodes{$name}{TYPES}});
+ } else {
+ printf OP_INFO_C " %-18s }", "'*'";
+ }
+
+ printf OP_INFO_C " }, /* %4d */\n", $opcodes{$name}{CODE};
+}
+print OP_INFO_C "};\n\n";
+
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.21
diff -a -u -r1.21 interpreter.c
--- interpreter.c 2001/10/02 14:01:30 1.21
+++ interpreter.c 2001/10/03 14:14:36
@@ -12,10 +12,12 @@
#include "parrot/parrot.h"
#include "parrot/interp_guts.h"
+#include "parrot/op_info.h"
-char *op_names[2048];
-int op_args[2048];
+/* char * op_names[2048]; */
+/* op_t op_info[2048]; */
+
/*=for api interpreter check_fingerprint
* TODO: Not really part of the API, but here's the docs.
* Check the bytecode's opcode table fingerprint.
@@ -47,10 +49,6 @@
*/
opcode_t *
runops_notrace_core (struct Parrot_Interp *interpreter) {
- /* Move these out of the inner loop. No need to redeclare 'em each
- time through */
- opcode_t *(* func)();
- opcode_t *(**temp)();
opcode_t * code_start;
INTVAL code_size;
opcode_t * code_end;
@@ -63,7 +61,7 @@
pc = code_start;
while (pc >= code_start && pc < code_end && *pc) {
- DO_OP(pc, temp, func, interpreter);
+ DO_OP(pc, interpreter);
}
return pc;
@@ -75,14 +73,16 @@
* and ARGS. Used by runops_trace.
*/
void
-trace_op(opcode_t * code_start, opcode_t * code_end, opcode_t *pc) {
+trace_op(struct Parrot_Interp * interpreter, opcode_t * code_start, opcode_t *
+code_end, opcode_t *pc) {
int i;
if (pc >= code_start && pc < code_end) {
- fprintf(stderr, "PC=%ld; OP=%ld (%s)", (long)(pc - code_start), *pc,
op_names[*pc]);
- if (op_args[*pc]) {
+ fprintf(stderr, "PC=%ld; OP=%ld (%s)", (long)(pc - code_start), *pc,
+ interpreter->opcode_info[*pc].name);
+
+ if (interpreter->opcode_info[*pc].nargs) {
fprintf(stderr, "; ARGS=(");
- for(i = 0; i < op_args[*pc]; i++) {
+ for(i = 0; i < interpreter->opcode_info[*pc].nargs; i++) {
if (i) { fprintf(stderr, ", "); }
fprintf(stderr, "%ld", *(pc + i + 1));
}
@@ -101,10 +101,6 @@
*/
opcode_t *
runops_trace_core (struct Parrot_Interp *interpreter) {
- /* Move these out of the inner loop. No need to redeclare 'em each
- time through */
- opcode_t *( *func)();
- opcode_t *(**temp)();
opcode_t * code_start;
INTVAL code_size;
opcode_t * code_end;
@@ -116,12 +112,11 @@
pc = code_start;
- trace_op(code_start, code_end, pc);
-
- while (pc >= code_start && pc < code_end && *pc) {
- DO_OP(pc, temp, func, interpreter);
+ trace_op(interpreter, code_start, code_end, pc);
- trace_op(code_start, code_end, pc);
+ while (pc >= code_start && pc < code_end && *pc) {
+ DO_OP(pc, interpreter);
+ trace_op(interpreter, code_start, code_end, pc);
}
return pc;
@@ -233,18 +228,9 @@
/* Need an empty stash */
interpreter->perl_stash = mem_allocate_new_stash();
- /* The default opcode function table would be a good thing here... */
- {
- opcode_t *(**foo)();
- foo = mem_sys_allocate(2048 * sizeof(void *));
-
- BUILD_TABLE(foo);
-
- interpreter->opcode_funcs = (void*)foo;
-
- BUILD_NAME_TABLE(op_names);
- BUILD_ARG_TABLE(op_args);
- }
+ /* Load the builtin op func and info tables */
+ interpreter->opcode_funcs = builtin_op_func_table;
+ interpreter->opcode_info = builtin_op_info_table;
/* In case the I/O system needs something */
Init_IO(interpreter);
Index: include/parrot/.cvsignore
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/.cvsignore,v
retrieving revision 1.2
diff -a -u -r1.2 .cvsignore
--- include/parrot/.cvsignore 2001/09/18 01:17:45 1.2
+++ include/parrot/.cvsignore 2001/10/03 14:14:36
@@ -1,3 +1,4 @@
op.h
+op_info.h
config.h
interp_guts.h
Index: include/parrot/interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.6
diff -a -u -r1.6 interpreter.h
--- include/parrot/interpreter.h 2001/10/02 14:01:31 1.6
+++ include/parrot/interpreter.h 2001/10/03 14:14:36
@@ -15,6 +15,9 @@
#include "parrot/parrot.h"
+#include "parrot/op_info.h"
+#include "parrot/interp_guts.h"
+
struct Parrot_Interp {
struct IReg *int_reg; /* Current top of int reg stack */
struct NReg *num_reg; /* Current top of the float reg stack */
@@ -30,14 +33,23 @@
/* variable area */
struct Arenas *arena_base; /* Pointer to this */
/* interpreter's arena */
+#if 0
+ opcode_t *(*(*opcode_funcs)[2048])(); /* Opcode */
+ /* function table */
+
+ op_func_t * opcode_funcs; /* Opcode funcs */
+#endif
+
+ op_info_t * opcode_info; /* Opcode info (name, nargs, arg types) */
+ /* TODO: Why not 'op_info_table_t
+opcode_info'? */
+
opcode_t *(**opcode_funcs)(); /* Opcode function table */
STRING_FUNCS *(**string_funcs)(); /* String function table */
INTVAL flags; /* Various interpreter flags
that signal that runops
should do something */
-
- struct PackFile * code; /* The code we are executing */
+ struct PackFile * code; /* The code we are executing */
};
#define PARROT_DEBUG_FLAG 0x01 /* Bit in the flags that says
