[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-107-g6f
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-107-g6f16379 |
|
Date: |
Sat, 09 Jan 2010 15:42:30 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6f16379e9a8d1f2d10c648793582a10772f29e32
The branch, master has been updated
via 6f16379e9a8d1f2d10c648793582a10772f29e32 (commit)
from 75c3ed282029f4d2a80adf75f52ec1b9b34edcb7 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6f16379e9a8d1f2d10c648793582a10772f29e32
Author: Andy Wingo <address@hidden>
Date: Sat Jan 9 16:42:27 2010 +0100
allocate free variables inline to closures
* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump.
* libguile/programs.h (SCM_PROGRAM_FREE_VARIABLES)
(SCM_PROGRAM_FREE_VARIABLE_REF, SCM_PROGRAM_FREE_VARIABLE_SET)
(SCM_PROGRAM_NUM_FREE_VARIABLES):
* libguile/programs.c (scm_make_program, scm_program_num_free_variables)
(scm_program_free_variable_ref, scm_program_free_variable_set_x):
Allocate free variables inline with programs, instead of being in a
vect. Should improve locality, and require fewer local variables in
the VM.
* libguile/vm-engine.c (vm_engine): Remove free_vars and free_vars_count
variables.
* libguile/vm-engine.h (CACHE_PROGRAM): No need to muck with free_vars
and free_vars_count.
(CHECK_FREE_VARIABLE): Update for inline free vars.
* libguile/vm-i-system.c (FREE_VARIABLE_REF): Update for inline free
vars.
(make-closure, fix-closure): Take the closure vals as separate stack
args, and copy or fix them inline into the appropriate closure.
* module/language/objcode/spec.scm (program-free-variables): Define a
local version of this removed function.
* module/language/tree-il/compile-glil.scm (flatten): Adjust to not make
a vector when making closures.
* module/system/vm/program.scm: Export program-num-free-variables,
program-free-variable-ref, program-free-variable-set!, and remove
program-free-variables.
* test-suite/tests/tree-il.test ("lambda"): Update to not make vectors
when making closures.
-----------------------------------------------------------------------
Summary of changes:
libguile/_scm.h | 2 +-
libguile/programs.c | 64 +++++++++++++++++++++++++----
libguile/programs.h | 9 +++-
libguile/vm-engine.c | 4 +-
libguile/vm-engine.h | 20 ++-------
libguile/vm-i-system.c | 33 ++++++++++-----
module/language/objcode/spec.scm | 7 +++-
module/language/tree-il/compile-glil.scm | 22 ++++++-----
module/system/vm/program.scm | 6 ++-
test-suite/tests/tree-il.test | 3 +-
10 files changed, 114 insertions(+), 56 deletions(-)
diff --git a/libguile/_scm.h b/libguile/_scm.h
index f80ec83..b4416ff 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -178,7 +178,7 @@
/* Major and minor versions must be single characters. */
#define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION N
+#define SCM_OBJCODE_MINOR_VERSION O
#define SCM_OBJCODE_MAJOR_VERSION_STRING \
SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING \
diff --git a/libguile/programs.c b/libguile/programs.c
index d5b3b1a..189b64e 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -42,13 +42,30 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
objtable = SCM_BOOL_F;
else if (scm_is_true (objtable))
SCM_VALIDATE_VECTOR (2, objtable);
- if (SCM_UNLIKELY (SCM_UNBNDP (free_variables)))
- free_variables = SCM_BOOL_F;
- else if (free_variables != SCM_BOOL_F)
- SCM_VALIDATE_VECTOR (3, free_variables);
- return scm_double_cell (scm_tc7_program, (scm_t_bits)objcode,
- (scm_t_bits)objtable, (scm_t_bits)free_variables);
+ if (SCM_UNBNDP (free_variables) || scm_is_false (free_variables))
+ {
+ SCM ret = scm_words (scm_tc7_program, 3);
+ SCM_SET_CELL_OBJECT_1 (ret, objcode);
+ SCM_SET_CELL_OBJECT_2 (ret, objtable);
+ return ret;
+ }
+ else
+ {
+ size_t i, len;
+ SCM ret;
+ SCM_VALIDATE_VECTOR (3, free_variables);
+ len = scm_c_vector_length (free_variables);
+ if (SCM_UNLIKELY (len >> 16))
+ SCM_OUT_OF_RANGE (3, free_variables);
+ ret = scm_words (scm_tc7_program | (len<<16), 3 + len);
+ SCM_SET_CELL_OBJECT_1 (ret, objcode);
+ SCM_SET_CELL_OBJECT_2 (ret, objtable);
+ for (i = 0; i < len; i++)
+ SCM_SET_CELL_OBJECT (ret, 3+i,
+ SCM_SIMPLE_VECTOR_REF (free_variables, i));
+ return ret;
+ }
}
#undef FUNC_NAME
@@ -264,13 +281,42 @@ scm_c_program_source (SCM program, size_t ip)
return source; /* (addr . (filename . (line . column))) */
}
-SCM_DEFINE (scm_program_free_variables, "program-free-variables", 1, 0, 0,
+SCM_DEFINE (scm_program_num_free_variables, "program-num-free-variables", 1,
0, 0,
(SCM program),
"")
-#define FUNC_NAME s_scm_program_free_variables
+#define FUNC_NAME s_scm_program_num_free_variables
+{
+ SCM_VALIDATE_PROGRAM (1, program);
+ return scm_from_ulong (SCM_PROGRAM_NUM_FREE_VARIABLES (program));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_free_variable_ref, "program-free-variable-ref", 2, 0,
0,
+ (SCM program, SCM i),
+ "")
+#define FUNC_NAME s_scm_program_free_variable_ref
+{
+ unsigned long idx;
+ SCM_VALIDATE_PROGRAM (1, program);
+ SCM_VALIDATE_ULONG_COPY (2, i, idx);
+ if (idx >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))
+ SCM_OUT_OF_RANGE (2, i);
+ return SCM_PROGRAM_FREE_VARIABLE_REF (program, idx);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_program_free_variable_set_x, "program-free-variable-set!", 3,
0, 0,
+ (SCM program, SCM i, SCM x),
+ "")
+#define FUNC_NAME s_scm_program_free_variable_set_x
{
+ unsigned long idx;
SCM_VALIDATE_PROGRAM (1, program);
- return SCM_PROGRAM_FREE_VARIABLES (program);
+ SCM_VALIDATE_ULONG_COPY (2, i, idx);
+ if (idx >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))
+ SCM_OUT_OF_RANGE (2, i);
+ SCM_PROGRAM_FREE_VARIABLE_SET (program, idx, x);
+ return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
diff --git a/libguile/programs.h b/libguile/programs.h
index 61b76a9..1545734 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -33,7 +33,10 @@
#define SCM_PROGRAM_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
#define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_CELL_OBJECT_2 (x))
-#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_3 (x))
+#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 3))
+#define SCM_PROGRAM_FREE_VARIABLE_REF(x,i) (SCM_PROGRAM_FREE_VARIABLES (x)[i])
+#define SCM_PROGRAM_FREE_VARIABLE_SET(x,i,v) (SCM_PROGRAM_FREE_VARIABLES
(x)[i]=(v))
+#define SCM_PROGRAM_NUM_FREE_VARIABLES(x) (SCM_CELL_WORD_0 (x) >> 16)
#define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
#define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT)
@@ -53,7 +56,9 @@ SCM_API SCM scm_program_properties (SCM program);
SCM_API SCM scm_program_name (SCM program);
SCM_API SCM scm_program_objects (SCM program);
SCM_API SCM scm_program_module (SCM program);
-SCM_API SCM scm_program_free_variables (SCM program);
+SCM_API SCM scm_program_num_free_variables (SCM program);
+SCM_API SCM scm_program_free_variable_ref (SCM program, SCM i);
+SCM_API SCM scm_program_free_variable_set_x (SCM program, SCM i, SCM x);
SCM_API SCM scm_program_objcode (SCM program);
SCM_API SCM scm_c_program_source (SCM program, size_t ip);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index a64b43a..c46834b 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -44,8 +44,6 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
- SCM *free_vars = NULL; /* free variables */
- size_t free_vars_count = 0; /* length of FREE_VARS */
SCM *objects = NULL; /* constant objects */
size_t object_count = 0; /* length of OBJECTS */
SCM *stack_limit = vp->stack_limit; /* stack limit address */
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 2cce734..51c462c 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -154,19 +154,6 @@
object_count = 0; \
} \
} \
- { \
- SCM c = SCM_PROGRAM_FREE_VARIABLES (program); \
- if (SCM_I_IS_VECTOR (c)) \
- { \
- free_vars = SCM_I_VECTOR_WELTS (c); \
- free_vars_count = SCM_I_VECTOR_LENGTH (c); \
- } \
- else \
- { \
- free_vars = NULL; \
- free_vars_count = 0; \
- } \
- } \
}
#define SYNC_BEFORE_GC() \
@@ -193,8 +180,11 @@
#endif
#if VM_CHECK_FREE_VARIABLES
-#define CHECK_FREE_VARIABLE(_num) \
- do { if (SCM_UNLIKELY ((_num) >= free_vars_count)) goto
vm_error_free_variable; } while (0)
+#define CHECK_FREE_VARIABLE(_num) \
+ do { \
+ if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
+ goto vm_error_free_variable; \
+ } while (0)
#else
#define CHECK_FREE_VARIABLE(_num)
#endif
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index dab268f..cc32804 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -242,7 +242,7 @@ VM_DEFINE_INSTRUCTION (19, vector, "vector", 2, -1, 1)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
-#define FREE_VARIABLE_REF(i) free_vars[i]
+#define FREE_VARIABLE_REF(i) SCM_PROGRAM_FREE_VARIABLE_REF (program, i)
/* ref */
@@ -1335,14 +1335,22 @@ VM_DEFINE_INSTRUCTION (73, free_boxed_set,
"free-boxed-set", 1, 1, 0)
NEXT;
}
-VM_DEFINE_INSTRUCTION (74, make_closure, "make-closure", 0, 2, 1)
+VM_DEFINE_INSTRUCTION (74, make_closure, "make-closure", 2, -1, 1)
{
- SCM vect;
- POP (vect);
+ size_t n, len;
+ SCM closure;
+
+ len = FETCH ();
+ len <<= 8;
+ len += FETCH ();
SYNC_BEFORE_GC ();
- /* fixme underflow */
- *sp = scm_double_cell (scm_tc7_program, (scm_t_bits)SCM_PROGRAM_OBJCODE
(*sp),
- (scm_t_bits)SCM_PROGRAM_OBJTABLE (*sp),
(scm_t_bits)vect);
+ closure = scm_words (scm_tc7_program | (len<<16), len + 3);
+ SCM_SET_CELL_OBJECT_1 (closure, SCM_PROGRAM_OBJCODE (sp[-len]));
+ SCM_SET_CELL_OBJECT_2 (closure, SCM_PROGRAM_OBJTABLE (sp[-len]));
+ sp[-len] = closure;
+ for (n = 0; n < len; n++)
+ SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, sp[-len + 1 + n]);
+ DROPN (len);
NEXT;
}
@@ -1354,17 +1362,20 @@ VM_DEFINE_INSTRUCTION (75, make_variable,
"make-variable", 0, 0, 1)
NEXT;
}
-VM_DEFINE_INSTRUCTION (76, fix_closure, "fix-closure", 2, 0, 1)
+VM_DEFINE_INSTRUCTION (76, fix_closure, "fix-closure", 2, -1, 0)
{
- SCM x, vect;
+ SCM x;
unsigned int i = FETCH ();
+ size_t n, len;
i <<= 8;
i += FETCH ();
- POP (vect);
/* FIXME CHECK_LOCAL (i) */
x = LOCAL_REF (i);
/* FIXME ASSERT_PROGRAM (x); */
- SCM_SET_CELL_WORD_3 (x, vect);
+ len = SCM_PROGRAM_NUM_FREE_VARIABLES (x);
+ for (n = 0; n < len; n++)
+ SCM_PROGRAM_FREE_VARIABLE_SET (x, n, sp[-len + 1 + n]);
+ DROPN (len);
NEXT;
}
diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm
index 9837c5c..707dd1f 100644
--- a/module/language/objcode/spec.scm
+++ b/module/language/objcode/spec.scm
@@ -1,6 +1,6 @@
;;; Guile Lowlevel Intermediate Language
-;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -53,6 +53,11 @@
(lp (acons (binding:index b) (list b) ret)
(cdr locs))))))))
+(define (program-free-variables program)
+ (list->vector
+ (map (lambda (i) (program-free-variable-ref program i))
+ (iota (program-num-free-variables program)))))
+
(define (decompile-value x env opts)
(cond
((program? x)
diff --git a/module/language/tree-il/compile-glil.scm
b/module/language/tree-il/compile-glil.scm
index 32c5b03..a2102c9 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -663,8 +663,8 @@
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
- (emit-code #f (make-glil-call 'vector (length free-locs)))
- (emit-code #f (make-glil-call 'make-closure 2)))))))
+ (emit-code #f (make-glil-call 'make-closure
+ (length free-locs))))))))
(maybe-emit-return))
((<lambda-case> src req opt rest kw inits vars alternate body)
@@ -812,13 +812,16 @@
((hashq-ref allocation x)
;; allocating a closure
(emit-code #f (flatten-lambda x v allocation))
- (if (not (null? (cdr (hashq-ref allocation x))))
- ;; Need to make-closure first, but with a temporary #f
- ;; free-variables vector, so we are mutating fresh
- ;; closures on the heap.
- (begin
- (emit-code #f (make-glil-const #f))
- (emit-code #f (make-glil-call 'make-closure 2))))
+ (let ((free-locs (cdr (hashq-ref allocation x))))
+ (if (not (null? free-locs))
+ ;; Need to make-closure first, so we have a fresh closure
on
+ ;; the heap, but with a temporary free values.
+ (begin
+ (for-each (lambda (loc)
+ (emit-code #f (make-glil-const #f)))
+ free-locs)
+ (emit-code #f (make-glil-call 'make-closure
+ (length free-locs))))))
(pmatch (hashq-ref (hashq-ref allocation v) self)
((#t #f . ,n)
(emit-code src (make-glil-lexical #t #f 'set n)))
@@ -868,7 +871,6 @@
(emit-code #f (make-glil-lexical local? #f 'ref n)))
(else (error "what" x loc))))
free-locs)
- (emit-code #f (make-glil-call 'vector (length free-locs)))
(pmatch (hashq-ref (hashq-ref allocation v) self)
((#t #f . ,n)
(emit-code #f (make-glil-lexical #t #f 'fix n)))
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 31b667b..ccb9ebf 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -1,6 +1,6 @@
;;; Guile VM program functions
-;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -40,7 +40,9 @@
program-meta
program-objcode program? program-objects
- program-module program-base program-free-variables))
+ program-module program-base
+ program-num-free-variables
+ program-free-variable-ref program-free-variable-set!))
(load-extension "libguile" "scm_init_programs")
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index f7cc75b..f5f85d0 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -401,8 +401,7 @@
(lexical #f #f ref 0) (call return 1)
(unbind))
(lexical #t #f ref 0)
- (call vector 1)
- (call make-closure 2)
+ (call make-closure 1)
(call return 1)
(unbind))
(call return 1))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-6-107-g6f16379,
Andy Wingo <=