summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlasdair Armstrong2017-08-14 17:11:16 +0100
committerAlasdair Armstrong2017-08-14 17:11:16 +0100
commitf05423c1947df0432362172ba9cfd00c4b8680c0 (patch)
treeb86d71669731f2f02aa6d2a752ac9d474ede1cab
parent96642bd568bd76d79ab3cc82aa66288e022467ab (diff)
parent1a94f80b5d518e9d79daf9b253331d5b7936761f (diff)
Merge remote-tracking branch 'origin/master' into experiments
-rw-r--r--.merlin8
-rw-r--r--risc-v/Makefile13
-rw-r--r--risc-v/hgen/ast.hgen13
-rw-r--r--risc-v/hgen/fold.hgen13
-rw-r--r--risc-v/hgen/herdtools_ast_to_shallow_ast.hgen61
-rw-r--r--risc-v/hgen/herdtools_types_to_shallow_types.hgen74
-rw-r--r--risc-v/hgen/lexer.hgen61
-rw-r--r--risc-v/hgen/map.hgen12
-rw-r--r--risc-v/hgen/parser.hgen26
-rw-r--r--risc-v/hgen/pretty.hgen15
-rw-r--r--risc-v/hgen/regs_out_in.hgen5
-rw-r--r--risc-v/hgen/sail_trans_out.hgen14
-rw-r--r--risc-v/hgen/shallow_ast_to_herdtools_ast.hgen14
-rw-r--r--risc-v/hgen/shallow_types_to_herdtools_types.hgen70
-rw-r--r--risc-v/hgen/token_types.hgen13
-rw-r--r--risc-v/hgen/tokens.hgen13
-rw-r--r--risc-v/hgen/trans_sail.hgen106
-rw-r--r--risc-v/hgen/types.hgen116
-rw-r--r--risc-v/hgen/types_sail_trans_out.hgen83
-rw-r--r--risc-v/hgen/types_trans_sail.hgen33
-rw-r--r--risc-v/riscv.sail (renamed from risc-v/risc-v.sail)81
-rw-r--r--risc-v/riscv_extras.lem58
-rw-r--r--risc-v/riscv_extras_embed.lem32
-rw-r--r--risc-v/riscv_extras_embed_sequential.lem34
-rw-r--r--risc-v/riscv_regfp.sail84
-rw-r--r--src/gen_lib/sail_values.lem2
-rw-r--r--src/lem_interp/interp_interface.lem2
-rw-r--r--src/lem_interp/run_with_elf.ml2
-rw-r--r--src/lem_interp/run_with_elf_cheri.ml2
-rw-r--r--src/lem_interp/run_with_elf_cheri128.ml2
-rw-r--r--src/test/lib/run_test_interp.ml2
31 files changed, 1040 insertions, 24 deletions
diff --git a/.merlin b/.merlin
new file mode 100644
index 00000000..d76ab020
--- /dev/null
+++ b/.merlin
@@ -0,0 +1,8 @@
+S src
+S src/contrib/**
+S src/gen_lib/**
+S src/lem_interp/**
+S src/pprint/**
+S src/test/**
+B src/_build/**
+PKG num str unix uint zarith \ No newline at end of file
diff --git a/risc-v/Makefile b/risc-v/Makefile
new file mode 100644
index 00000000..856a48eb
--- /dev/null
+++ b/risc-v/Makefile
@@ -0,0 +1,13 @@
+
+SAIL:=../src/sail.native
+SOURCES:=riscv.sail ../etc/regfp.sail riscv_regfp.sail
+all: lem_ast shallow
+
+lem_ast: $(SOURCES) $(SAIL)
+ $(SAIL) -lem_ast $(SOURCES)
+
+shallow: $(SOURCES) $(SAIL)
+ $(SAIL) -lem_lib Riscv_extras_embed -lem $(SOURCES)
+
+clean:
+ rm -f riscv.lem riscv_embed*.lem
diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen
new file mode 100644
index 00000000..2860484e
--- /dev/null
+++ b/risc-v/hgen/ast.hgen
@@ -0,0 +1,13 @@
+| `RISCVUTYPE of bit20 * reg * riscvUop
+| `RISCVJAL of bit20 * reg
+| `RISCVJALR of bit12 * reg * reg
+| `RISCVBType of bit12 * reg * reg * riscvBop
+| `RISCVIType of bit12 * reg * reg * riscvIop
+| `RISCVShiftIop of bit6 * reg * reg * riscvSop
+| `RISCVRType of reg * reg * reg * riscvRop
+| `RISCVLoad of bit12 * reg * reg * bool * wordWidth
+| `RISCVStore of bit12 * reg * reg * wordWidth
+| `RISCVADDIW of bit12 * reg * reg
+| `RISCVSHIFTW of bit5 * reg * reg * riscvSop
+| `RISCVRTYPEW of reg * reg * reg * riscvRopw
+| `RISCVFENCE
diff --git a/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen
new file mode 100644
index 00000000..03318805
--- /dev/null
+++ b/risc-v/hgen/fold.hgen
@@ -0,0 +1,13 @@
+| `RISCVThreadStart -> (y_reg, y_sreg)
+| `RISCVUTYPE (_, r0, _) -> fold_reg r0 (y_reg, y_sreg)
+| `RISCVJAL (_, r0) -> fold_reg r0 (y_reg, y_sreg)
+| `RISCVJALR (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVBType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVIType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVShiftIop (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVRType (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg)))
+| `RISCVLoad (_, r0, r1, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVStore (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVADDIW (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVSHIFTW (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg))
+| `RISCVRTYPEW (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg)))
diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen
new file mode 100644
index 00000000..46b11310
--- /dev/null
+++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen
@@ -0,0 +1,61 @@
+| `RISCVStopFetching -> EBREAK
+| `RISCVUTYPE(imm, rd, op) -> UTYPE(
+ translate_imm20 "imm" imm,
+ translate_reg "rd" rd,
+ translate_uop op)
+| `RISCVJAL(imm, rd) -> JAL0(
+ translate_imm20 "imm" imm,
+ translate_reg "rd" rd)
+| `RISCVJALR(imm, rs, rd) -> JALR0(
+ translate_imm12 "imm" imm,
+ translate_reg "rs" rd,
+ translate_reg "rd" rd)
+| `RISCVBType(imm, rs2, rs1, op) -> BTYPE(
+ translate_imm12 "imm" imm,
+ translate_reg "rs2" rs2,
+ translate_reg "rs1" rs1,
+ translate_bop op)
+| `RISCVIType(imm, rs1, rd, op) -> ITYPE(
+ translate_imm12 "imm" imm,
+ translate_reg "rs1" rs1,
+ translate_reg "rd" rd,
+ translate_iop op)
+| `RISCVShiftIop(imm, rs, rd, op) -> SHIFTIOP(
+ translate_imm6 "imm" imm,
+ translate_reg "rs" rs,
+ translate_reg "rd" rd,
+ translate_sop op)
+| `RISCVRType (rs2, rs1, rd, op) -> RTYPE (
+ translate_reg "rs2" rs2,
+ translate_reg "rs1" rs1,
+ translate_reg "rd" rd,
+ translate_rop op)
+| `RISCVLoad(imm, rs, rd, unsigned, width) -> LOAD(
+ translate_imm12 "imm" imm,
+ translate_reg "rs" rs,
+ translate_reg "rd" rd,
+ translate_bool "unsigned" unsigned,
+ translate_wordWidth width)
+| `RISCVStore(imm, rs, rd, width) -> STORE (
+ translate_imm12 "imm" imm,
+ translate_reg "rs" rs,
+ translate_reg "rd" rd,
+ translate_wordWidth width)
+| `RISCVADDIW(imm, rs, rd) -> ADDIW(
+ translate_imm12 "imm" imm,
+ translate_reg "rs" rs,
+ translate_reg "rd" rd)
+| `RISCVSHIFTW(imm, rs, rd, op) -> SHIFTW(
+ translate_imm5 "imm" imm,
+ translate_reg "rs" rs,
+ translate_reg "rd" rd,
+ translate_sop op)
+| `RISCVRTYPEW(rs2, rs1, rd, op) -> RTYPEW(
+ translate_reg "rs2" rs2,
+ translate_reg "rs1" rs1,
+ translate_reg "rd" rd,
+ translate_ropw op)
+| `RISCVFENCE -> FENCE (
+ translate_imm4 "pred" 0,
+ translate_imm4 "succ" 0
+)
diff --git a/risc-v/hgen/herdtools_types_to_shallow_types.hgen b/risc-v/hgen/herdtools_types_to_shallow_types.hgen
new file mode 100644
index 00000000..c15b3f94
--- /dev/null
+++ b/risc-v/hgen/herdtools_types_to_shallow_types.hgen
@@ -0,0 +1,74 @@
+let is_inc = false
+
+let translate_reg name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 5,Nat_big_num.of_int (reg_to_int value))
+
+let translate_uop op = match op with
+ | RISCVLUI -> LUI0
+ | RISCVAUIPC -> AUIPC
+
+let translate_bop op = match op with
+ | RISCVBEQ -> BEQ0
+ | RISCVBNE -> BNE
+ | RISCVBLT -> BLT
+ | RISCVBGE -> BGE
+ | RISCVBLTU -> BLTU
+ | RISCVBGEU -> BGEU
+
+let translate_iop op = match op with
+ | RISCVADDI -> ADDI0
+ | RISCVSLTI -> SLTI0
+ | RISCVSLTIU -> SLTIU0
+ | RISCVXORI -> XORI0
+ | RISCVORI -> ORI0
+ | RISCVANDI -> ANDI0
+
+let translate_sop op = match op with
+ | RISCVSLLI -> SLLI
+ | RISCVSRLI -> SRLI
+ | RISCVSRAI -> SRAI
+
+let translate_rop op = match op with
+ | RISCVADD -> ADD0
+ | RISCVSUB -> SUB0
+ | RISCVSLL -> SLL0
+ | RISCVSLT -> SLT0
+ | RISCVSLTU -> SLTU0
+ | RISCVXOR -> XOR0
+ | RISCVSRL -> SRL0
+ | RISCVSRA -> SRA0
+ | RISCVOR -> OR0
+ | RISCVAND -> AND0
+
+let translate_ropw op = match op with
+ | RISCVADDW -> ADDW
+ | RISCVSUBW -> SUBW
+ | RISCVSLLW -> SLLW
+ | RISCVSRLW -> SRLW
+ | RISCVSRAW -> SRAW
+
+let translate_wordWidth op = match op with
+ | RISCVBYTE -> BYTE
+ | RISCVHALF -> HALF
+ | RISCVWORD -> WORD
+ | RISCVDOUBLE -> DOUBLE
+
+let translate_bool name = function
+ | true -> Sail_values.B1
+ | false -> Sail_values.B0
+
+
+let translate_imm20 name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 20,Nat_big_num.of_int value)
+
+let translate_imm12 name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 12,Nat_big_num.of_int value)
+
+let translate_imm6 name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 6,Nat_big_num.of_int value)
+
+let translate_imm5 name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 5,Nat_big_num.of_int value)
+
+let translate_imm4 name value =
+ Sail_values.to_vec0 is_inc (Nat_big_num.of_int 4,Nat_big_num.of_int value)
diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen
new file mode 100644
index 00000000..1888d42b
--- /dev/null
+++ b/risc-v/hgen/lexer.hgen
@@ -0,0 +1,61 @@
+"lwu" , UTYPE { op=RISCVLUI };
+"auipc" , UTYPE { op=RISCVAUIPC };
+
+"jal", JAL ();
+"jalr", JALR ();
+
+"beq", BTYPE {op=RISCVBEQ};
+"bne", BTYPE {op=RISCVBNE};
+"blt", BTYPE {op=RISCVBLT};
+"bge", BTYPE {op=RISCVBGE};
+"bltu", BTYPE {op=RISCVBLTU};
+"bgeu", BTYPE {op=RISCVBGEU};
+
+"addi", ITYPE {op=RISCVADDI};
+"stli", ITYPE {op=RISCVSLTI};
+"sltiu", ITYPE {op=RISCVSLTIU};
+"xori", ITYPE {op=RISCVXORI};
+"ori", ITYPE {op=RISCVORI};
+"andi", ITYPE {op=RISCVANDI};
+
+"slli", SHIFTIOP{op=RISCVSLLI};
+"srli", SHIFTIOP{op=RISCVSRLI};
+"srai", SHIFTIOP{op=RISCVSRAI};
+
+"add", RTYPE{op=RISCVADD};
+"sub", RTYPE{op=RISCVSUB};
+"sll", RTYPE{op=RISCVSLL};
+"slt", RTYPE{op=RISCVSLT};
+"sltu", RTYPE{op=RISCVSLT};
+"xor", RTYPE{op=RISCVXOR};
+"srl", RTYPE{op=RISCVSRL};
+"sra", RTYPE{op=RISCVSRA};
+"or", RTYPE{op=RISCVOR};
+"and", RTYPE{op=RISCVAND};
+
+"lb", LOAD{unsigned=false; width=RISCVBYTE};
+"lbu", LOAD{unsigned=true; width=RISCVBYTE};
+"lh", LOAD{unsigned=false; width=RISCVHALF};
+"lhu", LOAD{unsigned=true; width=RISCVHALF};
+"lw", LOAD{unsigned=false; width=RISCVWORD};
+"lwu", LOAD{unsigned=true; width=RISCVWORD};
+"ld", LOAD{unsigned=false; width=RISCVDOUBLE};
+
+"sb", STORE{width=RISCVBYTE};
+"sh", STORE{width=RISCVHALF};
+"sw", STORE{width=RISCVWORD};
+"sd", STORE{width=RISCVDOUBLE};
+
+"addiw", ADDIW ();
+
+"slliw", SHIFTW{op=RISCVSLLI};
+"srliw", SHIFTW{op=RISCVSRLI};
+"sraiw", SHIFTW{op=RISCVSRAI};
+
+"addw", RTYPEW{op=RISCVADDW};
+"subw", RTYPEW{op=RISCVSUBW};
+"sslw", RTYPEW{op=RISCVSLLW};
+"srlw", RTYPEW{op=RISCVSRLW};
+"sraw", RTYPEW{op=RISCVSRAW};
+
+"fence", FENCE ();
diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen
new file mode 100644
index 00000000..ff14c428
--- /dev/null
+++ b/risc-v/hgen/map.hgen
@@ -0,0 +1,12 @@
+| `RISCVUTYPE (x, r0, y) -> `RISCVUTYPE (x, map_reg r0, y)
+| `RISCVJAL (x, r0) -> `RISCVJAL (x, map_reg r0)
+| `RISCVJALR (x, r0, r1) -> `RISCVJALR (x, map_reg r0, map_reg r1)
+| `RISCVBType (x, r0, r1, y) -> `RISCVBType (x, map_reg r0, map_reg r1, y)
+| `RISCVIType (x, r0, r1, y) -> `RISCVIType (x, map_reg r0, map_reg r1, y)
+| `RISCVShiftIop (x, r0, r1, y) -> `RISCVShiftIop (x, map_reg r0, map_reg r1, y)
+| `RISCVRType (r0, r1, r2, y) -> `RISCVRType (r0, map_reg r1, map_reg r2, y)
+| `RISCVLoad (x, r0, r1, y, z) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z)
+| `RISCVStore (x, r0, r1, y) -> `RISCVStore (x, map_reg r0, map_reg r1, y)
+| `RISCVADDIW (x, r0, r1) -> `RISCVADDIW (x, map_reg r0, map_reg r1)
+| `RISCVSHIFTW (x, r0, r1, y) -> `RISCVSHIFTW (x, map_reg r0, map_reg r1, y)
+| `RISCVRTYPEW (r0, r1, r2, x) -> `RISCVRTYPEW (r0, map_reg r1, map_reg r2, x)
diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen
new file mode 100644
index 00000000..ba780857
--- /dev/null
+++ b/risc-v/hgen/parser.hgen
@@ -0,0 +1,26 @@
+| UTYPE reg COMMA NUM
+ { `RISCVUTYPE($4, $2, $1.op) }
+| JAL reg COMMA NUM
+ { `RISCVJAL($4, $2) }
+| JALR reg COMMA reg COMMA NUM
+ { `RISCVJALR($6, $4, $2) }
+| BTYPE reg COMMA reg COMMA NUM
+ { `RISCVBType($6, $4, $2, $1.op) }
+| ITYPE reg COMMA reg COMMA NUM
+ { `RISCVIType($6, $4, $2, $1.op) }
+| SHIFTIOP reg COMMA reg COMMA NUM
+ { `RISCVShiftIop($6, $4, $2, $1.op) }
+| RTYPE reg COMMA reg COMMA reg
+ { `RISCVRType ($6, $4, $2, $1.op) }
+| LOAD reg COMMA NUM LPAR reg RPAR
+ { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width) }
+| STORE reg COMMA NUM LPAR reg RPAR
+ { `RISCVStore($4, $6, $2, $1.width) }
+| ADDIW reg COMMA reg COMMA NUM
+ { `RISCVADDIW ($6, $4, $2) }
+| SHIFTW reg COMMA reg COMMA NUM
+ { `RISCVSHIFTW ($6, $4, $2, $1.op) }
+| RTYPEW reg COMMA reg COMMA reg
+ { `RISCVRTYPEW ($6, $4, $2, $1.op) }
+| FENCE
+ { `RISCVFENCE }
diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen
new file mode 100644
index 00000000..d8572ae2
--- /dev/null
+++ b/risc-v/hgen/pretty.hgen
@@ -0,0 +1,15 @@
+| `RISCVThreadStart -> "start"
+| `RISCVStopFetching -> "stop"
+| `RISCVUTYPE(imm, rd, op) -> sprintf "%s %s, %d" (pp_riscv_uop op) (pp_reg rd) imm
+| `RISCVJAL(imm, rd) -> sprintf "jal %s, %d" (pp_reg rd) imm
+| `RISCVJALR(imm, rs, rd) -> sprintf "jalr %s, %s, %d" (pp_reg rd) (pp_reg rs) imm
+| `RISCVBType(imm, rs2, rs1, op) -> sprintf "%s %s, %s, %d" (pp_riscv_bop op) (pp_reg rs1) (pp_reg rs2) imm
+| `RISCVIType(imm, rs2, rs1, op) -> sprintf "%s %s, %s, %d" (pp_riscv_iop op) (pp_reg rs1) (pp_reg rs2) imm
+| `RISCVShiftIop(imm, rs, rd, op) -> sprintf "%s %s, %s, %d" (pp_riscv_sop op) (pp_reg rd) (pp_reg rs) imm
+| `RISCVRType (rs2, rs1, rd, op) -> sprintf "%s %s, %s, %s" (pp_riscv_rop op) (pp_reg rd) (pp_reg rs1) (pp_reg rs2)
+| `RISCVLoad(imm, rs, rd, unsigned, width) -> sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width)) (pp_reg rd) imm (pp_reg rs)
+| `RISCVStore(imm, rs, rd, width) -> sprintf "%s %s, %d(%s)" (pp_riscv_store_op width) (pp_reg rd) imm (pp_reg rs)
+| `RISCVADDIW(imm, rs, rd) -> sprintf "addiw %s, %s, %d" (pp_reg rd) (pp_reg rs) imm
+| `RISCVSHIFTW(imm, rs, rd, op) -> sprintf "%s %s, %s, %d" (pp_riscv_sop op) (pp_reg rd) (pp_reg rs) imm
+| `RISCVRTYPEW(rs2, rs1, rd, op) -> sprintf "%s %s, %s, %s" (pp_riscv_ropw op) (pp_reg rd) (pp_reg rs1) (pp_reg rs2)
+| `RISCVFENCE -> "fence"
diff --git a/risc-v/hgen/regs_out_in.hgen b/risc-v/hgen/regs_out_in.hgen
new file mode 100644
index 00000000..8e1fd093
--- /dev/null
+++ b/risc-v/hgen/regs_out_in.hgen
@@ -0,0 +1,5 @@
+(* for each instruction instance, identify the role of the registers
+ and possible branching: (outputs, inputs, voidstars, branch) *)
+
+| `MIPSAdd ->
+ ([], [], [], [Next])
diff --git a/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen
new file mode 100644
index 00000000..a9d3159c
--- /dev/null
+++ b/risc-v/hgen/sail_trans_out.hgen
@@ -0,0 +1,14 @@
+| ("EBREAK", []) -> `RISCVStopFetching
+| ("UTYPE", [imm; rd; op]) -> `RISCVUTYPE(translate_out_simm20 imm, translate_out_ireg rd, translate_out_uop op)
+| ("JAL", [imm; rd]) -> `RISCVJAL(translate_out_simm20 imm, translate_out_ireg rd)
+| ("JALR", [imm; rs; rd]) -> `RISCVJALR(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd)
+| ("BTYPE", [imm; rs2; rs1; op]) -> `RISCVBType(translate_out_simm12 imm, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_bop op)
+| ("ITYPE", [imm; rs1; rd; op]) -> `RISCVIType(translate_out_simm12 imm, translate_out_ireg rs1, translate_out_ireg rd, translate_out_iop op)
+| ("SHIFTIOP", [imm; rs; rd; op]) -> `RISCVShiftIop(translate_out_imm6 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op)
+| ("RTYPE", [rs2; rs1; rd; op]) -> `RISCVRType (translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_rop op)
+| ("LOAD", [imm; rs; rd; unsigned; width]) -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width)
+| ("STORE", [imm; rs; rd; width]) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width)
+| ("ADDIW", [imm; rs; rd]) -> `RISCVADDIW(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd)
+| ("SHIFTW", [imm; rs; rd; op]) -> `RISCVSHIFTW(translate_out_imm5 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op)
+| ("RTYPEW", [rs2; rs1; rd; op]) -> `RISCVRTYPEW(translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_ropw op)
+| ("FENCE", []) -> `RISCVFENCE
diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen
new file mode 100644
index 00000000..9278b92e
--- /dev/null
+++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen
@@ -0,0 +1,14 @@
+| EBREAK -> `RISCVStopFetching
+| UTYPE( imm, rd, op) -> `RISCVUTYPE(translate_out_simm20 imm, translate_out_ireg rd, translate_out_uop op)
+| JAL0( imm, rd) -> `RISCVJAL(translate_out_simm20 imm, translate_out_ireg rd)
+| JALR0( imm, rs, rd) -> `RISCVJALR(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd)
+| BTYPE( imm, rs2, rs1, op) -> `RISCVBType(translate_out_simm12 imm, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_bop op)
+| ITYPE( imm, rs1, rd, op) -> `RISCVIType(translate_out_simm12 imm, translate_out_ireg rs1, translate_out_ireg rd, translate_out_iop op)
+| SHIFTIOP( imm, rs, rd, op) -> `RISCVShiftIop(translate_out_imm6 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op)
+| RTYPE( rs2, rs1, rd, op) -> `RISCVRType (translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_rop op)
+| LOAD( imm, rs, rd, unsigned, width) -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width)
+| STORE( imm, rs, rd, width) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width)
+| ADDIW( imm, rs, rd) -> `RISCVADDIW(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd)
+| SHIFTW( imm, rs, rd, op) -> `RISCVSHIFTW(translate_out_imm5 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op)
+| RTYPEW( rs2, rs1, rd, op) -> `RISCVRTYPEW(translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_ropw op)
+| FENCE(pred, succ) -> `RISCVFENCE
diff --git a/risc-v/hgen/shallow_types_to_herdtools_types.hgen b/risc-v/hgen/shallow_types_to_herdtools_types.hgen
new file mode 100644
index 00000000..d635efde
--- /dev/null
+++ b/risc-v/hgen/shallow_types_to_herdtools_types.hgen
@@ -0,0 +1,70 @@
+let translate_out_big_bit = Sail_values.unsigned
+
+let translate_out_int inst = (Nat_big_num.to_int (translate_out_big_bit inst))
+let translate_out_signed_int inst bits =
+ let i = (Nat_big_num.to_int (translate_out_big_bit inst)) in
+ if (i >= (1 lsl (bits - 1))) then
+ (i - (1 lsl bits)) else
+ i
+
+let translate_out_ireg ireg = IReg (int_to_ireg (translate_out_int ireg))
+
+let translate_out_uop op = match op with
+ | LUI0 -> RISCVLUI
+ | AUIPC -> RISCVAUIPC
+
+let translate_out_bop op = match op with
+ | BEQ0 -> RISCVBEQ
+ | BNE -> RISCVBNE
+ | BLT -> RISCVBLT
+ | BGE -> RISCVBGE
+ | BLTU -> RISCVBLTU
+ | BGEU -> RISCVBGEU
+
+let translate_out_iop op = match op with
+ | ADDI0 -> RISCVADDI
+ | SLTI0 -> RISCVSLTI
+ | SLTIU0 -> RISCVSLTIU
+ | XORI0 -> RISCVXORI
+ | ORI0 -> RISCVORI
+ | ANDI0 -> RISCVANDI
+
+let translate_out_sop op = match op with
+ | SLLI -> RISCVSLLI
+ | SRLI -> RISCVSRLI
+ | SRAI -> RISCVSRAI
+
+let translate_out_rop op = match op with
+ | ADD0 -> RISCVADD
+ | SUB0 -> RISCVSUB
+ | SLL0 -> RISCVSLL
+ | SLT0 -> RISCVSLT
+ | SLTU0 -> RISCVSLTU
+ | XOR0 -> RISCVXOR
+ | SRL0 -> RISCVSRL
+ | SRA0 -> RISCVSRA
+ | OR0 -> RISCVOR
+ | AND0 -> RISCVAND
+
+let translate_out_ropw op = match op with
+ | ADDW -> RISCVADDW
+ | SUBW -> RISCVSUBW
+ | SLLW -> RISCVSLLW
+ | SRLW -> RISCVSRLW
+ | SRAW -> RISCVSRAW
+
+let translate_out_wordWidth op = match op with
+ | BYTE -> RISCVBYTE
+ | HALF -> RISCVHALF
+ | WORD -> RISCVWORD
+ | DOUBLE -> RISCVDOUBLE
+
+let translate_out_bool = function
+ | Sail_values.B1 -> true
+ | Sail_values.B0 -> false
+ | _ -> failwith "translate_out_bool Undef"
+
+let translate_out_simm20 imm = translate_out_signed_int imm 20
+let translate_out_simm12 imm = translate_out_signed_int imm 12
+let translate_out_imm6 imm = translate_out_int imm
+let translate_out_imm5 imm = translate_out_int imm
diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen
new file mode 100644
index 00000000..e778d2a9
--- /dev/null
+++ b/risc-v/hgen/token_types.hgen
@@ -0,0 +1,13 @@
+type token_UTYPE = {op : riscvUop }
+type token_JAL = unit
+type token_JALR = unit
+type token_BType = {op : riscvBop }
+type token_IType = {op : riscvIop }
+type token_ShiftIop = {op : riscvSop }
+type token_RTYPE = {op : riscvRop }
+type token_Load = {unsigned: bool; width : wordWidth }
+type token_Store = {width : wordWidth }
+type token_ADDIW = unit
+type token_SHIFTW = {op : riscvSop }
+type token_RTYPEW = {op : riscvRopw }
+type token_FENCE = unit
diff --git a/risc-v/hgen/tokens.hgen b/risc-v/hgen/tokens.hgen
new file mode 100644
index 00000000..abe6a6c3
--- /dev/null
+++ b/risc-v/hgen/tokens.hgen
@@ -0,0 +1,13 @@
+%token <RISCVHGenBase.token_UTYPE> UTYPE
+%token <RISCVHGenBase.token_JAL> JAL
+%token <RISCVHGenBase.token_JALR> JALR
+%token <RISCVHGenBase.token_BType> BTYPE
+%token <RISCVHGenBase.token_IType> ITYPE
+%token <RISCVHGenBase.token_ShiftIop> SHIFTIOP
+%token <RISCVHGenBase.token_RTYPE> RTYPE
+%token <RISCVHGenBase.token_Load> LOAD
+%token <RISCVHGenBase.token_Store> STORE
+%token <RISCVHGenBase.token_ADDIW> ADDIW
+%token <RISCVHGenBase.token_SHIFTW> SHIFTW
+%token <RISCVHGenBase.token_RTYPEW> RTYPEW
+%token <RISCVHGenBase.token_FENCE> FENCE
diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen
new file mode 100644
index 00000000..c2e3138b
--- /dev/null
+++ b/risc-v/hgen/trans_sail.hgen
@@ -0,0 +1,106 @@
+| `RISCVStopFetching -> ("EBREAK", [], [])
+| `RISCVUTYPE(imm, rd, op) ->
+ ("UTYPE",
+ [
+ translate_imm20 "imm" imm;
+ translate_reg "rd" rd;
+ translate_uop "op" op;
+ ],
+ [])
+| `RISCVJAL(imm, rd) ->
+ ("JAL",
+ [
+ translate_imm20 "imm" imm;
+ translate_reg "rd" rd;
+ ],
+ [])
+| `RISCVJALR(imm, rs, rd) ->
+ ("JALR",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs" rd;
+ translate_reg "rd" rd;
+ ],
+ [])
+| `RISCVBType(imm, rs2, rs1, op) ->
+ ("BTYPE",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs2" rs2;
+ translate_reg "rs1" rs1;
+ translate_bop "op" op;
+ ],
+ [])
+| `RISCVIType(imm, rs1, rd, op) ->
+ ("ITYPE",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs1" rs1;
+ translate_reg "rd" rd;
+ translate_iop "op" op;
+ ],
+ [])
+| `RISCVShiftIop(imm, rs, rd, op) ->
+ ("SHIFTIOP",
+ [
+ translate_imm6 "imm" imm;
+ translate_reg "rs" rs;
+ translate_reg "rd" rd;
+ translate_sop "op" op;
+ ],
+ [])
+| `RISCVRType (rs2, rs1, rd, op) ->
+ ("RTYPE",
+ [
+ translate_reg "rs2" rs2;
+ translate_reg "rs1" rs1;
+ translate_reg "rd" rd;
+ translate_rop "op" op;
+ ],
+ [])
+| `RISCVLoad(imm, rs, rd, unsigned, width) ->
+ ("LOAD",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs" rs;
+ translate_reg "rd" rd;
+ translate_bool "unsigned" unsigned;
+ translate_width "width" width;
+ ],
+ [])
+| `RISCVStore(imm, rs, rd, width) ->
+ ("STORE",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs" rs;
+ translate_reg "rd" rd;
+ translate_width "width" width;
+ ],
+ [])
+| `RISCVADDIW(imm, rs, rd) ->
+ ("ADDIW",
+ [
+ translate_imm12 "imm" imm;
+ translate_reg "rs" rs;
+ translate_reg "rd" rd;
+ ],
+ [])
+| `RISCVSHIFTW(imm, rs, rd, op) ->
+ ("SHIFTW",
+ [
+ translate_imm5 "imm" imm;
+ translate_reg "rs" rs;
+ translate_reg "rd" rd;
+ translate_sop "op" op;
+ ],
+ [])
+| `RISCVRTYPEW(rs2, rs1, rd, op) ->
+ ("RTYPEW",
+ [
+ translate_reg "rs2" rs2;
+ translate_reg "rs1" rs1;
+ translate_reg "rd" rd;
+ translate_ropw "op" op;
+ ],
+ [])
+| `RISCVFENCE -> ("FENCE", [], [])
diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen
new file mode 100644
index 00000000..e31b11f8
--- /dev/null
+++ b/risc-v/hgen/types.hgen
@@ -0,0 +1,116 @@
+type bit20 = int
+type bit12 = int
+type bit6 = int
+type bit5 = int
+
+type riscvUop = (* upper immediate ops *)
+| RISCVLUI
+| RISCVAUIPC
+
+let pp_riscv_uop = function
+| RISCVLUI -> "lui"
+| RISCVAUIPC -> "auipc"
+
+
+type riscvBop = (* branch ops *)
+| RISCVBEQ
+| RISCVBNE
+| RISCVBLT
+| RISCVBGE
+| RISCVBLTU
+| RISCVBGEU
+
+let pp_riscv_bop = function
+| RISCVBEQ -> "beq"
+| RISCVBNE -> "bne"
+| RISCVBLT -> "blt"
+| RISCVBGE -> "bge"
+| RISCVBLTU -> "bltu"
+| RISCVBGEU -> "bgeu"
+
+type riscvIop = (* immediate ops *)
+| RISCVADDI
+| RISCVSLTI
+| RISCVSLTIU
+| RISCVXORI
+| RISCVORI
+| RISCVANDI
+
+let pp_riscv_iop = function
+| RISCVADDI -> "addi"
+| RISCVSLTI -> "slti"
+| RISCVSLTIU -> "sltiu"
+| RISCVXORI -> "xori"
+| RISCVORI -> "ori"
+| RISCVANDI -> "andi"
+
+type riscvSop = (* shift ops *)
+| RISCVSLLI
+| RISCVSRLI
+| RISCVSRAI
+
+let pp_riscv_sop = function
+| RISCVSLLI -> "slli"
+| RISCVSRLI -> "srli"
+| RISCVSRAI -> "srai"
+
+type riscvRop = (* reg-reg ops *)
+| RISCVADD
+| RISCVSUB
+| RISCVSLL
+| RISCVSLT
+| RISCVSLTU
+| RISCVXOR
+| RISCVSRL
+| RISCVSRA
+| RISCVOR
+| RISCVAND
+
+let pp_riscv_rop = function
+| RISCVADD -> "add"
+| RISCVSUB -> "sub"
+| RISCVSLL -> "sll"
+| RISCVSLT -> "slt"
+| RISCVSLTU -> "sltu"
+| RISCVXOR -> "xor"
+| RISCVSRL -> "srl"
+| RISCVSRA -> "sra"
+| RISCVOR -> "or"
+| RISCVAND -> "and"
+
+type riscvRopw = (* reg-reg 32-bit ops *)
+| RISCVADDW
+| RISCVSUBW
+| RISCVSLLW
+| RISCVSRLW
+| RISCVSRAW
+
+let pp_riscv_ropw = function
+| RISCVADDW -> "addw"
+| RISCVSUBW -> "subw"
+| RISCVSLLW -> "sllw"
+| RISCVSRLW -> "srlw"
+| RISCVSRAW -> "sraw"
+
+type wordWidth =
+ | RISCVBYTE
+ | RISCVHALF
+ | RISCVWORD
+ | RISCVDOUBLE
+
+let pp_riscv_load_op (unsigned, width) = match (unsigned, width) with
+ | (false, RISCVBYTE) -> "lb"
+ | (true, RISCVBYTE) -> "lbu"
+ | (false, RISCVHALF) -> "lh"
+ | (true, RISCVHALF) -> "lhu"
+ | (false, RISCVWORD) -> "lw"
+ | (true, RISCVWORD) -> "lwu"
+ | (_, RISCVDOUBLE) -> "ld"
+ | _ -> failwith "unexpected load op"
+
+let pp_riscv_store_op width = match width with
+| RISCVBYTE -> "sb"
+| RISCVHALF -> "sh"
+| RISCVWORD -> "sw"
+| RISCVDOUBLE -> "sd"
+| _ -> failwith "unexpected store op"
diff --git a/risc-v/hgen/types_sail_trans_out.hgen b/risc-v/hgen/types_sail_trans_out.hgen
new file mode 100644
index 00000000..e034cf37
--- /dev/null
+++ b/risc-v/hgen/types_sail_trans_out.hgen
@@ -0,0 +1,83 @@
+let translate_out_big_bit = function
+ | (name, Bvector _, bits) -> IInt.integer_of_bit_list bits
+ | _ -> assert false
+
+let translate_out_int inst = (Nat_big_num.to_int (translate_out_big_bit inst))
+let translate_out_signed_int inst bits =
+ let i = (Nat_big_num.to_int (translate_out_big_bit inst)) in
+ if (i >= (1 lsl (bits - 1))) then
+ (i - (1 lsl bits)) else
+ i
+
+let translate_out_ireg ireg = IReg (int_to_ireg (translate_out_int ireg))
+
+let translate_out_simm20 imm = translate_out_signed_int imm 20
+let translate_out_simm12 imm = translate_out_signed_int imm 12
+let translate_out_imm6 imm = translate_out_int imm
+let translate_out_imm5 imm = translate_out_int imm
+
+let translate_out_bool = function
+ | (name, Bit, [Bitc_one]) -> true
+ | (name, Bit, [Bitc_zero]) -> false
+ | _ -> assert false
+
+let translate_out_enum (name,_,bits) =
+ Nat_big_num.to_int (IInt.integer_of_bit_list bits)
+
+let translate_out_wordWidth w =
+ match translate_out_enum w with
+ | 0 -> RISCVBYTE
+ | 1 -> RISCVHALF
+ | 2 -> RISCVWORD
+ | 3 -> RISCVDOUBLE
+ | _ -> failwith "Unknown wordWidth in sail translate out"
+
+let translate_out_uop op = match translate_out_enum op with
+ | 0 -> RISCVLUI
+ | 1 -> RISCVAUIPC
+ | _ -> failwith "Unknown uop in sail translate out"
+
+let translate_out_bop op = match translate_out_enum op with
+| 0 -> RISCVBEQ
+| 1 -> RISCVBNE
+| 2 -> RISCVBLT
+| 3 -> RISCVBGE
+| 4 -> RISCVBLTU
+| 5 -> RISCVBGEU
+| _ -> failwith "Unknown bop in sail translate out"
+
+let translate_out_iop op = match translate_out_enum op with
+| 0 -> RISCVADDI
+| 1 -> RISCVSLTI
+| 2 -> RISCVSLTIU
+| 3 -> RISCVXORI
+| 4 -> RISCVORI
+| 5 -> RISCVANDI
+| _ -> failwith "Unknown iop in sail translate out"
+
+let translate_out_sop op = match translate_out_enum op with
+| 0 -> RISCVSLLI
+| 1 -> RISCVSRLI
+| 2 -> RISCVSRAI
+| _ -> failwith "Unknown sop in sail translate out"
+
+let translate_out_rop op = match translate_out_enum op with
+| 0 -> RISCVADD
+| 1 -> RISCVSUB
+| 2 -> RISCVSLL
+| 3 -> RISCVSLT
+| 4 -> RISCVSLTU
+| 5 -> RISCVXOR
+| 6 -> RISCVSRL
+| 7 -> RISCVSRA
+| 8 -> RISCVOR
+| 9 -> RISCVAND
+| _ -> failwith "Unknown rop in sail translate out"
+
+let translate_out_ropw op = match translate_out_enum op with
+| 0 -> RISCVADDW
+| 1 -> RISCVSUBW
+| 2 -> RISCVSLLW
+| 3 -> RISCVSRLW
+| 4 -> RISCVSRAW
+| _ -> failwith "Unknown ropw in sail translate out" \ No newline at end of file
diff --git a/risc-v/hgen/types_trans_sail.hgen b/risc-v/hgen/types_trans_sail.hgen
new file mode 100644
index 00000000..9dd36d5e
--- /dev/null
+++ b/risc-v/hgen/types_trans_sail.hgen
@@ -0,0 +1,33 @@
+let translate_enum enum_values name value =
+ let rec bit_count n =
+ if n = 0 then 0
+ else 1 + (bit_count (n lsr 1)) in
+ let rec find_index element = function
+ | h::tail -> if h = element then 0 else 1 + (find_index element tail)
+ | _ -> failwith "translate_enum could not find value"
+ in
+ let size = bit_count (List.length enum_values) in
+ let index = find_index value enum_values in
+ (name, Range0 (Some size), IInt.bit_list_of_integer size (Nat_big_num.of_int index))
+
+let translate_uop = translate_enum [RISCVLUI; RISCVAUIPC]
+let translate_bop = translate_enum [RISCVBEQ; RISCVBNE; RISCVBLT; RISCVBGE; RISCVBLTU; RISCVBGEU] (* branch ops *)
+let translate_iop = translate_enum [RISCVADDI; RISCVSLTI; RISCVSLTIU; RISCVXORI; RISCVORI; RISCVANDI] (* immediate ops *)
+let translate_sop = translate_enum [RISCVSLLI; RISCVSRLI; RISCVSRAI] (* shift ops *)
+let translate_rop = translate_enum [RISCVADD; RISCVSUB; RISCVSLL; RISCVSLT; RISCVSLTU; RISCVXOR; RISCVSRL; RISCVSRA; RISCVOR; RISCVAND] (* reg-reg ops *)
+let translate_ropw = translate_enum [RISCVADDW; RISCVSUBW; RISCVSLLW; RISCVSRLW; RISCVSRAW] (* reg-reg 32-bit ops *)
+let translate_width = translate_enum [RISCVBYTE; RISCVHALF; RISCVWORD; RISCVDOUBLE]
+let translate_reg name value =
+ (name, Bvector (Some 5), bit_list_of_integer 5 (Nat_big_num.of_int (reg_to_int value)))
+let translate_imm20 name value =
+ (name, Bvector (Some 26), bit_list_of_integer 26 (Nat_big_num.of_int value))
+let translate_imm16 name value =
+ (name, Bvector (Some 16), bit_list_of_integer 16 (Nat_big_num.of_int value))
+let translate_imm12 name value =
+ (name, Bvector (Some 12), bit_list_of_integer 12 (Nat_big_num.of_int value))
+let translate_imm6 name value =
+ (name, Bvector (Some 6), bit_list_of_integer 6 (Nat_big_num.of_int value))
+let translate_imm5 name value =
+ (name, Bvector (Some 5), bit_list_of_integer 5 (Nat_big_num.of_int value))
+let translate_bool name value =
+ (name, Bit, [if value then Bitc_one else Bitc_zero])
diff --git a/risc-v/risc-v.sail b/risc-v/riscv.sail
index edf95c62..e464c5f7 100644
--- a/risc-v/risc-v.sail
+++ b/risc-v/riscv.sail
@@ -55,6 +55,7 @@ function unit wGPR((regno) r, (regval) v) =
val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr
val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea
val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval
+val extern unit -> unit effect { barr } MEM_sync
(* Ideally these would be sail builtin *)
function (bit[64]) shift_right_arith64 ((bit[64]) v, (bit[6]) shift) =
@@ -72,6 +73,8 @@ typedef sop = enumerate {SLLI; SRLI; SRAI} (* shift ops *)
typedef rop = enumerate {ADD; SUB; SLL; SLT; SLTU; XOR; SRL; SRA; OR; AND} (* reg-reg ops *)
typedef ropw = enumerate {ADDW; SUBW; SLLW; SRLW; SRAW} (* reg-reg 32-bit ops *)
+typedef word_width = enumerate {BYTE; HALF; WORD; DOUBLE}
+
scattered function unit execute
scattered typedef ast = const union
@@ -126,7 +129,7 @@ function clause execute (BTYPE(imm, rs2, rs1, op)) =
case BLT -> rs1_val <_s rs2_val
case BGE -> rs1_val >=_s rs2_val
case BLTU -> rs1_val <_u rs2_val
- case BGEU -> rs1_val >= rs2_val (* XXX is this signed or unsigned? *)
+ case BGEU -> unsigned(rs1_val) >= unsigned(rs2_val) (* XXX sail missing >=_u *)
} in
if (taken) then
nextPC := PC + EXTS(imm : 0b0)
@@ -192,31 +195,52 @@ function clause execute (RTYPE(rs2, rs1, rd, op)) =
} in
wGPR(rd, result)
-union ast member ((bit[12]), regno, regno, bool, [|8|]) LOAD
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, 1))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, 2))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, 4))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, 8))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, 1))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, 2))
-function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, 4))
+union ast member ((bit[12]), regno, regno, bool, word_width) LOAD
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, DOUBLE))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF))
+function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD))
function clause execute(LOAD(imm, rs1, rd, unsigned, width)) =
let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in
let (bit[64]) result = if unsigned then
- EXTZ(MEMr(addr, width))
+ switch (width) {
+ case BYTE -> EXTZ(MEMr(addr, 1))
+ case WORD -> EXTZ(MEMr(addr, 2))
+ case HALF -> EXTZ(MEMr(addr, 4))
+ case DOUBLE -> MEMr(addr, 8)
+ }
else
- EXTS(MEMr(addr, width)) in
+ switch (width) {
+ case BYTE -> EXTS(MEMr(addr, 1))
+ case WORD -> EXTS(MEMr(addr, 2))
+ case HALF -> EXTS(MEMr(addr, 4))
+ case DOUBLE -> MEMr(addr, 8)
+ } in
wGPR(rd, result)
-union ast member ((bit[12]), regno, regno, [|8|]) STORE
-function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, 1))
-function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, 2))
-function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, 4))
-function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, 8))
+union ast member ((bit[12]), regno, regno, word_width) STORE
+function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE))
+function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF))
+function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD))
+function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE))
function clause execute (STORE(imm, rs2, rs1, width)) =
let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in {
- MEMea(addr, width);
- MEMval(addr, width, rGPR(rs2));
+ switch (width) {
+ case BYTE -> MEMea(addr, 1)
+ case WORD -> MEMea(addr, 2)
+ case HALF -> MEMea(addr, 4)
+ case DOUBLE -> MEMea(addr, 8)
+ };
+ let rs2_val = rGPR(rs2) in
+ switch (width) {
+ case BYTE -> MEMval(addr, 1, rs2_val)
+ case WORD -> MEMval(addr, 2, rs2_val)
+ case HALF -> MEMval(addr, 4, rs2_val)
+ case DOUBLE -> MEMval(addr, 8, rs2_val)
+ }
}
union ast member ((bit[12]), regno, regno) ADDIW
@@ -258,6 +282,27 @@ function clause execute (RTYPEW(rs2, rs1, rd, op)) =
} in
wGPR(rd, EXTS(result))
+union ast member (bit[4], bit[4]) FENCE
+function clause decode (0b0000 : (bit[4]) pred : (bit[4]) succ : 0b00000 : 0b000 : 0b00000 : 0b0001111) = Some(FENCE (pred, succ))
+function clause execute (FENCE(pred, succ)) = {
+ MEM_sync(); (* XXX use pred and succ *)
+}
+
+union ast member unit FENCEI
+function clause decode (0b0000 : 0b0000 : 0b0000 : 0b00000 : 0b001 : 0b00000 : 0b0001111) = Some(FENCEI)
+function clause execute FENCEI = () (* XXX TODO *)
+
+union ast member unit ECALL
+function clause decode (0b000000000000 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(ECALL ())
+function clause execute ECALL = ()
+
+union ast member unit EBREAK
+function clause decode (0b000000000001 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(EBREAK ())
+function clause execute EBREAK = { exit () }
+
+
+function clause decode _ = None
+
end ast
end decode
end execute
diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem
new file mode 100644
index 00000000..c09c85c2
--- /dev/null
+++ b/risc-v/riscv_extras.lem
@@ -0,0 +1,58 @@
+open import Pervasives
+open import Interp_ast
+open import Interp_interface
+open import Sail_impl_base
+open import Interp_inter_imp
+import Set_extra
+
+let memory_parameter_transformer mode v =
+ match v with
+ | Interp_ast.V_tuple [location;length] ->
+ let (v,loc_regs) = extern_with_track mode extern_vector_value location in
+
+ match length with
+ | Interp_ast.V_lit (L_aux (L_num len) _) ->
+ (v,(natFromInteger len),loc_regs)
+ | Interp_ast.V_track (Interp_ast.V_lit (L_aux (L_num len) _)) size_regs ->
+ match loc_regs with
+ | Nothing -> (v,(natFromInteger len),Just (List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs)))
+ | Just loc_regs -> (v,(natFromInteger len),Just (loc_regs++(List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs))))
+ end
+ | _ -> Assert_extra.failwith "expected 'V_lit (L_aux (L_num _) _)' or 'V_track (V_lit (L_aux (L_num len) _)) _'"
+ end
+ | _ -> Assert_extra.failwith ("memory_parameter_transformer: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
+ end
+
+let memory_parameter_transformer_option_address _mode v =
+ match v with
+ | Interp_ast.V_tuple [location;_] ->
+ Just (extern_vector_value location)
+ | _ -> Assert_extra.failwith ("memory_parameter_transformer_option_address: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
+ end
+
+
+let read_memory_functions : memory_reads =
+ [ ("MEMr", (MR Read_plain memory_parameter_transformer));
+ ("MEMr_reserve", (MR Read_reserve memory_parameter_transformer));
+ ]
+
+let memory_writes : memory_writes =
+ []
+
+let memory_eas : memory_write_eas =
+ [ ("MEMea", (MEA Write_plain memory_parameter_transformer));
+ ("MEMea_conditional", (MEA Write_conditional memory_parameter_transformer));
+ ]
+
+let memory_vals : memory_write_vals =
+ [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing));
+ ("MEMval_conditional", (MV memory_parameter_transformer_option_address
+ (Just
+ (fun (IState interp context) b ->
+ let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in
+ (IState (Interp.add_answer_to_stack interp bit) context)))));
+ ]
+
+let barrier_functions = [
+ ("MEM_sync", Barrier_MIPS_SYNC);
+ ]
diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem
new file mode 100644
index 00000000..cbc8bd0d
--- /dev/null
+++ b/risc-v/riscv_extras_embed.lem
@@ -0,0 +1,32 @@
+open import Pervasives
+open import Pervasives_extra
+open import Sail_impl_base
+open import Sail_values
+open import Prompt
+
+val MEMr : (vector bitU * integer) -> M (vector bitU)
+val MEMr_reserve : (vector bitU * integer) -> M (vector bitU)
+
+let MEMr (addr,size) = read_mem false Read_plain addr size
+let MEMr_reserve (addr,size) = read_mem false Read_reserve addr size
+
+val MEMea : (vector bitU * integer) -> M unit
+val MEMea_conditional : (vector bitU * integer) -> M unit
+
+let MEMea (addr,size) = write_mem_ea Write_plain addr size
+let MEMea_conditional (addr,size) = write_mem_ea Write_conditional addr size
+
+val MEMval : (vector bitU * integer * vector bitU) -> M unit
+val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU
+
+let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return ()
+let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0)
+
+val MEM_sync : unit -> M unit
+
+let MEM_sync () = barrier Barrier_Isync
+
+let duplicate (bit,len) =
+ let bits = repeat [bit] len in
+ let start = len - 1 in
+ Vector bits start false
diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem
new file mode 100644
index 00000000..7fb62161
--- /dev/null
+++ b/risc-v/riscv_extras_embed_sequential.lem
@@ -0,0 +1,34 @@
+open import Pervasives
+open import Pervasives_extra
+open import Sail_impl_base
+open import Sail_values
+open import State
+
+val MEMr : (vector bitU * integer) -> M (vector bitU)
+val MEMr_reserve : (vector bitU * integer) -> M (vector bitU)
+
+let MEMr (addr,size) = read_mem false Read_plain addr size
+let MEMr_reserve (addr,size) = read_mem false Read_reserve addr size
+
+val MEMea : (vector bitU * integer) -> M unit
+val MEMea_conditional : (vector bitU * integer) -> M unit
+
+let MEMea (addr,size) = write_mem_ea Write_plain addr size
+let MEMea_conditional (addr,size) = write_mem_ea Write_conditional addr size
+
+
+val MEMval : (vector bitU * integer * vector bitU) -> M unit
+val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU
+
+let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return ()
+let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0)
+
+val MEM_sync : unit -> M unit
+
+let MEM_sync () = barrier Barrier_MIPS_SYNC
+
+
+let duplicate (bit,len) =
+ let bits = repeat [bit] len in
+ let start = len - 1 in
+ Vector bits start false
diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail
new file mode 100644
index 00000000..0c7a67d8
--- /dev/null
+++ b/risc-v/riscv_regfp.sail
@@ -0,0 +1,84 @@
+let (vector <0, 32, inc, string >) GPRstr =
+ [ "x0", "x1", "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9", "x10",
+ "x11", "x12", "x13", "x14", "x15", "x16", "x17", "x18", "x19", "x20",
+ "x21", "x22", "x23", "x24", "x25", "x26", "x27", "x28", "x29", "x30", "x31"
+ ]
+
+let CIA_fp = RFull("CIA")
+let NIA_fp = RFull("NIA")
+
+function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis (instr) = {
+ iR := [|| ||];
+ oR := [|| ||];
+ aR := [|| ||];
+ ik := IK_simple;
+ Nias := [|| NIAFP_successor ||];
+ Dia := DIAFP_none;
+
+ switch instr {
+ case (EBREAK) -> ()
+ case (UTYPE ( imm, rd, op)) -> {
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (JAL ( imm, rd)) -> {
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ let (bit[64]) offset = EXTS(imm) in
+ Nias := [|| NIAFP_concrete_address (PC + offset) ||]
+ }
+ case (JALR ( imm, rs, rd)) -> {
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ let (bit[64]) offset = EXTS(imm) in
+ Nias := [|| NIAFP_register (RFull(GPRstr[rs])) ||]; (* XXX this should br rs + offset... *)
+ }
+ case (BTYPE ( imm, rs2, rs1, op)) -> {
+ if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR;
+ if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR;
+ ik := IK_cond_branch;
+ let (bit[64]) offset = EXTS(imm) in
+ Nias := NIAFP_concrete_address(PC + offset) :: Nias;
+ }
+ case (ITYPE ( imm, rs, rd, op)) -> {
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (SHIFTIOP ( imm, rs, rd, op)) -> {
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (RTYPE ( rs2, rs1, rd, op)) -> {
+ if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR;
+ if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (LOAD ( imm, rs, rd, unsign, width)) -> { (* XXX "unsigned" causes name conflict in lem shallow embedding... *)
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ aR := iR;
+ ik := IK_mem_read (Read_plain);
+ }
+ case (STORE( imm, rs2, rs1, width)) -> {
+ if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR;
+ if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR;
+ if (rs1 == 0) then () else aR := RFull(GPRstr[rs1]) :: aR;
+ ik := IK_mem_write (Write_plain);
+ }
+ case (ADDIW ( imm, rs, rd)) -> {
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (SHIFTW ( imm, rs, rd, op)) -> {
+ if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (RTYPEW ( rs2, rs1, rd, op))-> {
+ if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR;
+ if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR;
+ if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR;
+ }
+ case (FENCE(pred, succ)) -> {
+ ik := IK_barrier (Barrier_MIPS_SYNC);
+ }
+ };
+ (iR,oR,aR,Nias,Dia,ik)
+}
diff --git a/src/gen_lib/sail_values.lem b/src/gen_lib/sail_values.lem
index b4a15432..53a74d05 100644
--- a/src/gen_lib/sail_values.lem
+++ b/src/gen_lib/sail_values.lem
@@ -378,7 +378,7 @@ let hardware_quot (a:integer) (b:integer) : integer =
if ((a<0) = (b<0)) then
q (* same sign -- result positive *)
else
- ~q (* different sign -- result negative *)
+ integerNegate q (* different sign -- result negative *)
let quot_signed = hardware_quot
diff --git a/src/lem_interp/interp_interface.lem b/src/lem_interp/interp_interface.lem
index 937db466..dcc9f537 100644
--- a/src/lem_interp/interp_interface.lem
+++ b/src/lem_interp/interp_interface.lem
@@ -259,7 +259,7 @@ type outcome =
(* Functions to build up the initial state for interpretation *)
-val build_context : specification -> memory_reads -> memory_read_taggeds-> memory_writes -> memory_write_eas -> memory_write_vals -> memory_write_vals_tagged -> barriers -> excl_res -> external_functions -> context
+val build_context : bool -> specification -> memory_reads -> memory_read_taggeds-> memory_writes -> memory_write_eas -> memory_write_vals -> memory_write_vals_tagged -> barriers -> excl_res -> external_functions -> context
val initial_instruction_state : context -> string -> list register_value -> instruction_state
(* string is a function name, list of value are the parameters to that function *)
diff --git a/src/lem_interp/run_with_elf.ml b/src/lem_interp/run_with_elf.ml
index d48b7e7b..2a1783db 100644
--- a/src/lem_interp/run_with_elf.ml
+++ b/src/lem_interp/run_with_elf.ml
@@ -1292,7 +1292,7 @@ let run () =
startaddr,
startaddr_internal), pp_symbol_map) = initial_system_state_of_elf_file !file in
- let context = build_context isa_defs isa_m0 [] isa_m1 isa_m2 isa_m3 [] isa_m4 None isa_externs in
+ let context = build_context false isa_defs isa_m0 [] isa_m1 isa_m2 isa_m3 [] isa_m4 None isa_externs in
(*NOTE: this is likely MIPS specific, so should probably pull from initial_system_state info on to translate or not,
endian mode, and translate function name
*)
diff --git a/src/lem_interp/run_with_elf_cheri.ml b/src/lem_interp/run_with_elf_cheri.ml
index eaf8ddfa..e773bf5b 100644
--- a/src/lem_interp/run_with_elf_cheri.ml
+++ b/src/lem_interp/run_with_elf_cheri.ml
@@ -1386,7 +1386,7 @@ let run () =
startaddr,
startaddr_internal), pp_symbol_map) = initial_system_state_of_elf_file !file in
- let context = build_context isa_defs isa_m0 isa_m1 isa_m2 isa_m3 isa_m4 isa_m5 isa_m6 None isa_externs in
+ let context = build_context false isa_defs isa_m0 isa_m1 isa_m2 isa_m3 isa_m4 isa_m5 isa_m6 None isa_externs in
(*NOTE: this is likely MIPS specific, so should probably pull from initial_system_state info on to translate or not,
endian mode, and translate function name
*)
diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml
index eca6d342..cd2e7312 100644
--- a/src/lem_interp/run_with_elf_cheri128.ml
+++ b/src/lem_interp/run_with_elf_cheri128.ml
@@ -1386,7 +1386,7 @@ let run () =
startaddr,
startaddr_internal), pp_symbol_map) = initial_system_state_of_elf_file !file in
- let context = build_context isa_defs isa_m0 isa_m1 isa_m2 isa_m3 isa_m4 isa_m5 isa_m6 None isa_externs in
+ let context = build_context false isa_defs isa_m0 isa_m1 isa_m2 isa_m3 isa_m4 isa_m5 isa_m6 None isa_externs in
(*NOTE: this is likely MIPS specific, so should probably pull from initial_system_state info on to translate or not,
endian mode, and translate function name
*)
diff --git a/src/test/lib/run_test_interp.ml b/src/test/lib/run_test_interp.ml
index 3446ef9f..5f2ace1b 100644
--- a/src/test/lib/run_test_interp.ml
+++ b/src/test/lib/run_test_interp.ml
@@ -45,7 +45,7 @@ open Interp_inter_imp ;;
open Sail_impl_base ;;
let doit () =
- let context = build_context Test_lem_ast.defs [] [] [] [] [] [] [] None [] in
+ let context = build_context false Test_lem_ast.defs [] [] [] [] [] [] [] None [] in
translate_address context E_little_endian "run" None (address_of_integer (Nat_big_num.of_int 0));;
doit () ;;