[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: `define!' instruction returns the variable
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/02: `define!' instruction returns the variable |
Date: |
Tue, 21 Jun 2016 20:46:46 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit f1c043440312b5504ba03debeaba25c9ac1a3873
Author: Andy Wingo <address@hidden>
Date: Tue Jun 21 22:29:55 2016 +0200
`define!' instruction returns the variable
* doc/ref/vm.texi (Top-Level Environment Instructions): Update
documentation.
* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump, sadly.
* module/system/vm/assembler.scm (*bytecode-minor-version*): Bump.
* libguile/vm-engine.c (define!): Change to store variable in dst slot.
* module/language/tree-il/compile-cps.scm (convert):
* module/language/cps/compile-bytecode.scm (compile-function): Adapt to
define! change.
* module/language/cps/effects-analysis.scm (current-module): Fix define!
effects. Incidentally here was the bug: in Guile 2.2 you can't have
effects on different object kinds in one instruction, without
reverting to &unknown-memory-kinds.
* test-suite/tests/compiler.test ("regression tests"): Add a test.
---
doc/ref/vm.texi | 4 ++--
libguile/_scm.h | 2 +-
libguile/vm-engine.c | 13 ++++++++-----
module/language/cps/compile-bytecode.scm | 4 ++--
module/language/cps/effects-analysis.scm | 2 +-
module/language/tree-il/compile-cps.scm | 5 ++++-
module/system/vm/assembler.scm | 2 +-
test-suite/tests/compiler.test | 8 ++++++++
8 files changed, 27 insertions(+), 13 deletions(-)
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 70aa364..4505a01 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -674,9 +674,9 @@ found. If @var{bound?} is true, an error will be signalled
if the
variable is unbound.
@end deftypefn
address@hidden Instruction {} define! s12:@var{sym} s12:@var{val}
address@hidden Instruction {} define! s12:@var{dst} s12:@var{sym}
Look up a binding for @var{sym} in the current module, creating it if
-necessary. Set its value to @var{val}.
+necessary. Store that variable to @var{dst}.
@end deftypefn
@deftypefn Instruction {} toplevel-box s24:@var{dst} r32:@var{var-offset}
r32:@var{mod-offset} n32:@var{sym-offset} b1:@var{bound?} x31:@var{_}
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 2792fd2..60ad082 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -268,7 +268,7 @@ void scm_ia64_longjmp (scm_i_jmp_buf *, int);
/* Major and minor versions must be single characters. */
#define SCM_OBJCODE_MAJOR_VERSION 3
-#define SCM_OBJCODE_MINOR_VERSION 8
+#define SCM_OBJCODE_MINOR_VERSION 9
#define SCM_OBJCODE_MAJOR_VERSION_STRING \
SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 0978636..4b5b70b 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1950,18 +1950,21 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (2);
}
- /* define! sym:12 val:12
+ /* define! dst:12 sym:12
*
* Look up a binding for SYM in the current module, creating it if
* necessary. Set its value to VAL.
*/
- VM_DEFINE_OP (66, define, "define!", OP1 (X8_S12_S12))
+ VM_DEFINE_OP (66, define, "define!", OP1 (X8_S12_S12) | OP_DST)
{
- scm_t_uint16 sym, val;
- UNPACK_12_12 (op, sym, val);
+ scm_t_uint16 dst, sym;
+ SCM var;
+ UNPACK_12_12 (op, dst, sym);
SYNC_IP ();
- scm_define (SP_REF (sym), SP_REF (val));
+ var = scm_module_ensure_local_variable (scm_current_module (),
+ SP_REF (sym));
CACHE_SP ();
+ SP_SET (dst, var);
NEXT (1);
}
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index ea5b59f..7c69fa6 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -150,6 +150,8 @@
(emit-cached-module-box asm (from-sp dst)
(constant mod) (constant name)
(constant public?) (constant bound?)))
+ (($ $primcall 'define! (sym))
+ (emit-define! asm (from-sp dst) (from-sp (slot sym))))
(($ $primcall 'resolve (name bound?))
(emit-resolve asm (from-sp dst) (constant bound?)
(from-sp (slot name))))
@@ -312,8 +314,6 @@
(emit-set-car! asm (from-sp (slot pair)) (from-sp (slot value))))
(($ $primcall 'set-cdr! (pair value))
(emit-set-cdr! asm (from-sp (slot pair)) (from-sp (slot value))))
- (($ $primcall 'define! (sym value))
- (emit-define! asm (from-sp (slot sym)) (from-sp (slot value))))
(($ $primcall 'push-fluid (fluid val))
(emit-push-fluid asm (from-sp (slot fluid)) (from-sp (slot val))))
(($ $primcall 'pop-fluid ())
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 70344a2..5698fcd 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -418,7 +418,7 @@ is or might be a read or a write to the same location as A."
((resolve name bound?) (&read-object &module) &type-check)
((cached-toplevel-box scope name bound?) &type-check)
((cached-module-box mod name public? bound?) &type-check)
- ((define! name val) (&read-object &module) (&write-object
&box)))
+ ((define! name) (&read-object &module)))
;; Numbers.
(define-primitive-effects
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 0b9c834..3443d76 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -493,9 +493,12 @@
(lambda (cps val)
(with-cps cps
(let$ k (adapt-arity k src 0))
+ (letv box)
+ (letk kset ($kargs ('box) (box)
+ ($continue k src ($primcall 'box-set! (box val)))))
($ (with-cps-constants ((name name))
(build-term
- ($continue k src ($primcall 'define! (name val))))))))))
+ ($continue kset src ($primcall 'define! (name))))))))))
(($ <call> src proc args)
(convert-args cps (cons proc args)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index fb7f074..9fc5349 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1754,7 +1754,7 @@ needed."
;; FIXME: Define these somewhere central, shared with C.
(define *bytecode-major-version* #x0202)
-(define *bytecode-minor-version* 8)
+(define *bytecode-minor-version* 9)
(define (link-dynamic-section asm text rw rw-init frame-maps)
"Link the dynamic section for an ELF image with bytecode @var{text},
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 02f2a54..b294912 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -202,3 +202,11 @@
(vector ,@(map (lambda (n) `(identity ,n))
(iota 300))))))
(list->vector (iota 300)))))
+
+(with-test-prefix "regression tests"
+ (pass-if-equal "#18583" 1
+ (compile
+ '(begin
+ (define x (list 1))
+ (define x (car x))
+ x))))