All --
I've updated the simplified DO_OP patch to work with the latest out
of CVS.
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 12:24:52
@@ -1,5 +1,8 @@
basic_opcodes.c
-test_prog
-pdump
+interp_guts.c
Makefile
+op_info.c
Parrot/
+pdisasm
+pdump
+test_prog
Index: MANIFEST
===================================================================
RCS file: /home/perlcvs/parrot/MANIFEST,v
retrieving revision 1.23
diff -a -u -r1.23 MANIFEST
--- MANIFEST 2001/09/30 20:25:22 1.23
+++ MANIFEST 2001/10/03 12:24:52
@@ -53,6 +53,7 @@
opcode_table
packfile.c
parrot.c
+pdisasm.c
pdump.c
process_opfunc.pl
register.c
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 12:24:52
@@ -18,24 +18,28 @@
PERL = ${perl}
TEST_PROG = test_prog${exe}
PDUMP = pdump${exe}
+PDISASM = pdisasm${exe}
.c$(O):
$(CC) $(CFLAGS) -o $@ -c $<
-all : $(TEST_PROG) $(PDUMP)
+all : $(TEST_PROG) $(PDUMP) $(PDISASM)
#XXX This target is not portable to Win32
shared: libparrot.so
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) $(O_FILES)
- $(CC) $(CFLAGS) -o $(PDUMP) $(O_FILES) pdump$(O) $(C_LIBS)
+$(PDISASM): pdisasm$(O) op_info$(O) packfile$(O) memory$(O) global_setup$(O)
+string$(O) strnative$(O)
+ $(CC) $(CFLAGS) -o $(PDISASM) pdisasm$(O) op_info$(O) packfile$(O) memory$(O)
+global_setup$(O) string$(O) strnative$(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)
-test_main$(O): $(H_FILES)
+test_main$(O): $(H_FILES) $(INC)/interp_guts.h
global_setup$(O): $(H_FILES)
@@ -43,7 +47,7 @@
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 +72,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 12:24:52
@@ -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 12:24:53
@@ -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: pdisasm.c
===================================================================
RCS file: pdisasm.c
diff -N pdisasm.c
--- /dev/null Wed Oct 3 03:04:34 2001
+++ pdisasm.c Wed Oct 3 05:24:53 2001
@@ -0,0 +1,171 @@
+/* pdisasm.c
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: $
+ * Overview:
+ * A program to disassemble Parrot programs from Pack Files.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#include "parrot/packfile.h"
+#include "parrot/interp_guts.h"
+
+
+/*
+** disassemble()
+*/
+
+
+void
+disassemble(PackFile * pf) {
+ IV byte_code_size;
+ char * byte_code;
+ char * byte_code_end;
+ char * cursor;
+ IV * iv_ptr;
+ NV * nv_ptr;
+
+ byte_code_size = PackFile_get_byte_code_size(pf);
+ byte_code = PackFile_get_byte_code(pf);
+ byte_code_end = byte_code + byte_code_size;
+
+ cursor = byte_code;
+
+ while(cursor < byte_code_end) {
+ IV op_code;
+ char * op_name;
+ IV iv_arg;
+ NV nv_arg;
+ int i;
+
+ iv_ptr = (IV *)cursor;
+ op_code = *iv_ptr;
+ cursor += sizeof(IV);
+
+ op_name = builtin_op_info_table[op_code].name;
+
+ printf("%08x: %-12s ", cursor - byte_code, op_name);
+
+ for (i = 0; i < builtin_op_info_table[op_code].nargs; i++) {
+ char arg_type = builtin_op_info_table[op_code].types[i];
+
+ switch (arg_type) {
+ case 'D':
+ iv_arg = *(IV *)cursor;
+ cursor += sizeof(IV);
+ printf("%s%d", (i ? ", " : ""), iv_arg);
+ break;
+
+ case 'I':
+ case 'N':
+ case 'P':
+ case 'S':
+ iv_arg = *(IV *)cursor;
+ cursor += sizeof(IV);
+ printf("%s%c%d", (i ? ", " : ""), arg_type, iv_arg);
+ break;
+
+ case 'i':
+ iv_arg = *(IV *)cursor;
+ cursor += sizeof(IV);
+ printf("%s%d", (i ? ", " : ""), iv_arg);
+ break;
+
+ case 'n':
+ nv_arg = *(NV *)cursor;
+ cursor += sizeof(NV);
+ printf("%s%g", (i ? ", " : ""), nv_arg);
+ break;
+
+ case 's':
+ iv_arg = *(IV *)cursor;
+ cursor += sizeof(IV);
+ printf("%sSTRING(%d)", (i ? ", " : ""), iv_arg);
+ break;
+
+ default:
+ fprintf(stderr, "pdisasm: Internal error! Unrecognized arg type
+'%c'!\n", arg_type);
+ exit(1);
+ break;
+ }
+ }
+
+ printf("\n");
+ }
+
+ return;
+}
+
+
+/*
+** main()
+*/
+
+int
+main(int argc, char **argv) {
+ struct stat file_stat;
+ int fd;
+ char * packed;
+ long packed_size;
+ PackFile * pf;
+
+ if (argc != 2) {
+ fprintf(stderr, "pdump: usage: pdump FILE\n");
+ return 1;
+ }
+
+ if (stat(argv[1], &file_stat)) {
+ printf("can't stat %s, code %i\n", argv[1], errno);
+ return 1;
+ }
+ fd = open(argv[1], O_RDONLY);
+ if (!fd) {
+ printf("Can't open, error %i\n", errno);
+ return 1;
+ }
+
+ packed_size = file_stat.st_size;
+
+#ifndef HAS_HEADER_SYSMMAN
+ packed = mem_sys_allocate(packed_size);
+
+ if (!packed) {
+ printf("Can't allocate, code %i\n", errno);
+ return 1;
+ }
+
+ read(fd, (void*)packed, packed_size);
+#else
+ packed = mmap(0, packed_size, PROT_READ, MAP_SHARED, fd, 0);
+
+ if (!packed) {
+ printf("Can't mmap, code %i\n", errno);
+ return 1;
+ }
+#endif
+
+ pf = PackFile_new();
+
+ PackFile_unpack(pf, packed, packed_size);
+
+ disassemble(pf);
+
+ PackFile_DELETE(pf);
+
+ pf = NULL;
+
+ return 0;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
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 12:24:53
@@ -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 12:24:53
@@ -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
