`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

@@ -674,9 +674,9 @@ found.  If @var{bound?} is true, an error will be signalled if the
 variable is unbound.
 @end deftypefn
 
-@deftypefn Instruction {} define! s12:@var{sym} s12:@var{val}
+@deftypefn 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{_}

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        \

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);
     }
 

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 ())

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

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)

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},

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))))