"Flag" operands represented with booleans

* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): Change the
  U1_ word types to be B1_ instead, indicating that the Scheme
  representation of that operand component should be a boolean.
  (br-if-true, br-if-null, br-if-nil, br-if-pair, br-if-struct)
  (br-if-char, br-if-tc7, br-if-eq, br-if-eqv, br-if-equal): Update.
* module/system/vm/assembler.scm (assembler):
* module/system/vm/disassembler.scm (disassembler): Update.

4 files changed, 21 insertions, 21 deletions

diff --git a/libguile/instructions.c b/libguile/instructions.c
index 11004fca0..08f7cd60d 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 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
@@ -64,8 +64,8 @@ struct scm_instruction {
     M(X8_U12_U12)                               \
     M(X8_R24)                                   \
     M(X8_L24)                                   \
-    M(U1_X7_L24)                                \
-    M(U1_U7_L24)
+    M(B1_X7_L24)                                \
+    M(B1_U7_L24)
 
 #define TYPE_WIDTH 5
 
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index e41596259..3def7a3f0 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1656,7 +1656,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is true for the purposes of Scheme, add
    * OFFSET, a signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (26, br_if_true, "br-if-true", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (26, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_true (x));
     }
@@ -1666,7 +1666,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
    * signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (27, br_if_null, "br-if-null", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (27, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_null (x));
     }
@@ -1676,7 +1676,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
    * number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (28, br_if_nil, "br-if-nil", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (28, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_lisp_false (x));
     }
@@ -1686,7 +1686,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
    * to the current instruction pointer.
    */
-  VM_DEFINE_OP (29, br_if_pair, "br-if-pair", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (29, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, scm_is_pair (x));
     }
@@ -1696,7 +1696,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is a struct, add OFFSET, a signed 24-bit
    * number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (30, br_if_struct, "br-if-struct", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (30, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, SCM_STRUCTP (x));
     }
@@ -1706,7 +1706,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
    * to the current instruction pointer.
    */
-  VM_DEFINE_OP (31, br_if_char, "br-if-char", OP2 (U8_U24, U1_X7_L24))
+  VM_DEFINE_OP (31, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
     {
       BR_UNARY (x, SCM_CHARP (x));
     }
@@ -1716,7 +1716,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in TEST has the TC7 given in the second word, add
    * OFFSET, a signed 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (32, br_if_tc7, "br-if-tc7", OP2 (U8_U24, U1_U7_L24))
+  VM_DEFINE_OP (32, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
     {
       BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
     }
@@ -1726,7 +1726,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in A is eq? to the value in B, add OFFSET, a signed
    * 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (33, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, U1_X7_L24))
+  VM_DEFINE_OP (33, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y, scm_is_eq (x, y));
     }
@@ -1736,7 +1736,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * If the value in A is eqv? to the value in B, add OFFSET, a signed
    * 24-bit number, to the current instruction pointer.
    */
-  VM_DEFINE_OP (34, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, U1_X7_L24))
+  VM_DEFINE_OP (34, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y,
                  scm_is_eq (x, y)
@@ -1750,7 +1750,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
    * 24-bit number, to the current instruction pointer.
    */
   // FIXME: should sync_ip before calling out?
-  VM_DEFINE_OP (35, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, U1_X7_L24))
+  VM_DEFINE_OP (35, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
     {
       BR_BINARY (x, y,
                  scm_is_eq (x, y)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index ef04d6637..b40464e5d 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -260,12 +260,12 @@
        ((X8_L24 label)
         (record-label-reference asm label)
         (emit asm 0))
-       ((U1_X7_L24 a label)
+       ((B1_X7_L24 a label)
         (record-label-reference asm label)
-        (emit asm (pack-u1-u7-u24 a 0 0)))
-       ((U1_U7_L24 a b label)
+        (emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
+       ((B1_U7_L24 a b label)
         (record-label-reference asm label)
-        (emit asm (pack-u1-u7-u24 a b 0)))))
+        (emit asm (pack-u1-u7-u24 (if a 1 0) b 0)))))
 
     (syntax-case x ()
       ((_ name opcode word0 word* ...)
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 7e949e024..123026c98 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -141,11 +141,11 @@
            #'(#:rest (ash word -8)))
           ((X8_L24)
            #'((unpack-s24 (ash word -8))))
-          ((U1_X7_L24)
-           #'((logand word #x1)
+          ((B1_X7_L24)
+           #'((not (zero? (logand word #x1)))
               (unpack-s24 (ash word -8))))
-          ((U1_U7_L24)
-           #'((logand word #x1)
+          ((B1_U7_L24)
+           #'((not (zero? (logand word #x1)))
               (logand (ash word -1) #x7f)
               (unpack-s24 (ash word -8))))
           (else