[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-172-gc96933f
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-172-gc96933f |
|
Date: |
Sat, 24 Aug 2013 13:43:29 +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=c96933fd544aaf14776a1fc3a2986afc6fecb00c
The branch, master has been updated
via c96933fd544aaf14776a1fc3a2986afc6fecb00c (commit)
via e063995db80e843ef664a90eff58ebc13fbdb2e8 (commit)
via 70a2043143e042563c3c2dbc22db5e7be4da56ee (commit)
via 8fa728892853c04f0e73572f31773f6bfb804440 (commit)
via 72bb47ae4cc2f15f88173ff29b0b1011ac68279a (commit)
via 84cc4127bd765719b2c502de4127a54867355ad5 (commit)
via adb8d905df01b91f9889af3b94571bf8b7db0f44 (commit)
via e79ed6b1d7f852614d6bb2e7b2f2c3d32afa4ea2 (commit)
via 62d3430cb618e8d45b0e72d195fdee6e2550ea91 (commit)
from 453acfacf408fafe0712f8796e06241d236d011a (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 c96933fd544aaf14776a1fc3a2986afc6fecb00c
Author: Andy Wingo <address@hidden>
Date: Sat Aug 24 12:38:02 2013 +0200
Export the assembler procedures
* module/system/vm/assembler.scm (define-assembler):
(define-macro-assembler): Export the assemblers.
commit e063995db80e843ef664a90eff58ebc13fbdb2e8
Author: Andy Wingo <address@hidden>
Date: Sat Aug 24 11:34:56 2013 +0200
rtl vm: box-set! binds no values
* libguile/vm-engine.c (box-set!): Remove the OP_DST flag.
commit 70a2043143e042563c3c2dbc22db5e7be4da56ee
Author: Andy Wingo <address@hidden>
Date: Mon Aug 12 21:41:23 2013 +0200
RA == MVRA in disassembler
* module/system/vm/disassembler.scm: Modify call disassembler to assume
RA == MVRA.
commit 8fa728892853c04f0e73572f31773f6bfb804440
Author: Andy Wingo <address@hidden>
Date: Tue Aug 20 22:08:25 2013 +0200
assembler: give proper permissions to .data section
* module/system/vm/assembler.scm (link-data): Give stringbufs the
"shared" flag already, so we don't attempt to set it at runtime. Give
.data sections the SHF_WRITE flag.
commit 72bb47ae4cc2f15f88173ff29b0b1011ac68279a
Author: Andy Wingo <address@hidden>
Date: Tue Aug 20 22:06:46 2013 +0200
compile-file adds #:to-disk? #t to opts
* module/system/base/compile.scm (compile-file): Pass #:to-disk? as an
option to indicate that the result will be being loaded from disk.
Perhaps a linker might want to page-align in that case.
* module/language/elisp/compile-tree-il.scm (process-options!): Accept
and ignore the #:to-file compiler option.
commit 84cc4127bd765719b2c502de4127a54867355ad5
Author: Mark H Weaver <address@hidden>
Date: Sat Aug 17 06:38:53 2013 -0400
RTL: 'return-values' instruction assumes 'reset-frame' has been called.
* libguile/vm-engine.c (return-values): Remove NVALUES operand.
Don't reset the frame.
* test-suite/tests/rtl.test ("cached-toplevel-set!"): Adapt to the fact
that 'return-values' has no operand now, and that 'reset-frame' must
be done first.
commit adb8d905df01b91f9889af3b94571bf8b7db0f44
Author: Mark H Weaver <address@hidden>
Date: Sat Aug 17 05:37:45 2013 -0400
RTL VM: Rename 'apply' instruction to 'tail-apply'.
* libguile/vm-engine.c (apply, tail-apply): apply -> tail-apply.
(RETURN_VALUE_LIST): goto op_apply -> goto op_tail_apply.
* libguile/vm.c (rtl_apply_code): scm_rtl_op_apply ->
scm_rtl_op_tail_apply.
commit e79ed6b1d7f852614d6bb2e7b2f2c3d32afa4ea2
Author: Mark H Weaver <address@hidden>
Date: Thu Aug 15 21:58:41 2013 -0400
RTL VM: fix multiple value returns.
* libguile/vm-engine.c (halt): Fix off-by-one error in retrieving
multiple values from the frame.
commit 62d3430cb618e8d45b0e72d195fdee6e2550ea91
Author: Mark H Weaver <address@hidden>
Date: Tue Aug 13 09:03:23 2013 -0400
Convert branchable primitives into binary operations only.
* module/language/tree-il/primitives.scm (maybe-simplify-to-eq): Wrap
within another lambda, binding the primitive name. If there are less
than two arguments, expand to constant #t. If there are more than two
arguments, convert into a conjunction of binary applications.
(expand-chained-comparisons): New procedure.
(*primitive-expand-table*): Add entries for (< <= = >= > eq?).
-----------------------------------------------------------------------
Summary of changes:
libguile/vm-engine.c | 21 +++++++----------
libguile/vm.c | 2 +-
module/language/elisp/compile-tree-il.scm | 2 +-
module/language/tree-il/primitives.scm | 28 +++++++++++++++++++++--
module/system/base/compile.scm | 3 +-
module/system/vm/assembler.scm | 34 +++++++++++++++++++---------
module/system/vm/disassembler.scm | 7 +-----
test-suite/tests/rtl.test | 3 +-
8 files changed, 64 insertions(+), 36 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 369bb79..a422d1e 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -664,7 +664,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
fp[1] = vals; \
RESET_FRAME (3); \
ip = (scm_t_uint32 *) rtl_apply_code; \
- goto op_apply; \
+ goto op_tail_apply; \
} while (0)
#define BR_NARGS(rel) \
@@ -967,7 +967,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
ret = SCM_EOL;
SYNC_BEFORE_GC();
for (n = nvals; n > 0; n--)
- ret = scm_cons (LOCAL_REF (5 + n), ret);
+ ret = scm_cons (LOCAL_REF (5 + n - 1), ret);
ret = scm_values (ret);
}
@@ -1087,22 +1087,19 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
RETURN_ONE_VALUE (LOCAL_REF (src));
}
- /* return-values nvalues:24
+ /* return-values _:24
*
* Return a number of values from a call frame. This opcode
* corresponds to an application of `values' in tail position. As
* with tail calls, we expect that the values have already been
* shuffled down to a contiguous array starting at slot 1.
+ * We also expect the frame has already been reset.
*/
- VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_U24))
+ VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_X24))
{
- scm_t_uint32 nvalues;
+ scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT();
SCM *base = fp;
- SCM_UNPACK_RTL_24 (op, nvalues);
-
- RESET_FRAME (nvalues + 1);
-
VM_HANDLE_INTERRUPTS;
ip = SCM_FRAME_RTL_MV_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
@@ -1282,13 +1279,13 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
NEXT (0);
}
- /* apply _:24
+ /* tail-apply _:24
*
* Tail-apply the procedure in local slot 0 to the rest of the
* arguments. This instruction is part of the implementation of
* `apply', and is not generated by the compiler.
*/
- VM_DEFINE_OP (11, apply, "apply", OP1 (U8_X24))
+ VM_DEFINE_OP (11, tail_apply, "tail-apply", OP1 (U8_X24))
{
int i, list_idx, list_len, nargs;
SCM list;
@@ -1826,7 +1823,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the contents of the variable at DST to SET.
*/
- VM_DEFINE_OP (42, box_set, "box-set!", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (42, box_set, "box-set!", OP1 (U8_U12_U12))
{
scm_t_uint16 dst, src;
SCM var;
diff --git a/libguile/vm.c b/libguile/vm.c
index ad41180..5f6a5a0 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -603,7 +603,7 @@ static const scm_t_uint32 rtl_boot_continuation_code[] = {
};
static const scm_t_uint32 rtl_apply_code[] = {
- SCM_PACK_RTL_24 (scm_rtl_op_apply, 0) /* proc in r1, args from r2, nargs set
*/
+ SCM_PACK_RTL_24 (scm_rtl_op_tail_apply, 0) /* proc in r1, args from r2,
nargs set */
};
static const scm_t_uint32 rtl_values_code[] = {
diff --git a/module/language/elisp/compile-tree-il.scm
b/module/language/elisp/compile-tree-il.scm
index c0b5f88..baa6b2a 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -792,7 +792,7 @@
(let ((key (car opt))
(value (cadr opt)))
(case key
- ((#:warnings) ; ignore
+ ((#:warnings #:to-file?) ; ignore
#f)
(else (report-error #f
"Invalid compiler option"
diff --git a/module/language/tree-il/primitives.scm
b/module/language/tree-il/primitives.scm
index 06b7a11..0fe4445 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -509,8 +509,10 @@
(bytevector-ieee-double-native-set! vec (* i 8) x))
;; Appropriate for use with either 'eqv?' or 'equal?'.
-(define maybe-simplify-to-eq
+(define (maybe-simplify-to-eq prim)
(case-lambda
+ ((src) (make-const src #t))
+ ((src a) (make-const src #t))
((src a b)
;; Simplify cases where either A or B is constant.
(define (maybe-simplify a b)
@@ -524,10 +526,30 @@
(>= v most-negative-fixnum)))
(make-primcall src 'eq? (list a b))))))
(or (maybe-simplify a b) (maybe-simplify b a)))
+ ((src a b . rest)
+ (make-conditional src (make-primcall src prim (list a b))
+ (make-primcall src prim (cons b rest))
+ (make-const src #f)))
(else #f)))
-(hashq-set! *primitive-expand-table* 'eqv? maybe-simplify-to-eq)
-(hashq-set! *primitive-expand-table* 'equal? maybe-simplify-to-eq)
+(hashq-set! *primitive-expand-table* 'eqv? (maybe-simplify-to-eq 'eqv?))
+(hashq-set! *primitive-expand-table* 'equal? (maybe-simplify-to-eq 'equal?))
+
+(define (expand-chained-comparisons prim)
+ (case-lambda
+ ((src) (make-const src #t))
+ ((src a) (make-const src #t))
+ ((src a b) #f)
+ ((src a b . rest)
+ (make-conditional src (make-primcall src prim (list a b))
+ (make-primcall src prim (cons b rest))
+ (make-const src #f)))
+ (else #f)))
+
+(for-each (lambda (prim)
+ (hashq-set! *primitive-expand-table* prim
+ (expand-chained-comparisons prim)))
+ '(< <= = >= > eq?))
(hashq-set! *primitive-expand-table*
'call-with-prompt
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index c522b74..82d75c7 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -150,7 +150,8 @@
(call-with-output-file/atomic comp
(lambda (port)
((language-printer (ensure-language to))
- (read-and-compile in #:env env #:from from #:to to #:opts opts)
+ (read-and-compile in #:env env #:from from #:to to #:opts
+ (cons* #:to-file? #t opts))
port))
file)
comp)))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 2c46c3b..9c267fe 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -440,10 +440,12 @@ later by the linker."
(syntax-case x ()
((_ name opcode kind arg ...)
(with-syntax ((emit (id-append #'name #'emit- #'name)))
- #'(define emit
- (let ((emit (assembler name opcode arg ...)))
- (hashq-set! assemblers 'name emit)
- emit)))))))
+ #'(begin
+ (define emit
+ (let ((emit (assembler name opcode arg ...)))
+ (hashq-set! assemblers 'name emit)
+ emit))
+ (export emit)))))))
(define-syntax visit-opcodes
(lambda (x)
@@ -601,10 +603,12 @@ returned instead."
(syntax-case x ()
((_ (name arg ...) body body* ...)
(with-syntax ((emit (id-append #'name #'emit- #'name)))
- #'(define emit
- (let ((emit (lambda (arg ...) body body* ...)))
- (hashq-set! assemblers 'name emit)
- emit)))))))
+ #'(begin
+ (define emit
+ (let ((emit (lambda (arg ...) body body* ...)))
+ (hashq-set! assemblers 'name emit)
+ emit))
+ (export emit)))))))
(define-macro-assembler (load-constant asm dst obj)
(cond
@@ -801,8 +805,13 @@ should be .data or .rodata), and return the resulting
linker object.
(modulo (- alignment (modulo address alignment)) alignment)))
(define tc7-vector 13)
- (define tc7-narrow-stringbuf 39)
- (define tc7-wide-stringbuf (+ 39 #x400))
+ (define stringbuf-shared-flag #x100)
+ (define stringbuf-wide-flag #x400)
+ (define tc7-stringbuf 39)
+ (define tc7-narrow-stringbuf
+ (+ tc7-stringbuf stringbuf-shared-flag))
+ (define tc7-wide-stringbuf
+ (+ tc7-stringbuf stringbuf-shared-flag stringbuf-wide-flag))
(define tc7-ro-string (+ 21 #x200))
(define tc7-rtl-program 69)
@@ -941,7 +950,10 @@ should be .data or .rodata), and return the resulting
linker object.
(lp (1+ i)
(align (+ (byte-length obj) pos) 8)
(cons (make-linker-symbol obj-label pos) labels)))
- (make-object asm name buf '() labels))))))))
+ (make-object asm name buf '() labels
+ #:flags (match name
+ ('.data (logior SHF_ALLOC SHF_WRITE))
+ ('.rodata SHF_ALLOC))))))))))
(define (link-constants asm)
"Link sections to hold constants needed by the program text emitted
diff --git a/module/system/vm/disassembler.scm
b/module/system/vm/disassembler.scm
index b339b5c..138f267 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -286,12 +286,7 @@ address of that offset."
((prompt)
(match arg
((_ ... target)
- (add-label! (+ offset target) "H"))))
- ((call call/values)
- (let* ((MVRA (+ offset len))
- (RA (+ MVRA 1)))
- (add-label! MVRA "MVRA")
- (add-label! RA "RA"))))))
+ (add-label! (+ offset target) "H")))))))
(lp (+ offset len))))))
(let lp ((offset start) (n 1))
(when (< offset end)
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index 6f61f37..a6467ea 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -242,7 +242,8 @@
(box-ref 2 1)
(add1 2 2)
(box-set! 1 2)
- (return-values 0)
+ (reset-frame 1)
+ (return-values)
(end-arity)
(end-program)))))
((make-top-incrementor))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-172-gc96933f,
Andy Wingo <=