Support D extension on RV32 (#108)

* Use bool for floating point comparison result

Using bits_WU (bits(32)) or bits_LU (bits(64)) makes no sense, these are
just boolean values, and having fixed-width types is a pain for
suporting RV32D (since RV32D would need to truncate, but RV128D would
need to extend). Instead represent these as an actual bool to match what
the values really are. This could be done with bits(1) but the value is
logically a boolean (like the built-in integer comparison operators) not
a bit vector of length one so we convert to bool and back for a cleaner
interface.

* Support compiling RV32F with flen == 64

The code conflated flen and xlen; deconflating them and adding suitable
assertions (rather than silently retiring as a no-op that doesn't bump
instret) ensures that it can be compiled for RV32 with flen set to 64.
Whilst here, add the extensions and truncations that would be needed for
RV128F.

Note that there are already suitable guards on the decode clauses to
ensure these instructions are illegal on RV32.

* Support compiling RV32D

This copies various bits of XLEN generality from the F code.

* Support RV32D loads/stores

* Correctly initialise misa.D based on flen not xlen

* Makefile: Enable D extension for RV32

This now works so can be enabled.

* test: Enable RV32D tests

7 files changed, 94 insertions, 118 deletions

diff --git a/Makefile b/Makefile
index f7a4a3e..c6ce332 100644
--- a/Makefile
+++ b/Makefile
@@ -10,21 +10,19 @@ endif
 # Currently, we only have F with RV32, and both F and D with RV64.
 ifeq ($(ARCH),RV32)
   SAIL_XLEN := riscv_xlen32.sail
-  SAIL_FLEN := riscv_flen_F.sail
 else ifeq ($(ARCH),RV64)
   SAIL_XLEN := riscv_xlen64.sail
-  SAIL_FLEN := riscv_flen_D.sail
 else
   $(error '$(ARCH)' is not a valid architecture, must be one of: RV32, RV64)
 endif
 
+SAIL_FLEN := riscv_flen_D.sail
+
 # Instruction sources, depending on target
 SAIL_CHECK_SRCS = riscv_addr_checks_common.sail riscv_addr_checks.sail riscv_misa_ext.sail
 SAIL_DEFAULT_INST = riscv_insts_base.sail riscv_insts_aext.sail riscv_insts_cext.sail riscv_insts_mext.sail riscv_insts_zicsr.sail riscv_insts_next.sail riscv_insts_hints.sail
 SAIL_DEFAULT_INST += riscv_insts_fext.sail riscv_insts_cfext.sail
-ifeq ($(ARCH),RV64)
 SAIL_DEFAULT_INST += riscv_insts_dext.sail riscv_insts_cdext.sail
-endif
 SAIL_DEFAULT_INST += riscv_insts_zkn.sail
 SAIL_DEFAULT_INST += riscv_insts_zks.sail
 
diff --git a/model/riscv_insts_dext.sail b/model/riscv_insts_dext.sail
index 1619a51..ea6f280 100644
--- a/model/riscv_insts_dext.sail
+++ b/model/riscv_insts_dext.sail
@@ -584,6 +584,7 @@ function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_D_S)) = {
 }
 
 function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_L_D)) = {
+  assert(sizeof(xlen) >= 64);
   let rs1_val_D = F(rs1);
   match (select_instr_or_fcsr_rm (rm)) {
     None() => { handle_illegal(); RETIRE_FAIL },
@@ -592,13 +593,14 @@ function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_L_D)) = {
       let (fflags, rd_val_L) = riscv_f64ToI64 (rm_3b, rs1_val_D);
 
       write_fflags(fflags);
-      X(rd) = rd_val_L;
+      X(rd) = EXTS(rd_val_L);
       RETIRE_SUCCESS
     }
   }
 }
 
 function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_LU_D)) = {
+  assert(sizeof(xlen) >= 64);
   let rs1_val_D = F(rs1);
   match (select_instr_or_fcsr_rm (rm)) {
     None() => { handle_illegal(); RETIRE_FAIL },
@@ -607,14 +609,15 @@ function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_LU_D)) = {
       let (fflags, rd_val_LU) = riscv_f64ToUi64 (rm_3b, rs1_val_D);
 
       write_fflags(fflags);
-      X(rd) = rd_val_LU;
+      X(rd) = EXTS(rd_val_LU);
       RETIRE_SUCCESS
     }
   }
 }
 
 function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_D_L)) = {
-  let rs1_val_L = X(rs1);
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_L = X(rs1)[63..0];
   match (select_instr_or_fcsr_rm (rm)) {
     None() => { handle_illegal(); RETIRE_FAIL },
     Some(rm') => {
@@ -629,7 +632,8 @@ function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_D_L)) = {
 }
 
 function clause execute (F_UN_RM_TYPE_D(rs1, rm, rd, FCVT_D_LU)) = {
-  let rs1_val_LU = X(rs1);
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_LU = X(rs1)[63..0];
   match (select_instr_or_fcsr_rm (rm)) {
     None() => { handle_illegal(); RETIRE_FAIL },
     Some(rm') => {
@@ -839,11 +843,11 @@ function clause execute (F_BIN_TYPE_D(rs2, rs1, rd, FEQ_D)) = {
   let rs1_val_D = F(rs1);
   let rs2_val_D = F(rs2);
 
-  let (fflags, rd_val) : (bits_fflags, bits_LU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f64Eq (rs1_val_D, rs2_val_D);
 
   write_fflags(fflags);
-  X(rd) = rd_val;
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
@@ -851,11 +855,11 @@ function clause execute (F_BIN_TYPE_D(rs2, rs1, rd, FLT_D)) = {
   let rs1_val_D = F(rs1);
   let rs2_val_D = F(rs2);
 
-  let (fflags, rd_val) : (bits_fflags, bits_LU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f64Lt (rs1_val_D, rs2_val_D);
 
   write_fflags(fflags);
-  X(rd) = rd_val;
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
@@ -863,11 +867,11 @@ function clause execute (F_BIN_TYPE_D(rs2, rs1, rd, FLE_D)) = {
   let rs1_val_D = F(rs1);
   let rs2_val_D = F(rs2);
 
-  let (fflags, rd_val) : (bits_fflags, bits_LU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f64Le (rs1_val_D, rs2_val_D);
 
   write_fflags(fflags);
-  X(rd) = rd_val;
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
@@ -973,16 +977,18 @@ function clause execute (F_UN_TYPE_D(rs1, rd, FCLASS_D)) = {
 }
 
 function clause execute (F_UN_TYPE_D(rs1, rd, FMV_X_D)) = {
-  let rs1_val_D = F(rs1);
-  let rd_val_X  = rs1_val_D;
-  X(rd)         = rd_val_X;
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_D            = F(rs1)[63..0];
+  let rd_val_X  : xlenbits = EXTS(rs1_val_D);
+  X(rd) = rd_val_X;
   RETIRE_SUCCESS
 }
 
 function clause execute (F_UN_TYPE_D(rs1, rd, FMV_D_X)) = {
-  let rs1_val_X = X(rs1);
-  let rd_val_D  = rs1_val_X;
-  F(rd)         = rd_val_D;
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_X            = X(rs1);
+  let rd_val_D             = rs1_val_X [63..0];
+  F(rd) = rd_val_D;
   RETIRE_SUCCESS
 }
 
diff --git a/model/riscv_insts_fext.sail b/model/riscv_insts_fext.sail
index 42d797a..69fc528 100644
--- a/model/riscv_insts_fext.sail
+++ b/model/riscv_insts_fext.sail
@@ -403,7 +403,7 @@ function clause execute(LOAD_FP(imm, rs1, rd, width)) = {
         TR_Failure(e, _) => { handle_mem_exception(vaddr, e); RETIRE_FAIL },
         TR_Address(addr, _) => {
           let (aq, rl, res) = (false, false, false);
-          match (width, sizeof(xlen)) {
+          match (width, sizeof(flen)) {
             (BYTE, _)   => { handle_illegal(); RETIRE_FAIL },
             (HALF, _)   => { handle_illegal(); RETIRE_FAIL },
             (WORD, _)   =>
@@ -473,7 +473,7 @@ function clause execute (STORE_FP(imm, rs2, rs1, width)) = {
             MemException(e) => { handle_mem_exception(addr, e); RETIRE_FAIL },
             MemValue(_) => {
               let rs2_val = F(rs2);
-              match (width, sizeof(xlen)) {
+              match (width, sizeof(flen)) {
                 (BYTE, _)    => { handle_illegal(); RETIRE_FAIL },
                 (HALF, _)    => { handle_illegal(); RETIRE_FAIL },
                 (WORD, _)    => process_fstore (vaddr, mem_write_value(addr, 4, rs2_val[31..0], aq, rl, con)),
@@ -748,86 +748,66 @@ function clause execute (F_UN_RM_TYPE_S(rs1, rm, rd, FCVT_S_WU)) = {
 }
 
 function clause execute (F_UN_RM_TYPE_S(rs1, rm, rd, FCVT_L_S)) = {
-  if   sizeof(flen) == 64
-  then {
-    let rs1_val_S = nan_unbox (F(rs1));
-    match (select_instr_or_fcsr_rm (rm)) {
-      None() => { handle_illegal(); RETIRE_FAIL },
-      Some(rm') => {
-        let rm_3b = encdec_rounding_mode(rm');
-        let (fflags, rd_val_L) = riscv_f32ToI64 (rm_3b, rs1_val_S);
-
-        write_fflags(fflags);
-        X(rd) = rd_val_L;
-        RETIRE_SUCCESS
-      }
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_S = nan_unbox (F(rs1));
+  match (select_instr_or_fcsr_rm (rm)) {
+    None() => { handle_illegal(); RETIRE_FAIL },
+    Some(rm') => {
+      let rm_3b = encdec_rounding_mode(rm');
+      let (fflags, rd_val_L) = riscv_f32ToI64 (rm_3b, rs1_val_S);
+
+      write_fflags(fflags);
+      X(rd) = EXTS(rd_val_L);
+      RETIRE_SUCCESS
     }
-  } else {
-    /* this would not decode on RV32 */
-    RETIRE_FAIL
   }
 }
 
 function clause execute (F_UN_RM_TYPE_S(rs1, rm, rd, FCVT_LU_S)) = {
-  if   sizeof(flen) == 64
-  then {
-    let rs1_val_S = nan_unbox (F(rs1));
-    match (select_instr_or_fcsr_rm (rm)) {
-      None() => { handle_illegal(); RETIRE_FAIL },
-      Some(rm') => {
-        let rm_3b = encdec_rounding_mode(rm');
-        let (fflags, rd_val_LU) = riscv_f32ToUi64 (rm_3b, rs1_val_S);
-
-        write_fflags(fflags);
-        X(rd) = rd_val_LU;
-        RETIRE_SUCCESS
-      }
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_S = nan_unbox (F(rs1));
+  match (select_instr_or_fcsr_rm (rm)) {
+    None() => { handle_illegal(); RETIRE_FAIL },
+    Some(rm') => {
+      let rm_3b = encdec_rounding_mode(rm');
+      let (fflags, rd_val_LU) = riscv_f32ToUi64 (rm_3b, rs1_val_S);
+
+      write_fflags(fflags);
+      X(rd) = EXTS(rd_val_LU);
+      RETIRE_SUCCESS
     }
-  } else {
-    /* this would not decode on RV32 */
-    RETIRE_FAIL
   }
 }
 
 function clause execute (F_UN_RM_TYPE_S(rs1, rm, rd, FCVT_S_L)) = {
-  if   sizeof(flen) == 64
-  then {
-    let rs1_val_L = X(rs1);
-    match (select_instr_or_fcsr_rm (rm)) {
-      None() => { handle_illegal(); RETIRE_FAIL },
-      Some(rm') => {
-        let rm_3b = encdec_rounding_mode(rm');
-        let (fflags, rd_val_S) = riscv_i64ToF32 (rm_3b, rs1_val_L);
-
-        write_fflags(fflags);
-        F(rd) = nan_box (rd_val_S);
-        RETIRE_SUCCESS
-      }
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_L = X(rs1)[63..0];
+  match (select_instr_or_fcsr_rm (rm)) {
+    None() => { handle_illegal(); RETIRE_FAIL },
+    Some(rm') => {
+      let rm_3b = encdec_rounding_mode(rm');
+      let (fflags, rd_val_S) = riscv_i64ToF32 (rm_3b, rs1_val_L);
+
+      write_fflags(fflags);
+      F(rd) = nan_box (rd_val_S);
+      RETIRE_SUCCESS
     }
-  } else {
-    /* this would not decode on RV32 */
-    RETIRE_FAIL
   }
 }
 
 function clause execute (F_UN_RM_TYPE_S(rs1, rm, rd, FCVT_S_LU)) = {
-  if   sizeof(flen) == 64
-  then {
-    let rs1_val_LU = X(rs1);
-    match (select_instr_or_fcsr_rm (rm)) {
-      None() => { handle_illegal(); RETIRE_FAIL },
-      Some(rm') => {
-        let rm_3b = encdec_rounding_mode(rm');
-        let (fflags, rd_val_S) = riscv_ui64ToF32 (rm_3b, rs1_val_LU);
-
-        write_fflags(fflags);
-        F(rd) = nan_box (rd_val_S);
-        RETIRE_SUCCESS
-      }
+  assert(sizeof(xlen) >= 64);
+  let rs1_val_LU = X(rs1)[63..0];
+  match (select_instr_or_fcsr_rm (rm)) {
+    None() => { handle_illegal(); RETIRE_FAIL },
+    Some(rm') => {
+      let rm_3b = encdec_rounding_mode(rm');
+      let (fflags, rd_val_S) = riscv_ui64ToF32 (rm_3b, rs1_val_LU);
+
+      write_fflags(fflags);
+      F(rd) = nan_box (rd_val_S);
+      RETIRE_SUCCESS
     }
-  } else {
-    /* this would not decode on RV32 */
-    RETIRE_FAIL
   }
 }
 
@@ -1013,11 +993,11 @@ function clause execute (F_BIN_TYPE_S(rs2, rs1, rd, FEQ_S)) = {
   let rs1_val_S = nan_unbox (F(rs1));
   let rs2_val_S = nan_unbox (F(rs2));
 
-  let (fflags, rd_val) : (bits_fflags, bits_WU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f32Eq (rs1_val_S, rs2_val_S);
 
   write_fflags(fflags);
-  X(rd) = EXTZ(rd_val);
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
@@ -1025,11 +1005,11 @@ function clause execute (F_BIN_TYPE_S(rs2, rs1, rd, FLT_S)) = {
   let rs1_val_S = nan_unbox (F(rs1));
   let rs2_val_S = nan_unbox (F(rs2));
 
-  let (fflags, rd_val) : (bits_fflags, bits_WU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f32Lt (rs1_val_S, rs2_val_S);
 
   write_fflags(fflags);
-  X(rd) = EXTZ(rd_val);
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
@@ -1037,11 +1017,11 @@ function clause execute (F_BIN_TYPE_S(rs2, rs1, rd, FLE_S)) = {
   let rs1_val_S = nan_unbox (F(rs1));
   let rs2_val_S = nan_unbox (F(rs2));
 
-  let (fflags, rd_val) : (bits_fflags, bits_WU) =
+  let (fflags, rd_val) : (bits_fflags, bool) =
       riscv_f32Le (rs1_val_S, rs2_val_S);
 
   write_fflags(fflags);
-  X(rd) = EXTZ(rd_val);
+  X(rd) = EXTZ(bool_to_bits(rd_val));
   RETIRE_SUCCESS
 }
 
diff --git a/model/riscv_softfloat_interface.sail b/model/riscv_softfloat_interface.sail
index 97cc9c3..dab347a 100644
--- a/model/riscv_softfloat_interface.sail
+++ b/model/riscv_softfloat_interface.sail
@@ -335,44 +335,44 @@ function riscv_f64ToF32 (rm, v) = {
 /* COMPARISONS                                                      */
 
 val     extern_f32Lt = {c: "softfloat_f32lt", ocaml: "Softfloat.f32_lt", lem: "softfloat_f32_lt"} : (bits_S, bits_S) -> unit
-val      riscv_f32Lt : (bits_S, bits_S) -> (bits_fflags, bits_WU) effect {rreg}
+val      riscv_f32Lt : (bits_S, bits_S) -> (bits_fflags, bool) effect {rreg}
 function riscv_f32Lt (v1, v2) = {
   extern_f32Lt(v1, v2);
-  (float_fflags[4 .. 0], float_result[31 .. 0])
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 
 val     extern_f32Le = {c: "softfloat_f32le", ocaml: "Softfloat.f32_le", lem: "softfloat_f32_le"} : (bits_S, bits_S) -> unit
-val      riscv_f32Le : (bits_S, bits_S) -> (bits_fflags, bits_WU) effect {rreg}
+val      riscv_f32Le : (bits_S, bits_S) -> (bits_fflags, bool) effect {rreg}
 function riscv_f32Le (v1, v2) = {
   extern_f32Le(v1, v2);
-  (float_fflags[4 .. 0], float_result[31 .. 0])
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 
 val     extern_f32Eq = {c: "softfloat_f32eq", ocaml: "Softfloat.f32_eq", lem: "softfloat_f32_eq"} : (bits_S, bits_S) -> unit
-val      riscv_f32Eq : (bits_S, bits_S) -> (bits_fflags, bits_WU) effect {rreg}
+val      riscv_f32Eq : (bits_S, bits_S) -> (bits_fflags, bool) effect {rreg}
 function riscv_f32Eq (v1, v2) = {
   extern_f32Eq(v1, v2);
-  (float_fflags[4 .. 0], float_result[31 .. 0])
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 
 val     extern_f64Lt = {c: "softfloat_f64lt", ocaml: "Softfloat.f64_lt", lem: "softfloat_f64_lt"} : (bits_D, bits_D) -> unit
-val      riscv_f64Lt : (bits_D, bits_D) -> (bits_fflags, bits_LU) effect {rreg}
+val      riscv_f64Lt : (bits_D, bits_D) -> (bits_fflags, bool) effect {rreg}
 function riscv_f64Lt (v1, v2) = {
   extern_f64Lt(v1, v2);
-  (float_fflags[4 .. 0], float_result)
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 
 val     extern_f64Le = {c: "softfloat_f64le", ocaml: "Softfloat.f64_le", lem: "softfloat_f64_le"} : (bits_D, bits_D) -> unit
-val      riscv_f64Le : (bits_D, bits_D) -> (bits_fflags, bits_LU) effect {rreg}
+val      riscv_f64Le : (bits_D, bits_D) -> (bits_fflags, bool) effect {rreg}
 function riscv_f64Le (v1, v2) = {
   extern_f64Le(v1, v2);
-  (float_fflags[4 .. 0], float_result)
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 
 val     extern_f64Eq = {c: "softfloat_f64eq", ocaml: "Softfloat.f64_eq", lem: "softfloat_f64_eq"} : (bits_D, bits_D) -> unit
-val      riscv_f64Eq : (bits_D, bits_D) -> (bits_fflags, bits_LU) effect {rreg}
+val      riscv_f64Eq : (bits_D, bits_D) -> (bits_fflags, bool) effect {rreg}
 function riscv_f64Eq (v1, v2) = {
   extern_f64Eq(v1, v2);
-  (float_fflags[4 .. 0], float_result)
+  (float_fflags[4 .. 0], bit_to_bool(float_result[0]))
 }
 /* **************************************************************** */
diff --git a/model/riscv_sys_control.sail b/model/riscv_sys_control.sail
index a3859ff..f5ee261 100644
--- a/model/riscv_sys_control.sail
+++ b/model/riscv_sys_control.sail
@@ -559,11 +559,9 @@ function init_sys() -> unit = {
   misa->U()   = 0b1;                            /* user-mode */
   misa->S()   = 0b1;                            /* supervisor-mode */
 
-  /* On RV64, we currently support either both F and D, or neither.
-   * On RV32, we currently only support F.
-   */
+  /* We currently support both F and D */
   misa->F()   = bool_to_bits(sys_enable_fdext());      /* single-precision */
-  misa->D()   = if   sizeof(xlen) == 64
+  misa->D()   = if   sizeof(flen) >= 64
                 then bool_to_bits(sys_enable_fdext())  /* double-precision */
                 else 0b0;
 
diff --git a/test/run_fp_tests.sh b/test/run_fp_tests.sh
index 70ae00f..91e7c80 100755
--- a/test/run_fp_tests.sh
+++ b/test/run_fp_tests.sh
@@ -75,7 +75,7 @@ then
 else
     red "Building 32-bit RISCV C emulator" "fail"
 fi
-for test in $DIR/riscv-tests/rv32uf*.elf $DIR/riscv-tests/rv32mi-p-csr.elf; do
+for test in $DIR/riscv-tests/rv32u{f,d}*.elf $DIR/riscv-tests/rv32mi-p-csr.elf; do
     if timeout 5 $RISCVDIR/c_emulator/riscv_sim_RV32 -p $test > ${test%.elf}.cout 2>&1 && grep -q SUCCESS ${test%.elf}.cout
     then
 	green "C-32 $(basename $test)" "ok"
diff --git a/test/run_tests.sh b/test/run_tests.sh
index dceeae9..a132132 100755
--- a/test/run_tests.sh
+++ b/test/run_tests.sh
@@ -60,13 +60,12 @@ else
     red "Building 32-bit RISCV OCaml emulator" "fail"
 fi
 for test in $DIR/riscv-tests/rv32*.elf; do
-    # skip D tests on RV32
-    pat="rv32ud-.+elf"
+    # skip F/D tests on OCaml for now
+    pat='rv32ud-.+elf'
     if [[ $(basename $test) =~ $pat ]];
     then continue
     fi
-    # skip F tests on RV32 OCaml for now
-    pat="rv32uf-.+elf"
+    pat='rv32uf-.+elf'
     if [[ $(basename $test) =~ $pat ]];
     then continue
     fi
@@ -87,11 +86,6 @@ else
     red "Building 32-bit RISCV C emulator" "fail"
 fi
 for test in $DIR/riscv-tests/rv32*.elf; do
-    # skip D tests on C RV32
-    pat='rv32ud-.+elf'
-    if [[ $(basename $test) =~ $pat ]];
-    then continue
-    fi
     if timeout 5 $RISCVDIR/c_emulator/riscv_sim_RV32 -p $test > ${test%.elf}.cout 2>&1 && grep -q SUCCESS ${test%.elf}.cout
     then
 	green "C-32 $(basename $test)" "ok"