summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Court`es <ludovic.courtes@laas.fr>2005-04-29 14:12:12 +0000
committerLudovic Courtès <ludo@gnu.org>2008-04-25 19:09:30 +0200
commit2d80426a3ec7de15a194d0baed0e9f4be8659b92 (patch)
tree8100ff8d82d6a1fec507e67f23987c0da58a9703 /src
parent238e7a11a8ec5aa2406b31620d3e56409639d4cf (diff)
downloadguile-2d80426a3ec7de15a194d0baed0e9f4be8659b92.tar.gz
Improved the VM's efficiency. The VM is as fast as the interpreter. :-(
* benchmark/lib.scm: New file. * benchmark/measure.scm: New file. * README: Added useful pointers to various threads. * doc/guile-vm.texi: Fixed the description of `load-program' (it now expects _immediate_ integers). * src/*.[ch]: Use immediate integers whereever possible, as in the original code. For `CONS', use `scm_cell' rather than `scm_cons'. git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-6
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.am15
-rw-r--r--src/frames.c4
-rw-r--r--src/instructions.c10
-rw-r--r--src/objcodes.c9
-rw-r--r--src/programs.c8
-rw-r--r--src/vm.c8
-rw-r--r--src/vm_engine.c2
-rw-r--r--src/vm_engine.h13
-rw-r--r--src/vm_loader.c12
-rw-r--r--src/vm_scheme.c14
-rw-r--r--src/vm_system.c18
11 files changed, 69 insertions, 44 deletions
diff --git a/src/Makefile.am b/src/Makefile.am
index 936ba1567..e1d8db014 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -4,7 +4,8 @@ guile_vm_SOURCES = guile-vm.c
guile_vm_LDADD = libguilevm.la
guile_vm_LDFLAGS = $(GUILE_LDFLAGS)
-AM_CFLAGS = -Wall -g
+AM_CFLAGS = -Wall -g -pg
+guile_vm_LDFLAGS += -pg
lib_LTLIBRARIES = libguilevm.la
libguilevm_la_SOURCES = \
@@ -12,6 +13,7 @@ libguilevm_la_SOURCES = \
envs.h frames.h instructions.h objcodes.h programs.h vm.h \
vm_engine.h vm_expand.h
libguilevm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic
+libguilevm_la_LDFLAGS += -pg
EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_loader.c
BUILT_SOURCES = vm_system.i vm_scheme.i vm_loader.i \
envs.x frames.x instructions.x objcodes.x programs.x vm.x
@@ -25,12 +27,23 @@ ETAGS_ARGS = --regex='/SCM_\(SYMBOL\|VCELL\).*\"\([^\"]\)*\"/\3/' \
SNARF = guile-snarf
SUFFIXES = .i .x
+
.c.i:
grep '^VM_DEFINE' $< > $@
+
.c.x:
$(SNARF) $< $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
|| { rm $@; false; }
+
+# Extra rules for debugging purposes.
+
+%.I: %.c
+ $(CPP) $(DEFS) $(INCLUDES) $(CPPFLAGS) $< > $@
+
+%.s: %.c
+ $(CC) -S -dA $(DEFS) $(INCLUDES) $(CFLAGS) $(CPPFLAGS) -o $@ $<
+
GUILE = "$(bindir)/guile"
guilec: guilec.in
sed "s!@guile@!$(GUILE)!" guilec.in > guilec
diff --git a/src/frames.c b/src/frames.c
index f2f16647d..baa31d9b9 100644
--- a/src/frames.c
+++ b/src/frames.c
@@ -117,7 +117,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
SCM_VALIDATE_HEAP_FRAME (1, frame);
SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
- scm_to_int (index));
+ SCM_I_INUM (index));
}
#undef FUNC_NAME
@@ -129,7 +129,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
SCM_VALIDATE_HEAP_FRAME (1, frame);
SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
- scm_to_int (index)) = val;
+ SCM_I_INUM (index)) = val;
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
diff --git a/src/instructions.c b/src/instructions.c
index df557b264..ae04d82d4 100644
--- a/src/instructions.c
+++ b/src/instructions.c
@@ -107,7 +107,7 @@ SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
#define FUNC_NAME s_scm_instruction_length
{
SCM_VALIDATE_INSTRUCTION (1, inst);
- return scm_from_schar (SCM_INSTRUCTION_LENGTH (inst));
+ return SCM_I_MAKINUM (SCM_INSTRUCTION_LENGTH (inst));
}
#undef FUNC_NAME
@@ -117,7 +117,7 @@ SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
#define FUNC_NAME s_scm_instruction_pops
{
SCM_VALIDATE_INSTRUCTION (1, inst);
- return scm_from_schar (SCM_INSTRUCTION_POPS (inst));
+ return SCM_I_MAKINUM (SCM_INSTRUCTION_POPS (inst));
}
#undef FUNC_NAME
@@ -127,7 +127,7 @@ SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
#define FUNC_NAME s_scm_instruction_pushes
{
SCM_VALIDATE_INSTRUCTION (1, inst);
- return scm_from_char (SCM_INSTRUCTION_PUSHES (inst));
+ return SCM_I_MAKINUM (SCM_INSTRUCTION_PUSHES (inst));
}
#undef FUNC_NAME
@@ -137,7 +137,7 @@ SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
#define FUNC_NAME s_scm_instruction_to_opcode
{
SCM_VALIDATE_INSTRUCTION (1, inst);
- return scm_from_char (SCM_INSTRUCTION_OPCODE (inst));
+ return SCM_I_MAKINUM (SCM_INSTRUCTION_OPCODE (inst));
}
#undef FUNC_NAME
@@ -148,7 +148,7 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
{
int i;
SCM_VALIDATE_INUM (1, op);
- i = scm_to_int (op);
+ i = SCM_I_INUM (op);
SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last);
return scm_from_locale_symbol (scm_instruction_table[i].name);
}
diff --git a/src/objcodes.c b/src/objcodes.c
index efb9eb65f..b93bed848 100644
--- a/src/objcodes.c
+++ b/src/objcodes.c
@@ -159,8 +159,8 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0,
base = SCM_OBJCODE_BASE (objcode);
memcpy (base, OBJCODE_COOKIE, 8);
- base[8] = scm_to_int (nlocs);
- base[9] = scm_to_int (nexts);
+ base[8] = SCM_I_INUM (nlocs);
+ base[9] = SCM_I_INUM (nexts);
memcpy (base + 10, c_bytecode, size - 10);
@@ -176,10 +176,13 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
#define FUNC_NAME s_scm_load_objcode
{
int fd;
+ char *c_file;
SCM_VALIDATE_STRING (1, file);
- fd = open (SCM_STRING_CHARS (file), O_RDONLY);
+ c_file = scm_to_locale_string (file);
+ fd = open (c_file, O_RDONLY);
+ free (c_file);
if (fd < 0) SCM_SYSERROR;
return make_objcode_by_mmap (fd);
diff --git a/src/programs.c b/src/programs.c
index d45cd96dd..756348d70 100644
--- a/src/programs.c
+++ b/src/programs.c
@@ -149,10 +149,10 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
SCM_VALIDATE_PROGRAM (1, program);
p = SCM_PROGRAM_DATA (program);
- return SCM_LIST4 (scm_from_uchar (p->nargs),
- scm_from_uchar (p->nrest),
- scm_from_uchar (p->nlocs),
- scm_from_uchar (p->nexts));
+ return SCM_LIST4 (SCM_I_MAKINUM (p->nargs),
+ SCM_I_MAKINUM (p->nrest),
+ SCM_I_MAKINUM (p->nlocs),
+ SCM_I_MAKINUM (p->nexts));
}
#undef FUNC_NAME
diff --git a/src/vm.c b/src/vm.c
index 8a826ef41..560afb6be 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -476,10 +476,10 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
SCM_VALIDATE_VM (1, vm);
- stats = scm_make_vector (scm_from_int (2), SCM_UNSPECIFIED);
- scm_vector_set_x (stats, scm_from_int (0),
+ stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
+ scm_vector_set_x (stats, SCM_I_MAKINUM (0),
scm_from_ulong (SCM_VM_DATA (vm)->time));
- scm_vector_set_x (stats, scm_from_int (1),
+ scm_vector_set_x (stats, SCM_I_MAKINUM (1),
scm_from_ulong (SCM_VM_DATA (vm)->clock));
return stats;
@@ -528,7 +528,7 @@ SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 1, 0, 0,
list = SCM_LIST1 (scm_str2symbol (p->name));
for (i = 1; i <= p->len; i++)
- list = scm_cons (scm_from_uint8 (ip[i]), list);
+ list = scm_cons (SCM_I_MAKINUM (ip[i]), list);
return scm_reverse_x (list, SCM_EOL);
}
#undef FUNC_NAME
diff --git a/src/vm_engine.c b/src/vm_engine.c
index 21b8468ef..3a18067cb 100644
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -72,7 +72,7 @@ vm_run (SCM vm, SCM program, SCM args)
#endif
#ifdef HAVE_LABELS_AS_VALUES
- /* Jump talbe */
+ /* Jump table */
static void *jump_table[] = {
#define VM_INSTRUCTION_TO_LABEL 1
#include "vm_expand.h"
diff --git a/src/vm_engine.h b/src/vm_engine.h
index 745b68972..2632b413b 100644
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -216,10 +216,15 @@
#define DROP() do { CHECK_UNDERFLOW (); sp--; } while (0)
#define POP(x) do { x = *sp; DROP (); } while (0)
-#define CONS(x,y,z) \
-{ \
- SYNC_BEFORE_GC (); \
- x = scm_cons (y, z); \
+/* A fast CONS. This has to be fast since its used, for instance, by
+ POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
+ inlined function in Guile 1.7. Unfortunately, it calls
+ `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
+ heap. XXX */
+#define CONS(x,y,z) \
+{ \
+ SYNC_BEFORE_GC (); \
+ x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
}
#define POP_LIST(n) \
diff --git a/src/vm_loader.c b/src/vm_loader.c
index 6516b36c5..a21e8a2d4 100644
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -138,9 +138,9 @@ VM_DEFINE_LOADER (load_program, "load-program")
/* init parameters */
/* NOTE: format defined in system/vm/assemble.scm */
- if (scm_is_integer (x))
+ if (SCM_I_INUMP (x))
{
- int i = scm_to_int (x);
+ int i = SCM_I_INUM (x);
if (-128 <= i && i <= 127)
{
/* 8-bit representation */
@@ -162,10 +162,10 @@ VM_DEFINE_LOADER (load_program, "load-program")
{
/* Other cases */
sp -= 4;
- p->nargs = scm_to_int (sp[0]);
- p->nrest = scm_to_int (sp[1]);
- p->nlocs = scm_to_int (sp[2]);
- p->nexts = scm_to_int (sp[3]);
+ p->nargs = SCM_I_INUM (sp[0]);
+ p->nrest = SCM_I_INUM (sp[1]);
+ p->nlocs = SCM_I_INUM (sp[2]);
+ p->nexts = SCM_I_INUM (sp[3]);
}
PUSH (prog);
diff --git a/src/vm_scheme.c b/src/vm_scheme.c
index a134dfe07..99568cc1c 100644
--- a/src/vm_scheme.c
+++ b/src/vm_scheme.c
@@ -167,8 +167,8 @@ VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
#define REL(crel,srel) \
{ \
ARGS2 (x, y); \
- if (scm_is_integer (x) && scm_is_integer (y)) \
- RETURN (SCM_BOOL (scm_to_int (x) crel scm_to_int (y))); \
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
+ RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y))); \
RETURN (srel (x, y)); \
}
@@ -206,11 +206,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
#define FUNC1(CEXP,SEXP) \
{ \
ARGS1 (x); \
- if (scm_is_integer (x)) \
+ if (SCM_I_INUMP (x)) \
{ \
int n = CEXP; \
if (SCM_FIXABLE (n)) \
- RETURN (scm_from_int (n)); \
+ RETURN (SCM_I_MAKINUM (n)); \
} \
RETURN (SEXP); \
}
@@ -219,11 +219,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
#define FUNC2(CFUNC,SFUNC) \
{ \
ARGS2 (x, y); \
- if (scm_is_integer (x) && scm_is_integer (y)) \
+ if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
{ \
- int n = scm_to_int (x) CFUNC scm_to_int (y); \
+ int n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
if (SCM_FIXABLE (n)) \
- RETURN (scm_from_int (n)); \
+ RETURN (SCM_I_MAKINUM (n)); \
} \
RETURN (SFUNC (x, y)); \
}
diff --git a/src/vm_system.c b/src/vm_system.c
index 9b4522747..e10263f19 100644
--- a/src/vm_system.c
+++ b/src/vm_system.c
@@ -119,7 +119,7 @@ VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1)
VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
{
- PUSH (scm_from_schar ((signed char) FETCH ()));
+ PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
NEXT;
}
@@ -139,7 +139,7 @@ VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1)
{
int h = FETCH ();
int l = FETCH ();
- PUSH (scm_from_short ((signed short) (h << 8) + l));
+ PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
NEXT;
}
@@ -197,8 +197,12 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
#define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i)
#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o
-/* #define VARIABLE_REF(v) SCM_CDR (v) */
-/* #define VARIABLE_SET(v,o) SCM_SETCDR (v, o) */
+/* For the variable operations, we _must_ obviously avoid function calls to
+ `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
+ nothing more than the corresponding macros. */
+#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
+#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
+#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
/* ref */
@@ -232,7 +236,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
{
SCM x = *sp;
- if (SCM_FALSEP (scm_variable_bound_p (x)))
+ if (!VARIABLE_BOUNDP (x))
{
err_args = SCM_LIST1 (x);
/* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
@@ -240,7 +244,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
}
else
{
- SCM o = scm_variable_ref (x);
+ SCM o = VARIABLE_REF (x);
*sp = o;
}
@@ -273,7 +277,7 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
{
- scm_variable_set_x (sp[0], sp[-1]);
+ VARIABLE_SET (sp[0], sp[-1]);
scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
sp -= 2;
NEXT;