diff options
Diffstat (limited to 'riscv')
62 files changed, 0 insertions, 9934 deletions
diff --git a/riscv/.gitignore b/riscv/.gitignore deleted file mode 100644 index 52f3767a..00000000 --- a/riscv/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -riscv.lem -riscv_types.lem -riscvScript.sml -riscv_extrasScript.sml -riscv_typesScript.sml diff --git a/riscv/Holmakefile b/riscv/Holmakefile deleted file mode 100644 index 8269bc36..00000000 --- a/riscv/Holmakefile +++ /dev/null @@ -1,11 +0,0 @@ -LEMDIR=../../lem/hol-lib - -INCLUDES = $(LEMDIR) ../lib/hol - -all: riscvTheory.uo -.PHONY: all - -ifdef POLY -BASE_HEAP = ../lib/hol/sail-heap - -endif diff --git a/riscv/Makefile b/riscv/Makefile deleted file mode 100644 index 52883c21..00000000 --- a/riscv/Makefile +++ /dev/null @@ -1,160 +0,0 @@ -SAIL_SEQ_INST = riscv.sail riscv_jalr_seq.sail -SAIL_RMEM_INST = riscv.sail riscv_jalr_rmem.sail - -SAIL_SEQ_INST_SRCS = riscv_insts_begin.sail $(SAIL_SEQ_INST) riscv_insts_end.sail -SAIL_RMEM_INST_SRCS = riscv_insts_begin.sail $(SAIL_RMEM_INST) riscv_insts_end.sail - -# non-instruction sources -SAIL_OTHER_SRCS = prelude.sail riscv_types.sail riscv_sys.sail riscv_platform.sail riscv_mem.sail riscv_vmem.sail -SAIL_OTHER_RVFI_SRCS = prelude.sail rvfi_dii.sail riscv_types.sail riscv_sys.sail riscv_platform.sail riscv_mem.sail riscv_vmem.sail - -SAIL_SRCS = $(SAIL_OTHER_SRCS) $(SAIL_SEQ_INST_SRCS) riscv_step.sail riscv_analysis.sail -SAIL_RMEM_SRCS = $(SAIL_OTHER_SRCS) $(SAIL_RMEM_INST_SRCS) riscv_step.sail riscv_analysis.sail -SAIL_RVFI_SRCS = $(SAIL_OTHER_RVFI_SRCS) $(SAIL_SEQ_INST_SRCS) riscv_step.sail riscv_analysis.sail - -PLATFORM_OCAML_SRCS = platform.ml platform_impl.ml platform_main.ml -SAIL_DIR ?= $(realpath ..) -SAIL ?= $(SAIL_DIR)/sail -C_WARNINGS ?= -#-Wall -Wextra -Wno-unused-label -Wno-unused-parameter -Wno-unused-but-set-variable -Wno-unused-function -C_INCS = riscv_prelude.h riscv_platform_impl.h riscv_platform.h -C_SRCS = riscv_prelude.c riscv_platform_impl.c riscv_platform.c - -C_FLAGS = -I ../lib -C_LIBS = -lgmp -lz - -# The C simulator can be built to be linked against Spike for tandem-verification. -# This needs the C bindings to Spike from https://github.com/SRI-CSL/l3riscv -# TV_SPIKE_DIR in the environment should point to the top-level dir of the L3 -# RISC-V, containing the built C bindings to Spike. -# RISCV should be defined if TV_SPIKE_DIR is. -ifneq (,$(TV_SPIKE_DIR)) -C_FLAGS += -I $(TV_SPIKE_DIR)/src/cpp -DENABLE_SPIKE -C_LIBS += -L $(TV_SPIKE_DIR) -ltv_spike -Wl,-rpath=$(TV_SPIKE_DIR) -C_LIBS += -L $(RISCV)/lib -lfesvr -lriscv -Wl,-rpath=$(RISCV)/lib -endif - -export SAIL_DIR - -all: platform Riscv.thy - -check: $(SAIL_SRCS) main.sail Makefile - $(SAIL) $(SAIL_FLAGS) $(SAIL_SRCS) main.sail - -interpret: $(SAIL_SRCS) - $(SAIL) -i $(SAIL_FLAGS) $(SAIL_SRCS) main.sail - -cgen: $(SAIL_SRCS) - $(SAIL) -cgen $(SAIL_FLAGS) $(SAIL_SRCS) main.sail - -_sbuild/riscv.ml: $(SAIL_SRCS) Makefile main.sail - $(SAIL) $(SAIL_FLAGS) -ocaml -ocaml-nobuild -o riscv $(SAIL_SRCS) - -_sbuild/platform_main.native: _sbuild/riscv.ml _tags $(PLATFORM_OCAML_SRCS) Makefile - cp _tags $(PLATFORM_OCAML_SRCS) _sbuild - cd _sbuild && ocamlbuild -use-ocamlfind platform_main.native - -_sbuild/coverage.native: _sbuild/riscv.ml _tags.bisect $(PLATFORM_OCAML_SRCS) Makefile - cp $(PLATFORM_OCAML_SRCS) _sbuild - cp _tags.bisect _sbuild/_tags - cd _sbuild && ocamlbuild -use-ocamlfind platform_main.native && cp -L platform_main.native coverage.native - -platform: _sbuild/platform_main.native - rm -f $@ && ln -s $^ $@ - -coverage: _sbuild/coverage.native - rm -f platform && ln -s $^ platform # since the test scripts runs this file - rm -rf bisect*.out bisect coverage - ../test/riscv/run_tests.sh # this will generate bisect*.out files in this directory - mkdir bisect && mv bisect*.out bisect/ - mkdir coverage && bisect-ppx-report -html coverage/ -I _sbuild/ bisect/bisect*.out - -riscv.c: $(SAIL_SRCS) main.sail Makefile - $(SAIL) $(SAIL_FLAGS) -O -memo_z3 -c -c_include riscv_prelude.h -c_include riscv_platform.h $(SAIL_SRCS) main.sail 1> $@ - -riscv_c: riscv.c $(C_INCS) $(C_SRCS) Makefile - gcc $(C_WARNINGS) -O2 riscv.c $(C_SRCS) ../lib/*.c -lgmp -lz -I ../lib -o riscv_c - -riscv_model.c: $(SAIL_SRCS) main.sail Makefile - $(SAIL) $(SAIL_FLAGS) -O -memo_z3 -c -c_include riscv_prelude.h -c_include riscv_platform.h -c_no_main $(SAIL_SRCS) main.sail 1> $@ - -riscv_sim: riscv_model.c riscv_sim.c $(C_INCS) $(C_SRCS) $(CPP_SRCS) Makefile - gcc -g $(C_WARNINGS) $(C_FLAGS) -O2 riscv_model.c riscv_sim.c $(C_SRCS) ../lib/*.c $(C_LIBS) -o $@ - -riscv_rvfi_model.c: $(SAIL_RVFI_SRCS) main_rvfi.sail Makefile - $(SAIL) -O -memo_z3 -c -c_include riscv_prelude.h -c_include riscv_platform.h -c_no_main $(SAIL_RVFI_SRCS) main_rvfi.sail 1> $@ - -riscv_rvfi: riscv_rvfi_model.c riscv_sim.c $(C_INCS) $(C_SRCS) $(CPP_SRCS) Makefile - gcc -g $(C_WARNINGS) $(C_FLAGS) -O2 riscv_rvfi_model.c -DRVFI_DII riscv_sim.c $(C_SRCS) ../lib/*.c $(C_LIBS) -o $@ - -latex: $(SAIL_SRCS) Makefile - $(SAIL) -latex -latex_prefix sail -o sail_ltx $(SAIL_SRCS) - -tracecmp: tracecmp.ml - ocamlfind ocamlopt -annot -linkpkg -package unix $^ -o $@ - -riscv_duopod_ocaml: prelude.sail riscv_duopod.sail - $(SAIL) $(SAIL_FLAGS) -ocaml -o $@ $^ - -riscv_duopod.lem: prelude.sail riscv_duopod.sail - $(SAIL) $(SAIL_FLAGS) -lem -lem_mwords -lem_lib Riscv_extras -o riscv_duopod $^ -Riscv_duopod.thy: riscv_duopod.lem riscv_extras.lem - lem -isa -outdir . -lib Sail=../src/lem_interp -lib Sail=../src/gen_lib \ - riscv_extras.lem \ - riscv_duopod_types.lem \ - riscv_duopod.lem - -riscv_duopod: riscv_duopod_ocaml Riscv_duopod.thy - -Riscv.thy: riscv.lem riscv_extras.lem - lem -isa -outdir . -lib Sail=../src/lem_interp -lib Sail=../src/gen_lib \ - riscv_extras.lem \ - riscv_types.lem \ - riscv.lem - sed -i 's/datatype ast/datatype (plugins only: size) ast/' Riscv_types.thy - -riscv.lem: $(SAIL_SRCS) Makefile - $(SAIL) $(SAIL_FLAGS) -lem -o riscv -lem_mwords -lem_lib Riscv_extras $(SAIL_SRCS) - -riscv_sequential.lem: $(SAIL_SRCS) Makefile - $(SAIL_DIR)/sail -lem -lem_sequential -o riscv_sequential -lem_mwords -lem_lib Riscv_extras_sequential $(SAIL_SRCS) - -riscvScript.sml : riscv.lem riscv_extras.lem - lem -hol -outdir . -lib ../lib/hol -i ../lib/hol/sail2_prompt_monad.lem -i ../lib/hol/sail2_prompt.lem \ - -lib ../src/lem_interp -lib ../src/gen_lib \ - riscv_extras.lem \ - riscv_types.lem \ - riscv.lem - -riscvTheory.uo riscvTheory.ui: riscvScript.sml - Holmake riscvTheory.uo - -COQ_LIBS = -R ../../bbv/theories bbv -R ../lib/coq Sail - -riscv.v riscv_types.v: $(SAIL_SRCS) - $(SAIL) $(SAIL_FLAGS) -dcoq_undef_axioms -coq -o riscv -coq_lib riscv_extras $(SAIL_SRCS) -riscv_duopod.v riscv_duopod_types.v: prelude.sail riscv_duopod.sail - $(SAIL) $(SAIL_FLAGS) -dcoq_undef_axioms -coq -o riscv_duopod -coq_lib riscv_extras $^ -%.vo: %.v - coqc $(COQ_LIBS) $< -riscv.vo: riscv_types.vo riscv_extras.vo -riscv_duopod.vo: riscv_duopod_types.vo riscv_extras.vo - -# we exclude prelude.sail here, most code there should move to sail lib -LOC_FILES:=$(SAIL_SRCS) main.sail -include ../etc/loc.mk - -clean: - -rm -rf riscv _sbuild - -rm -f riscv.lem riscv_types.lem - -rm -f Riscv.thy Riscv_types.thy \ - Riscv_extras.thy - -rm -f Riscv_duopod.thy Riscv_duopod_types.thy riscv_duopod.lem riscv_duopod_types.lem - -rm -f riscvScript.sml riscv_typesScript.sml riscv_extrasScript.sml - -rm -f platform_main.native platform coverage.native - -rm -f riscv.vo riscv_types.vo riscv_extras.vo riscv.v riscv_types.v - -rm -f riscv_duopod.vo riscv_duopod_types.vo riscv_duopod.v riscv_duopod_types.v - -rm -f riscv.c riscv_model.c riscv_sim - -rm -f riscv_rvfi_model.c riscv_rvfi - -Holmake cleanAll - ocamlbuild -clean diff --git a/riscv/README b/riscv/README deleted file mode 100644 index 2748c897..00000000 --- a/riscv/README +++ /dev/null @@ -1,3 +0,0 @@ - -Please use the repository at -https://github.com/rems-project/sail-riscv diff --git a/riscv/ROOT b/riscv/ROOT deleted file mode 100644 index ea74bca1..00000000 --- a/riscv/ROOT +++ /dev/null @@ -1,9 +0,0 @@ -session "Sail-RISC-V" = "Sail" + - options [document = false] - theories - Riscv_lemmas - -session "Sail-RISC-V-Duopod" = "Sail" + - options [document = false] - theories - Riscv_duopod_lemmas diff --git a/riscv/_tags b/riscv/_tags deleted file mode 100644 index eab7e89a..00000000 --- a/riscv/_tags +++ /dev/null @@ -1,3 +0,0 @@ -<**/*.ml>: bin_annot, annot -<*.m{l,li}>: package(lem), package(linksem), package(zarith) -<platform_main.native>: package(lem), package(linksem), package(zarith) diff --git a/riscv/_tags.bisect b/riscv/_tags.bisect deleted file mode 100644 index d3b996f2..00000000 --- a/riscv/_tags.bisect +++ /dev/null @@ -1,3 +0,0 @@ -<**/*.ml>: bin_annot, annot -<*.m{l,li}>: package(lem), package(linksem), package(zarith), package(bisect_ppx) -<platform_main.native>: package(lem), package(linksem), package(zarith), package(bisect_ppx) diff --git a/riscv/coq.patch b/riscv/coq.patch deleted file mode 100644 index 829466e8..00000000 --- a/riscv/coq.patch +++ /dev/null @@ -1,335 +0,0 @@ ---- riscv.v.plain 2018-11-20 14:53:45.400922942 +0000 -+++ riscv.v 2018-11-20 15:08:45.661714873 +0000 -@@ -1260,6 +1260,9 @@ - let v64 : bits 64 := EXTS 64 v in - subrange_vec_dec (shift_bits_right v64 shift) 31 0. - -+Definition n_leading_spaces s : {n : Z & ArithFact (n >= 0)} := -+ build_ex (Z.of_nat (n_leading_spaces s)). -+(* - Fixpoint n_leading_spaces (s : string) - : {n : Z & ArithFact (n >= 0)} := - build_ex(let p0_ := s in -@@ -1273,7 +1276,7 @@ - (string_drop s - (build_ex 1))))))) - : {n : Z & ArithFact (n >= 0)})))) -- else 0). -+ else 0).*) - - Definition spc_forwards '(tt : unit) : string := " ". - -@@ -1284,7 +1287,7 @@ - let 'n := projT1 (n_leading_spaces s) in - let p0_ := n in - if sumbool_of_bool ((Z.eqb p0_ 0)) then None -- else Some ((tt, n)). -+ else Some ((tt, build_ex n)). - - Definition opt_spc_forwards '(tt : unit) : string := "". - -@@ -10451,14 +10454,13 @@ - returnm ((EXTZ 56 (shiftl (_get_Satp64_PPN satp64) PAGESIZE_BITS)) - : mword 56). - --Fixpoint walk39 (vaddr : mword 39) (ac : AccessType) (priv : Privilege) (mxr : bool) (do_sum : bool) (ptb : mword 56) '(existT _ level _ : {n : Z & ArithFact (n >= -- 0)}) (global : bool) -+Fixpoint walk39 (vaddr : mword 39) (ac : AccessType) (priv : Privilege) (mxr : bool) (do_sum : bool) (ptb : mword 56) (level : nat) (global : bool) - : M (PTW_Result) := - let va := Mk_SV39_Vaddr vaddr in - let pt_ofs : paddr39 := - shiftl - (EXTZ 56 -- (subrange_vec_dec (shiftr (_get_SV39_Vaddr_VPNi va) (Z.mul level SV39_LEVEL_BITS)) -+ (subrange_vec_dec (shiftr (_get_SV39_Vaddr_VPNi va) (Z.mul (Z.of_nat level) SV39_LEVEL_BITS)) - (projT1 (sub_range (build_ex SV39_LEVEL_BITS) (build_ex 1))) 0)) PTE39_LOG_SIZE in - let pte_addr := add_vec ptb pt_ofs in - (phys_mem_read Data (EXTZ 64 pte_addr) 8 false false false) >>= fun w__0 : MemoryOpResult (mword (8 * 8)) => -@@ -10471,27 +10473,27 @@ - let is_global := orb global (eq_vec (_get_PTE_Bits_G pattr) ((bool_to_bits true) : mword 1)) in - (if ((isInvalidPTE pbits)) then returnm ((PTW_Failure (PTW_Invalid_PTE)) : PTW_Result ) - else if ((isPTEPtr pbits)) then -- (if sumbool_of_bool ((Z.eqb level 0)) then -+ (match level with O => - returnm ((PTW_Failure - (PTW_Invalid_PTE)) - : PTW_Result ) -- else -+ | S level' => - (walk39 vaddr ac priv mxr do_sum - (EXTZ 56 (shiftl (_get_SV39_PTE_PPNi pte) PAGESIZE_BITS)) -- (build_ex (projT1 (sub_range (build_ex level) (build_ex 1)))) is_global) -- : M (PTW_Result)) -+ level' is_global) -+ : M (PTW_Result) end) - : M (PTW_Result) - else - (checkPTEPermission ac priv mxr do_sum pattr) >>= fun w__3 : bool => - returnm ((if ((negb w__3)) then PTW_Failure (PTW_No_Permission) -- else if sumbool_of_bool ((Z.gtb level 0)) then -+ else if sumbool_of_bool (Nat.ltb O level) then - let mask := - sub_vec_int - (shiftl - (xor_vec (_get_SV39_PTE_PPNi pte) - (xor_vec (_get_SV39_PTE_PPNi pte) - (EXTZ 44 (vec_of_bits [B1] : mword 1)))) -- (Z.mul level SV39_LEVEL_BITS)) 1 in -+ (Z.mul (Z.of_nat level) SV39_LEVEL_BITS)) 1 in - if ((neq_vec (and_vec (_get_SV39_PTE_PPNi pte) mask) - (EXTZ 44 (vec_of_bits [B0] : mword 1)))) then - PTW_Failure -@@ -10501,10 +10503,10 @@ - or_vec (_get_SV39_PTE_PPNi pte) - (and_vec (EXTZ 44 (_get_SV39_Vaddr_VPNi va)) mask) in - PTW_Success -- ((concat_vec ppn (_get_SV39_Vaddr_PgOfs va), pte, pte_addr, build_ex level, is_global)) -+ ((concat_vec ppn (_get_SV39_Vaddr_PgOfs va), pte, pte_addr, build_ex (Z.of_nat level), is_global)) - else - PTW_Success -- ((concat_vec (_get_SV39_PTE_PPNi pte) (_get_SV39_Vaddr_PgOfs va), pte, pte_addr, build_ex level, is_global))) -+ ((concat_vec (_get_SV39_PTE_PPNi pte) (_get_SV39_Vaddr_PgOfs va), pte, pte_addr, build_ex (Z.of_nat level), is_global))) - : PTW_Result)) - : M (PTW_Result) - end) -@@ -10630,7 +10632,7 @@ - : M (TR39_Result) - | None => - (curPTB39 tt) >>= fun w__6 : mword 56 => -- (walk39 vAddr ac priv mxr do_sum w__6 (build_ex level) false) >>= fun w__7 : PTW_Result => -+ (walk39 vAddr ac priv mxr do_sum w__6 (Z.to_nat level) false) >>= fun w__7 : PTW_Result => - (match w__7 with - | PTW_Failure (f) => returnm ((TR39_Failure (f)) : TR39_Result ) - | PTW_Success (pAddr,pte,pteAddr,(existT _ level _),global) => -@@ -14670,138 +14672,144 @@ - returnm (true - : bool). - --Fixpoint execute (merge_var : ast) --: M (bool) := -- match merge_var with -+Definition expand_ast (i : ast) : ast := -+match i with - | C_ADDI4SPN (rdc,nzimm) => - let imm : bits 12 := - concat_vec (vec_of_bits [B0;B0] : mword 2) - (concat_vec nzimm (vec_of_bits [B0;B0] : mword 2)) in - let rd := creg2reg_bits rdc in -- (execute (ITYPE ((imm, sp, rd, RISCV_ADDI)))) -- : M (bool) -+ ((ITYPE ((imm, sp, rd, RISCV_ADDI)))) -+ - | C_LW (uimm,rsc,rdc) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0] : mword 2)) in - let rd := creg2reg_bits rdc in - let rs := creg2reg_bits rsc in -- (execute (LOAD ((imm, rs, rd, false, WORD, false, false)))) -- : M (bool) -+ ((LOAD ((imm, rs, rd, false, WORD, false, false)))) -+ - | C_LD (uimm,rsc,rdc) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0;B0] : mword 3)) in - let rd := creg2reg_bits rdc in - let rs := creg2reg_bits rsc in -- (execute (LOAD ((imm, rs, rd, false, DOUBLE, false, false)))) -- : M (bool) -+ ((LOAD ((imm, rs, rd, false, DOUBLE, false, false)))) -+ - | C_SW (uimm,rsc1,rsc2) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0] : mword 2)) in - let rs1 := creg2reg_bits rsc1 in - let rs2 := creg2reg_bits rsc2 in -- (execute (STORE ((imm, rs2, rs1, WORD, false, false)))) -- : M (bool) -+ ((STORE ((imm, rs2, rs1, WORD, false, false)))) -+ - | C_SD (uimm,rsc1,rsc2) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0;B0] : mword 3)) in - let rs1 := creg2reg_bits rsc1 in - let rs2 := creg2reg_bits rsc2 in -- (execute (STORE ((imm, rs2, rs1, DOUBLE, false, false)))) -- : M (bool) -+ ((STORE ((imm, rs2, rs1, DOUBLE, false, false)))) -+ - | C_ADDI (nzi,rsd) => - let imm : bits 12 := EXTS 12 nzi in -- (execute (ITYPE ((imm, rsd, rsd, RISCV_ADDI)))) -- : M (bool) -+ ((ITYPE ((imm, rsd, rsd, RISCV_ADDI)))) -+ - | C_JAL (imm) => -- (execute (RISCV_JAL ((EXTS 21 (concat_vec imm (vec_of_bits [B0] : mword 1)), ra)))) -- : M (bool) -+ ((RISCV_JAL ((EXTS 21 (concat_vec imm (vec_of_bits [B0] : mword 1)), ra)))) -+ - | C_LI (imm,rd) => - let imm : bits 12 := EXTS 12 imm in -- (execute (ITYPE ((imm, zreg, rd, RISCV_ADDI)))) -- : M (bool) -+ ((ITYPE ((imm, zreg, rd, RISCV_ADDI)))) -+ - | C_ADDI16SP (imm) => - let imm : bits 12 := EXTS 12 (concat_vec imm (vec_of_bits [B0;B0;B0;B0] : mword 4)) in -- (execute (ITYPE ((imm, sp, sp, RISCV_ADDI)))) -- : M (bool) -+ ((ITYPE ((imm, sp, sp, RISCV_ADDI)))) -+ - | C_LUI (imm,rd) => - let res : bits 20 := EXTS 20 imm in -- (execute (UTYPE ((res, rd, RISCV_LUI)))) -- : M (bool) -+ ((UTYPE ((res, rd, RISCV_LUI)))) -+ - | C_SRLI (shamt,rsd) => - let rsd := creg2reg_bits rsd in -- (execute (SHIFTIOP ((shamt, rsd, rsd, RISCV_SRLI)))) -- : M (bool) -+ ((SHIFTIOP ((shamt, rsd, rsd, RISCV_SRLI)))) -+ - | C_SRAI (shamt,rsd) => - let rsd := creg2reg_bits rsd in -- (execute (SHIFTIOP ((shamt, rsd, rsd, RISCV_SRAI)))) -- : M (bool) -+ ((SHIFTIOP ((shamt, rsd, rsd, RISCV_SRAI)))) -+ - | C_ANDI (imm,rsd) => - let rsd := creg2reg_bits rsd in -- (execute (ITYPE ((EXTS 12 imm, rsd, rsd, RISCV_ANDI)))) -- : M (bool) -+ ((ITYPE ((EXTS 12 imm, rsd, rsd, RISCV_ANDI)))) -+ - | C_SUB (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPE ((rs2, rsd, rsd, RISCV_SUB)))) -- : M (bool) -+ ((RTYPE ((rs2, rsd, rsd, RISCV_SUB)))) -+ - | C_XOR (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPE ((rs2, rsd, rsd, RISCV_XOR)))) -- : M (bool) -+ ((RTYPE ((rs2, rsd, rsd, RISCV_XOR)))) -+ - | C_OR (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPE ((rs2, rsd, rsd, RISCV_OR)))) -- : M (bool) -+ ((RTYPE ((rs2, rsd, rsd, RISCV_OR)))) -+ - | C_AND (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPE ((rs2, rsd, rsd, RISCV_AND)))) -- : M (bool) -+ ((RTYPE ((rs2, rsd, rsd, RISCV_AND)))) -+ - | C_SUBW (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPEW ((rs2, rsd, rsd, RISCV_SUBW)))) -- : M (bool) -+ ((RTYPEW ((rs2, rsd, rsd, RISCV_SUBW)))) -+ - | C_ADDW (rsd,rs2) => - let rsd := creg2reg_bits rsd in - let rs2 := creg2reg_bits rs2 in -- (execute (RTYPEW ((rs2, rsd, rsd, RISCV_ADDW)))) -- : M (bool) -+ ((RTYPEW ((rs2, rsd, rsd, RISCV_ADDW)))) -+ - | C_J (imm) => -- (execute (RISCV_JAL ((EXTS 21 (concat_vec imm (vec_of_bits [B0] : mword 1)), zreg)))) -- : M (bool) -+ ((RISCV_JAL ((EXTS 21 (concat_vec imm (vec_of_bits [B0] : mword 1)), zreg)))) -+ - | C_BEQZ (imm,rs) => -- (execute -+ ( - (BTYPE - ((EXTS 13 (concat_vec imm (vec_of_bits [B0] : mword 1)), zreg, creg2reg_bits rs, RISCV_BEQ)))) -- : M (bool) -+ - | C_BNEZ (imm,rs) => -- (execute -+ ( - (BTYPE - ((EXTS 13 (concat_vec imm (vec_of_bits [B0] : mword 1)), zreg, creg2reg_bits rs, RISCV_BNE)))) -- : M (bool) -- | C_SLLI (shamt,rsd) => (execute (SHIFTIOP ((shamt, rsd, rsd, RISCV_SLLI)))) : M (bool) -+ -+ | C_SLLI (shamt,rsd) => ((SHIFTIOP ((shamt, rsd, rsd, RISCV_SLLI)))) - | C_LWSP (uimm,rd) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0] : mword 2)) in -- (execute (LOAD ((imm, sp, rd, false, WORD, false, false)))) -- : M (bool) -+ ((LOAD ((imm, sp, rd, false, WORD, false, false)))) -+ - | C_LDSP (uimm,rd) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0;B0] : mword 3)) in -- (execute (LOAD ((imm, sp, rd, false, DOUBLE, false, false)))) -- : M (bool) -+ ((LOAD ((imm, sp, rd, false, DOUBLE, false, false)))) -+ - | C_SWSP (uimm,rs2) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0] : mword 2)) in -- (execute (STORE ((imm, rs2, sp, WORD, false, false)))) -- : M (bool) -+ ((STORE ((imm, rs2, sp, WORD, false, false)))) -+ - | C_SDSP (uimm,rs2) => - let imm : bits 12 := EXTZ 12 (concat_vec uimm (vec_of_bits [B0;B0;B0] : mword 3)) in -- (execute (STORE ((imm, rs2, sp, DOUBLE, false, false)))) -- : M (bool) -+ ((STORE ((imm, rs2, sp, DOUBLE, false, false)))) -+ - | C_JR (rs1) => -- (execute (RISCV_JALR ((EXTZ 12 (vec_of_bits [B0] : mword 1), rs1, zreg)))) : M (bool) -+ ((RISCV_JALR ((EXTZ 12 (vec_of_bits [B0] : mword 1), rs1, zreg)))) - | C_JALR (rs1) => -- (execute (RISCV_JALR ((EXTZ 12 (vec_of_bits [B0] : mword 1), rs1, ra)))) : M (bool) -- | C_MV (rd,rs2) => (execute (RTYPE ((rs2, zreg, rd, RISCV_ADD)))) : M (bool) -- | C_EBREAK (tt) => (execute (EBREAK (tt))) : M (bool) -- | C_ADD (rsd,rs2) => (execute (RTYPE ((rs2, rsd, rsd, RISCV_ADD)))) : M (bool) -+ ((RISCV_JALR ((EXTZ 12 (vec_of_bits [B0] : mword 1), rs1, ra)))) -+ | C_MV (rd,rs2) => ((RTYPE ((rs2, zreg, rd, RISCV_ADD)))) -+ | C_EBREAK (tt) => ((EBREAK (tt))) -+ | C_ADD (rsd,rs2) => ((RTYPE ((rs2, rsd, rsd, RISCV_ADD)))) -+| i => i -+end. -+ -+Fixpoint execute (merge_var : ast) -+: M (bool) := -+let merge_var := expand_ast merge_var in -+ match merge_var with - | UTYPE (imm,rd,op) => (execute_UTYPE imm rd op) : M (bool) - | RISCV_JAL (imm,rd) => (execute_RISCV_JAL imm rd) : M (bool) - | BTYPE (imm,rs2,rs1,op) => (execute_BTYPE imm rs2 rs1 op) : M (bool) -@@ -14841,6 +14849,7 @@ - | ILLEGAL (s) => (execute_ILLEGAL s) : M (bool) - | C_ILLEGAL (s) => (execute_C_ILLEGAL s) : M (bool) - | RISCV_JALR (imm,rs1,rd) => (execute_RISCV_JALR imm rs1 rd) : M (bool) -+| _ => Fail "Unexpanded instruction" - end. - - Definition assembly_forwards (arg_ : ast) -@@ -35883,7 +35892,7 @@ - returnm (stepped - : bool). - --Definition loop '(tt : unit) -+(*Definition loop '(tt : unit) - : M (unit) := - let insns_per_tick := plat_insns_per_tick tt in - let i : Z := 0 in -@@ -35923,7 +35932,7 @@ - : M (Z)) >>= fun i : Z => - returnm (i, step_no))) >>= fun '(i, step_no) => - returnm (tt -- : unit). -+ : unit).*) - - Definition read_kind_of_num (arg_ : Z) `{ArithFact (0 <= arg_ /\ arg_ <= 11)} - : read_kind := diff --git a/riscv/gen/ast.hgen b/riscv/gen/ast.hgen deleted file mode 100644 index 4bad813d..00000000 --- a/riscv/gen/ast.hgen +++ /dev/null @@ -1,21 +0,0 @@ -| `RISCVStopFetching (* this is a special instruction used by rmem to - indicate the end of a litmus thread *) -| `RISCVThreadStart (* this instruction indicates a thread creation in ELF files *) - -| `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 * bool * bool -| `RISCVStore of bit12 * reg * reg * wordWidth * bool * bool -| `RISCVADDIW of bit12 * reg * reg -| `RISCVSHIFTW of bit5 * reg * reg * riscvSop -| `RISCVRTYPEW of reg * reg * reg * riscvRopw -| `RISCVFENCE of riscv_fence_mode * bit4 * bit4 -| `RISCVFENCEI -| `RISCVLoadRes of bool * bool * reg * wordWidth * reg -| `RISCVStoreCon of bool * bool * reg * reg * wordWidth * reg -| `RISCVAMO of riscvAmoop * bool * bool * reg * reg * wordWidth * reg diff --git a/riscv/gen/fold.hgen b/riscv/gen/fold.hgen deleted file mode 100644 index a47aa246..00000000 --- a/riscv/gen/fold.hgen +++ /dev/null @@ -1,20 +0,0 @@ -| `RISCVThreadStart -> (y_reg, y_sreg) -| `RISCVStopFetching -> (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))) -| `RISCVFENCE (_, _, _) -> (y_reg, y_sreg) -| `RISCVFENCEI -> (y_reg, y_sreg) -| `RISCVLoadRes (_, _, rs1, _, rd) -> fold_reg rs1 (fold_reg rd (y_reg, y_sreg)) -| `RISCVStoreCon (_, _, rs2, rs1, _, rd) -> fold_reg rs2 (fold_reg rs1 (fold_reg rd (y_reg, y_sreg))) -| `RISCVAMO (_, _, _, rs2, rs1, _, rd) -> fold_reg rs2 (fold_reg rs1 (fold_reg rd (y_reg, y_sreg))) diff --git a/riscv/gen/herdtools_ast_to_shallow_ast.hgen b/riscv/gen/herdtools_ast_to_shallow_ast.hgen deleted file mode 100644 index f36949f7..00000000 --- a/riscv/gen/herdtools_ast_to_shallow_ast.hgen +++ /dev/null @@ -1,88 +0,0 @@ -| `RISCVThreadStart -> THREAD_START() -| `RISCVStopFetching -> STOP_FETCHING() - -| `RISCVUTYPE(imm, rd, op) -> UTYPE( - translate_imm20 "imm" imm, - translate_reg "rd" rd, - translate_uop op) -| `RISCVJAL(imm, rd) -> RISCV_JAL( - translate_imm21 "imm" imm, - translate_reg "rd" rd) -| `RISCVJALR(imm, rs, rd) -> RISCV_JALR( - translate_imm12 "imm" imm, - translate_reg "rs" rd, - translate_reg "rd" rd) -| `RISCVBType(imm, rs2, rs1, op) -> BTYPE( - translate_imm13 "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, aq, rl) -> LOAD( - translate_imm12 "imm" imm, - translate_reg "rs" rs, - translate_reg "rd" rd, - translate_bool "unsigned" unsigned, - translate_wordWidth width, - translate_bool "aq" aq, - translate_bool "rl" rl) -| `RISCVStore(imm, rs, rd, width, aq, rl) -> STORE ( - translate_imm12 "imm" imm, - translate_reg "rs" rs, - translate_reg "rd" rd, - translate_wordWidth width, - translate_bool "aq" aq, - translate_bool "rl" rl) -| `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(mode, pred, succ) -> FENCE( - translate_imm4 "pred" pred, - translate_imm4 "succ" succ) -| `RISCVFENCEI -> FENCEI () -| `RISCVLoadRes(aq, rl, rs1, width, rd) -> LOADRES( - translate_bool "aq" aq, - translate_bool "rl" rl, - translate_reg "rs1" rs1, - translate_wordWidth width, - translate_reg "rd" rd) -| `RISCVStoreCon(aq, rl, rs2, rs1, width, rd) -> STORECON( - translate_bool "aq" aq, - translate_bool "rl" rl, - translate_reg "rs2" rs2, - translate_reg "rs1" rs1, - translate_wordWidth width, - translate_reg "rd" rd) -| `RISCVAMO (op, aq, rl, rs2, rs1, width, rd) -> AMO( - translate_amoop op, - translate_bool "aq" aq, - translate_bool "rl" rl, - translate_reg "rs2" rs2, - translate_reg "rs1" rs1, - translate_wordWidth width, - translate_reg "rd" rd) diff --git a/riscv/gen/herdtools_types_to_shallow_types.hgen b/riscv/gen/herdtools_types_to_shallow_types.hgen deleted file mode 100644 index 8bd311b2..00000000 --- a/riscv/gen/herdtools_types_to_shallow_types.hgen +++ /dev/null @@ -1,90 +0,0 @@ -let is_inc = false - -let translate_reg name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty5_dict (Nat_big_num.of_int (reg_to_int value)) - -let translate_uop op = match op with - | RISCVLUI -> RISCV_LUI - | RISCVAUIPC -> RISCV_AUIPC - -let translate_bop op = match op with - | RISCVBEQ -> RISCV_BEQ - | RISCVBNE -> RISCV_BNE - | RISCVBLT -> RISCV_BLT - | RISCVBGE -> RISCV_BGE - | RISCVBLTU -> RISCV_BLTU - | RISCVBGEU -> RISCV_BGEU - -let translate_iop op = match op with - | RISCVADDI -> RISCV_ADDI - | RISCVSLTI -> RISCV_SLTI - | RISCVSLTIU -> RISCV_SLTIU - | RISCVXORI -> RISCV_XORI - | RISCVORI -> RISCV_ORI - | RISCVANDI -> RISCV_ANDI - -let translate_sop op = match op with - | RISCVSLLI -> RISCV_SLLI - | RISCVSRLI -> RISCV_SRLI - | RISCVSRAI -> RISCV_SRAI - -let translate_rop op = match op with - | RISCVADD -> RISCV_ADD - | RISCVSUB -> RISCV_SUB - | RISCVSLL -> RISCV_SLL - | RISCVSLT -> RISCV_SLT - | RISCVSLTU -> RISCV_SLTU - | RISCVXOR -> RISCV_XOR - | RISCVSRL -> RISCV_SRL - | RISCVSRA -> RISCV_SRA - | RISCVOR -> RISCV_OR - | RISCVAND -> RISCV_AND - -let translate_ropw op = match op with - | RISCVADDW -> RISCV_ADDW - | RISCVSUBW -> RISCV_SUBW - | RISCVSLLW -> RISCV_SLLW - | RISCVSRLW -> RISCV_SRLW - | RISCVSRAW -> RISCV_SRAW - -let translate_amoop op = match op with - | RISCVAMOSWAP -> AMOSWAP - | RISCVAMOADD -> AMOADD - | RISCVAMOXOR -> AMOXOR - | RISCVAMOAND -> AMOAND - | RISCVAMOOR -> AMOOR - | RISCVAMOMIN -> AMOMIN - | RISCVAMOMAX -> AMOMAX - | RISCVAMOMINU -> AMOMINU - | RISCVAMOMAXU -> AMOMAXU - -let translate_wordWidth op = match op with - | RISCVBYTE -> BYTE - | RISCVHALF -> HALF - | RISCVWORD -> WORD - | RISCVDOUBLE -> DOUBLE - -let translate_bool name b = b (* function - * | true -> trueSail2_values.B10 - * | false -> false Sail2_values.B00 *) - -let translate_imm21 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty21_dict (Nat_big_num.of_int value) - -let translate_imm20 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty20_dict (Nat_big_num.of_int value) - -let translate_imm13 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty13_dict (Nat_big_num.of_int value) - -let translate_imm12 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty12_dict (Nat_big_num.of_int value) - -let translate_imm6 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty6_dict (Nat_big_num.of_int value) - -let translate_imm5 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty5_dict (Nat_big_num.of_int value) - -let translate_imm4 name value = - Lem_machine_word.wordFromInteger Lem_machine_word.instance_Machine_word_Size_Machine_word_ty4_dict (Nat_big_num.of_int value) diff --git a/riscv/gen/lexer.hgen b/riscv/gen/lexer.hgen deleted file mode 100644 index 9009f333..00000000 --- a/riscv/gen/lexer.hgen +++ /dev/null @@ -1,63 +0,0 @@ -(** RV32I (and RV64I) ***********************************************) -"lui" , 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}; - -"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}; - -"fence", FENCE (); -"fence.tso", FENCETSO (); -"fence.i", FENCEI (); - -(** RV64I (in addition to RV32I) ************************************) - -"addiw", ADDIW (); - -"addw", RTYPEW {op=RISCVADDW}; -"subw", RTYPEW {op=RISCVSUBW}; -"sllw", RTYPEW {op=RISCVSLLW}; -"srlw", RTYPEW {op=RISCVSRLW}; -"sraw", RTYPEW {op=RISCVSRAW}; - -"slli", SHIFTIOP {op=RISCVSLLI}; -"srli", SHIFTIOP {op=RISCVSRLI}; -"srai", SHIFTIOP {op=RISCVSRAI}; - -"slliw", SHIFTW {op=RISCVSLLI}; -"srliw", SHIFTW {op=RISCVSRLI}; -"sraiw", SHIFTW {op=RISCVSRAI}; - -(** RV32A (and RV64A) ***********************************************) - -"r", FENCEOPTION Fence_R; -"w", FENCEOPTION Fence_W; -"rw", FENCEOPTION Fence_RW; - -(** pseudo instructions *********************************************) - -"li", LI () diff --git a/riscv/gen/lexer_regexps.hgen b/riscv/gen/lexer_regexps.hgen deleted file mode 100644 index b8f3ca67..00000000 --- a/riscv/gen/lexer_regexps.hgen +++ /dev/null @@ -1,131 +0,0 @@ -(** RV32I (and RV64I) ***********************************************) - -| 'l' (('b'|'h') as width) ("u"? as u) (".aq"? as aq) (".rl"? as rl) as load - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ load ^ "' is not a valid instruction") else - LOAD { width = (match width with 'b' -> RISCVBYTE | 'h' -> RISCVHALF | _ -> failwith "bad width"); - unsigned = (u = "u"); - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "lw" (".aq"? as aq) (".rl"? as rl) as load - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ load ^ "' is not a valid instruction") else - LOAD { width = RISCVWORD; - unsigned = false; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| 's' (('b'|'h'|'w') as width) (".aq"? as aq) (".rl"? as rl) as store - { if (aq = ".aq") && not (rl = ".rl") then failwith ("'" ^ store ^ "' is not a valid instruction") else - STORE { width = (match width with 'b' -> RISCVBYTE | 'h' -> RISCVHALF | 'w' -> RISCVWORD | _ -> failwith "bad width"); - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -(** RV64I (in addition to RV32I) ************************************) - -| "lwu" (".aq"? as aq) (".rl"? as rl) as load - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ load ^ "' is not a valid instruction") else - LOAD { width = RISCVWORD; - unsigned = true; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "ld" (".aq"? as aq) (".rl"? as rl) as load - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ load ^ "' is not a valid instruction") else - LOAD { width = RISCVDOUBLE; - unsigned = false; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "sd" (".aq"? as aq) (".rl"? as rl) as store - { if (aq = ".aq") && not (rl = ".rl") then failwith ("'" ^ store ^ "' is not a valid instruction") else - STORE { width = RISCVDOUBLE; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -(** RV32A (and RV64A) ***********************************************) - -| "lr.w" (".aq"? as aq) (".rl"? as rl) as lr - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ lr ^ "' is not a valid instruction") else - LOADRES { width = RISCVWORD; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "sc.w" (".aq"? as aq) (".rl"? as rl) as sc - { if (aq = ".aq") && not (rl = ".rl") then failwith ("'" ^ sc ^ "' is not a valid instruction") else - STORECON { width = RISCVWORD; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "amo" (("swap"|"add"|"and"|"or"|"xor"|"max"|"min"|"maxu"|"minu") as op) ".w" (".aq"? as aq) (".rl"? as rl) - { AMO { op = - begin match op with - | "swap" -> RISCVAMOSWAP; - | "add" -> RISCVAMOADD; - | "and" -> RISCVAMOAND; - | "or" -> RISCVAMOOR; - | "xor" -> RISCVAMOXOR; - | "max" -> RISCVAMOMAX; - | "min" -> RISCVAMOMIN; - | "maxu" -> RISCVAMOMAXU; - | "minu" -> RISCVAMOMINU; - | _ -> failwith "bad amo" - end; - width = RISCVWORD; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -(** RV64A (in addition to RV32A) ************************************) - -| "lr.d" (".aq"? as aq) (".rl"? as rl) as lr - { if (rl = ".rl") && not (aq = ".aq") then failwith ("'" ^ lr ^ "' is not a valid instruction") else - LOADRES { width = RISCVDOUBLE; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "sc.d" (".aq"? as aq) (".rl"? as rl) as sc - { if (aq = ".aq") && not (rl = ".rl") then failwith ("'" ^ sc ^ "' is not a valid instruction") else - STORECON { width = RISCVDOUBLE; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } - -| "amo" (("swap"|"add"|"and"|"or"|"xor"|"max"|"min"|"maxu"|"minu") as op) ".d" (".aq"? as aq) (".rl"? as rl) - { AMO { op = - begin match op with - | "swap" -> RISCVAMOSWAP; - | "add" -> RISCVAMOADD; - | "and" -> RISCVAMOAND; - | "or" -> RISCVAMOOR; - | "xor" -> RISCVAMOXOR; - | "max" -> RISCVAMOMAX; - | "min" -> RISCVAMOMIN; - | "maxu" -> RISCVAMOMAXU; - | "minu" -> RISCVAMOMINU; - | _ -> failwith "bad amo" - end; - width = RISCVDOUBLE; - aq = (aq = ".aq"); - rl = (rl = ".rl"); - } - } diff --git a/riscv/gen/map.hgen b/riscv/gen/map.hgen deleted file mode 100644 index 28e36e08..00000000 --- a/riscv/gen/map.hgen +++ /dev/null @@ -1,20 +0,0 @@ -| `RISCVThreadStart -> `RISCVThreadStart -| `RISCVStopFetching -> `RISCVStopFetching - -| `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, a, b) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z, a, b) -| `RISCVStore (x, r0, r1, y, z, a) -> `RISCVStore (x, map_reg r0, map_reg r1, y, z, a) -| `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) -| `RISCVFENCE (m, p, s) -> `RISCVFENCE (m, p, s) -| `RISCVFENCEI -> `RISCVFENCEI -| `RISCVLoadRes (aq, rl, rs1, w, rd) -> `RISCVLoadRes (aq, rl, map_reg rs1, w, map_reg rd) -| `RISCVStoreCon (aq, rl, rs2, rs1, w, rd) -> `RISCVStoreCon (aq, rl, map_reg rs2, map_reg rs1, w, map_reg rd) -| `RISCVAMO (op, aq, rl, rs2, rs1, w, rd) -> `RISCVAMO (op, aq, rl, map_reg rs2, map_reg rs1, w, map_reg rd) diff --git a/riscv/gen/parser.hgen b/riscv/gen/parser.hgen deleted file mode 100644 index b0ed4b31..00000000 --- a/riscv/gen/parser.hgen +++ /dev/null @@ -1,76 +0,0 @@ -| UTYPE reg COMMA NUM - { (* it's not clear if NUM here should be before or after filling the - lowest 12 bits with zeros, or if it should be signed or unsigned; - currently assuming: NUM does not include the 12 zeros, and is unsigned *) - if not (iskbituimm 20 $4) then failwith "immediate is not 20bit" - else `RISCVUTYPE ($4, $2, $1.op) } -| JAL reg COMMA NUM - { if not ($4 mod 2 = 0) then failwith "odd offset" - else if not (iskbitsimm 21 $4) then failwith "offset is not 21bit" - else `RISCVJAL ($4, $2) } -| JALR reg COMMA reg COMMA NUM - { if not (iskbitsimm 12 $6) then failwith "offset is not 12bit" - else `RISCVJALR ($6, $4, $2) } -| BTYPE reg COMMA reg COMMA NUM - { if not ($6 mod 2 = 0) then failwith "odd offset" - else if not (iskbitsimm 13 $6) then failwith "offset is not 13bit" - else `RISCVBType ($6, $4, $2, $1.op) } -| ITYPE reg COMMA reg COMMA NUM - { if $1.op <> RISCVSLTIU && not (iskbitsimm 12 $6) then failwith "immediate is not 12bit" - else if $1.op = RISCVSLTIU && not (iskbituimm 12 $6) then failwith "unsigned immediate is not 12bit" - else `RISCVIType ($6, $4, $2, $1.op) } -| ADDIW reg COMMA reg COMMA NUM - { if not (iskbitsimm 12 $6) then failwith "immediate is not 12bit" - else `RISCVADDIW ($6, $4, $2) } -| SHIFTIOP reg COMMA reg COMMA NUM - { if not (iskbituimm 6 $6) then failwith "unsigned immediate is not 6bit" - else `RISCVShiftIop ($6, $4, $2, $1.op) } -| SHIFTW reg COMMA reg COMMA NUM - { if not (iskbituimm 5 $6) then failwith "unsigned immediate is not 5bit" - else `RISCVSHIFTW ($6, $4, $2, $1.op) } -| RTYPE reg COMMA reg COMMA reg - { `RISCVRType ($6, $4, $2, $1.op) } -| LOAD reg COMMA NUM LPAR reg RPAR - { if not (iskbitsimm 12 $4) then failwith "offset is not 12bit" - else `RISCVLoad ($4, $6, $2, $1.unsigned, $1.width, $1.aq, $1.rl) } -| STORE reg COMMA NUM LPAR reg RPAR - { if not (iskbitsimm 12 $4) then failwith "offset is not 12bit" - else `RISCVStore ($4, $2, $6, $1.width, $1.aq, $1.rl) } -| RTYPEW reg COMMA reg COMMA reg - { `RISCVRTYPEW ($6, $4, $2, $1.op) } -| FENCE FENCEOPTION COMMA FENCEOPTION - { match ($2, $4) with - | (Fence_RW, Fence_RW) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0011, 0b0011) - | (Fence_R, Fence_RW) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0010, 0b0011) - | (Fence_W, Fence_RW) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0001, 0b0011) - | (Fence_RW, Fence_R) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0011, 0b0010) - | (Fence_R, Fence_R) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0010, 0b0010) - | (Fence_W, Fence_R) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0001, 0b0010) - | (Fence_RW, Fence_W) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0011, 0b0001) - | (Fence_R, Fence_W) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0010, 0b0001) - | (Fence_W, Fence_W) -> `RISCVFENCE (RISCV_FM_NORMAL, 0b0001, 0b0001) - } -| FENCETSO - { `RISCVFENCE (RISCV_FM_TSO, 0b0011, 0b0011) } -| FENCEI - { `RISCVFENCEI } -| LOADRES reg COMMA LPAR reg RPAR - { `RISCVLoadRes ($1.aq, $1.rl, $5, $1.width, $2) } -| LOADRES reg COMMA NUM LPAR reg RPAR - { if $4 <> 0 then failwith "'lr' offset must be 0" else - `RISCVLoadRes ($1.aq, $1.rl, $6, $1.width, $2) } -| STORECON reg COMMA reg COMMA LPAR reg RPAR - { `RISCVStoreCon ($1.aq, $1.rl, $4, $7, $1.width, $2) } -| STORECON reg COMMA reg COMMA NUM LPAR reg RPAR - { if $6 <> 0 then failwith "'sc' offset must be 0" else - `RISCVStoreCon ($1.aq, $1.rl, $4, $8, $1.width, $2) } -| AMO reg COMMA reg COMMA LPAR reg RPAR - { `RISCVAMO ($1.op, $1.aq, $1.rl, $4, $7, $1.width, $2) } -| AMO reg COMMA reg COMMA NUM LPAR reg RPAR - { if $6 <> 0 then failwith "'amo<op>' offset must be 0" else - `RISCVAMO ($1.op, $1.aq, $1.rl, $4, $8, $1.width, $2) } - -/* pseudo-ops */ -| LI reg COMMA NUM - { if not (iskbitsimm 12 $4) then failwith "immediate is not 12bit (li is currently implemented only with small immediate)" - else `RISCVIType ($4, IReg R0, $2, RISCVORI) } diff --git a/riscv/gen/pretty.hgen b/riscv/gen/pretty.hgen deleted file mode 100644 index a283b7e4..00000000 --- a/riscv/gen/pretty.hgen +++ /dev/null @@ -1,38 +0,0 @@ -| `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, aq, rl) -> - sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width, aq, rl)) (pp_reg rd) imm (pp_reg rs) - -| `RISCVStore(imm, rs2, rs1, width, aq, rl) -> - sprintf "%s %s, %d(%s)" (pp_riscv_store_op (width, aq, rl)) (pp_reg rs2) imm (pp_reg rs1) - -| `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(RISCV_FM_NORMAL, pred, succ) - -> sprintf "fence %s,%s" (pp_riscv_fence_option pred) (pp_riscv_fence_option succ) - -| `RISCVFENCE(RISCV_FM_TSO, 0b0011, 0b0011) - -> sprintf "fence.tso" -| `RISCVFENCE(RISCV_FM_TSO, _, _) -> failwith "bad fence.tso" - -| `RISCVFENCEI -> sprintf "fence.i" - -| `RISCVLoadRes(aq, rl, rs1, width, rd) -> - sprintf "%s %s, (%s)" (pp_riscv_load_reserved_op (aq, rl, width)) (pp_reg rd) (pp_reg rs1) - -| `RISCVStoreCon(aq, rl, rs2, rs1, width, rd) -> - sprintf "%s %s, %s, (%s)" (pp_riscv_store_conditional_op (aq, rl, width)) (pp_reg rd) (pp_reg rs2) (pp_reg rs1) - -| `RISCVAMO(op, aq, rl, rs2, rs1, width, rd) -> - sprintf "%s %s, %s, (%s)" (pp_riscv_amo_op (op, aq, rl, width)) (pp_reg rd) (pp_reg rs2) (pp_reg rs1) diff --git a/riscv/gen/pretty_xml.hgen b/riscv/gen/pretty_xml.hgen deleted file mode 100644 index c2c350a3..00000000 --- a/riscv/gen/pretty_xml.hgen +++ /dev/null @@ -1,138 +0,0 @@ -| `RISCVThreadStart -> ("op_thread_start", []) - -| `RISCVStopFetching -> ("op_stop_fetching", []) - -| `RISCVUTYPE(imm, rd, op) -> - ("op_U_type", - [ ("op", pp_riscv_uop op); - ("uimm", sprintf "%d" imm); - ("dest", pp_reg rd); - ]) - -| `RISCVJAL(imm, rd) -> - ("op_jal", - [ ("offset", sprintf "%d" imm); - ("dest", pp_reg rd); - ]) - -| `RISCVJALR(imm, rs1, rd) -> - ("op_jalr", - [ ("offset", sprintf "%d" imm); - ("base", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVBType(imm, rs2, rs1, op) -> - ("op_branch", - [ ("op", pp_riscv_bop op); - ("offset", sprintf "%d" imm); - ("src2", pp_reg rs2); - ("src1", pp_reg rs1); - ]) - -| `RISCVIType(imm, rs1, rd, op) -> - ("op_I_type", - [ ("op", pp_riscv_iop op); - ("iimm", sprintf "%d" imm); - ("src", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVShiftIop(imm, rs1, rd, op) -> - ("op_IS_type", - [ ("op", pp_riscv_sop op); - ("shamt", sprintf "%d" imm); - ("src", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVSHIFTW(imm, rs1, rd, op) -> - ("op_ISW_type", - [ ("op", pp_riscv_sop op); - ("shamt", sprintf "%d" imm); - ("src", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVRType (rs2, rs1, rd, op) -> - ("op_R_type", - [ ("op", pp_riscv_rop op); - ("src2", pp_reg rs2); - ("src1", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVLoad(imm, rs1, rd, unsigned, width, aq, rl) -> - ("op_load", - [ ("aq", if aq then "true" else "false"); - ("rl", if rl then "true" else "false"); - ("width", pp_word_width width); - ("unsigned", if unsigned then "true" else "false"); - ("base", pp_reg rs1); - ("offset", sprintf "%d" imm); - ("dest", pp_reg rd); - ]) - -| `RISCVStore(imm, rs2, rs1, width, aq, rl) -> - ("op_store", - [ ("aq", if aq then "true" else "false"); - ("rl", if rl then "true" else "false"); - ("width", pp_word_width width); - ("src", pp_reg rs2); - ("base", pp_reg rs1); - ("offset", sprintf "%d" imm); - ]) - -| `RISCVADDIW(imm, rs1, rd) -> - ("op_addiw", - [ ("iimm", sprintf "%d" imm); - ("src", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVRTYPEW(rs2, rs1, rd, op) -> - ("op_RW_type", - [ ("op", pp_riscv_ropw op); - ("src2", pp_reg rs2); - ("src1", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVFENCE(mode, pred, succ) -> - ("op_fence", - [ ("mode", match mode with RISCV_FM_NORMAL -> "normal" | RISCV_FM_TSO -> "tso"); - ("pred", pp_riscv_fence_option pred); - ("succ", pp_riscv_fence_option succ); - ]) - -| `RISCVFENCEI -> ("op_fence_i", []) - -| `RISCVLoadRes(aq, rl, rs1, width, rd) -> - ("op_lr", - [ ("aq", if aq then "true" else "false"); - ("rl", if rl then "true" else "false"); - ("width", pp_word_width width); - ("addr", pp_reg rs1); - ("dest", pp_reg rd); - ]) - -| `RISCVStoreCon(aq, rl, rs2, rs1, width, rd) -> - ("op_sc", - [ ("aq", if aq then "true" else "false"); - ("rl", if rl then "true" else "false"); - ("width", pp_word_width width); - ("addr", pp_reg rs1); - ("src", pp_reg rs2); - ("dest", pp_reg rd); - ]) - -| `RISCVAMO(op, aq, rl, rs2, rs1, width, rd) -> - ("op_amo", - [ ("op", pp_riscv_amo_op_part op); - ("aq", if aq then "true" else "false"); - ("rl", if rl then "true" else "false"); - ("width", pp_word_width width); - ("src", pp_reg rs2); - ("addr", pp_reg rs1); - ("dest", pp_reg rd); - ]) diff --git a/riscv/gen/sail_trans_out.hgen b/riscv/gen/sail_trans_out.hgen deleted file mode 100644 index 3c252502..00000000 --- a/riscv/gen/sail_trans_out.hgen +++ /dev/null @@ -1,25 +0,0 @@ -| ("StopFetching", []) -> `RISCVStopFetching -| ("ThreadStart", []) -> `RISCVThreadStart - -| ("UTYPE", [imm; rd; op]) -> `RISCVUTYPE(translate_out_simm20 imm, translate_out_ireg rd, translate_out_uop op) -| ("JAL", [imm; rd]) -> `RISCVJAL(translate_out_simm21 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_simm13 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; aq; rl]) - -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width, translate_out_bool aq, translate_out_bool rl) -| ("STORE", [imm; rs; rd; width; aq; rl]) - -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, translate_out_bool aq, translate_out_bool rl) -| ("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", [mode; pred; succ]) -> `RISCVFENCE(translate_out_fm_mode mode, translate_out_imm4 pred, translate_out_imm4 succ) -| ("FENCEI", []) -> `RISCVFENCEI -| ("LOADRES", [aq; rl; rs1; width; rd]) - -> `RISCVLoadRes(translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) -| ("STORECON", [aq; rl; rs2; rs1; width; rd]) - -> `RISCVStoreCon(translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) -| ("AMO", [op; aq; rl; rs2; rs1; width; rd]) - -> `RISCVAMO(translate_out_amoop op, translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) diff --git a/riscv/gen/shallow_ast_to_herdtools_ast.hgen b/riscv/gen/shallow_ast_to_herdtools_ast.hgen deleted file mode 100644 index e612f8c3..00000000 --- a/riscv/gen/shallow_ast_to_herdtools_ast.hgen +++ /dev/null @@ -1,25 +0,0 @@ -| STOP_FETCHING () -> `RISCVStopFetching -| THREAD_START () -> `RISCVThreadStart - -| UTYPE( imm, rd, op) -> `RISCVUTYPE(translate_out_simm20 imm, translate_out_ireg rd, translate_out_uop op) -| RISCV_JAL( imm, rd) -> `RISCVJAL(translate_out_simm21 imm, translate_out_ireg rd) -| RISCV_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_simm13 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, aq, rl) - -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width, translate_out_bool aq, translate_out_bool rl) -| STORE( imm, rs, rd, width, aq, rl) - -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, translate_out_bool aq, translate_out_bool rl) -| 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(RISCV_FM_NORMAL, translate_out_imm4 pred, translate_out_imm4 succ) -| FENCEI () -> `RISCVFENCEI -| LOADRES( aq, rl, rs1, width, rd) - -> `RISCVLoadRes(translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) -| STORECON( aq, rl, rs2, rs1, width, rd) - -> `RISCVStoreCon(translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) -| AMO( op, aq, rl, rs2, rs1, width, rd) - -> `RISCVAMO(translate_out_amoop op, translate_out_bool aq, translate_out_bool rl, translate_out_ireg rs2, translate_out_ireg rs1, translate_out_wordWidth width, translate_out_ireg rd) diff --git a/riscv/gen/shallow_types_to_herdtools_types.hgen b/riscv/gen/shallow_types_to_herdtools_types.hgen deleted file mode 100644 index 5a659cd4..00000000 --- a/riscv/gen/shallow_types_to_herdtools_types.hgen +++ /dev/null @@ -1,91 +0,0 @@ -(* 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_int i = Nat_big_num.to_int (Lem.naturalFromWord i) -let translate_out_signed_int i = Nat_big_num.to_int (Lem.signedIntegerFromWord i) - -let translate_out_ireg ireg = IReg (int_to_ireg (translate_out_int ireg)) - -let translate_out_uop op = match op with - | RISCV_LUI -> RISCVLUI - | RISCV_AUIPC -> RISCVAUIPC - -let translate_out_bop op = match op with - | RISCV_BEQ -> RISCVBEQ - | RISCV_BNE -> RISCVBNE - | RISCV_BLT -> RISCVBLT - | RISCV_BGE -> RISCVBGE - | RISCV_BLTU -> RISCVBLTU - | RISCV_BGEU -> RISCVBGEU - -let translate_out_iop op = match op with - | RISCV_ADDI -> RISCVADDI - | RISCV_SLTI -> RISCVSLTI - | RISCV_SLTIU -> RISCVSLTIU - | RISCV_XORI -> RISCVXORI - | RISCV_ORI -> RISCVORI - | RISCV_ANDI -> RISCVANDI - -let translate_out_sop op = match op with - | RISCV_SLLI -> RISCVSLLI - | RISCV_SRLI -> RISCVSRLI - | RISCV_SRAI -> RISCVSRAI - -let translate_out_rop op = match op with - | RISCV_ADD -> RISCVADD - | RISCV_SUB -> RISCVSUB - | RISCV_SLL -> RISCVSLL - | RISCV_SLT -> RISCVSLT - | RISCV_SLTU -> RISCVSLTU - | RISCV_XOR -> RISCVXOR - | RISCV_SRL -> RISCVSRL - | RISCV_SRA -> RISCVSRA - | RISCV_OR -> RISCVOR - | RISCV_AND -> RISCVAND - -let translate_out_ropw op = match op with - | RISCV_ADDW -> RISCVADDW - | RISCV_SUBW -> RISCVSUBW - | RISCV_SLLW -> RISCVSLLW - | RISCV_SRLW -> RISCVSRLW - | RISCV_SRAW -> RISCVSRAW - -let translate_out_amoop op = match op with - | AMOSWAP -> RISCVAMOSWAP - | AMOADD -> RISCVAMOADD - | AMOXOR -> RISCVAMOXOR - | AMOAND -> RISCVAMOAND - | AMOOR -> RISCVAMOOR - | AMOMIN -> RISCVAMOMIN - | AMOMAX -> RISCVAMOMAX - | AMOMINU -> RISCVAMOMINU - | AMOMAXU -> RISCVAMOMAXU - -let translate_out_wordWidth op = match op with - | BYTE -> RISCVBYTE - | HALF -> RISCVHALF - | WORD -> RISCVWORD - | DOUBLE -> RISCVDOUBLE - -(* let translate_out_fm_mode = function - * | FM_NORMAL -> RISCV_FM_NORMAL - * | FM_TSO -> RISCV_FM_TSO *) - -let translate_out_bool b = b (* function - * | Sail_values.B1 -> true - * | Sail_values.B0 -> false - * | _ -> failwith "translate_out_bool Undef" *) - -let translate_out_simm21 imm = translate_out_signed_int imm (* 21 *) -let translate_out_simm20 imm = translate_out_signed_int imm (* 20 *) -let translate_out_simm13 imm = translate_out_signed_int imm (* 13 *) -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_imm4 imm = translate_out_int imm diff --git a/riscv/gen/token_types.hgen b/riscv/gen/token_types.hgen deleted file mode 100644 index 1a2895af..00000000 --- a/riscv/gen/token_types.hgen +++ /dev/null @@ -1,24 +0,0 @@ -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; aq: bool; rl: bool } -type token_Store = {width : wordWidth; aq: bool; rl: bool } -type token_ADDIW = unit -type token_SHIFTW = {op : riscvSop } -type token_RTYPEW = {op : riscvRopw } -type token_FENCE = unit -type token_FENCETSO = unit -type token_FENCEI = unit -type token_LoadRes = {width : wordWidth; aq: bool; rl: bool } -type token_StoreCon = {width : wordWidth; aq: bool; rl: bool } -type token_AMO = {width : wordWidth; aq: bool; rl: bool; op: riscvAmoop } - -type token_FENCEOPTION = Fence_R | Fence_W | Fence_RW - -(* pseudo-ops *) - -type token_LI = unit diff --git a/riscv/gen/tokens.hgen b/riscv/gen/tokens.hgen deleted file mode 100644 index 37c76a2e..00000000 --- a/riscv/gen/tokens.hgen +++ /dev/null @@ -1,20 +0,0 @@ -%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 -%token <RISCVHGenBase.token_FENCEOPTION> FENCEOPTION -%token <RISCVHGenBase.token_FENCETSO> FENCETSO -%token <RISCVHGenBase.token_FENCEI> FENCEI -%token <RISCVHGenBase.token_LoadRes> LOADRES -%token <RISCVHGenBase.token_StoreCon> STORECON -%token <RISCVHGenBase.token_AMO> AMO -%token <RISCVHGenBase.token_LI> LI diff --git a/riscv/gen/trans_sail.hgen b/riscv/gen/trans_sail.hgen deleted file mode 100644 index bff31ce8..00000000 --- a/riscv/gen/trans_sail.hgen +++ /dev/null @@ -1,156 +0,0 @@ -| `RISCVStopFetching -> ("StopFetching", [], []) -| `RISCVThreadStart -> ("ThreadStart", [], []) - -| `RISCVUTYPE(imm, rd, op) -> - ("UTYPE", - [ - translate_imm20 "imm" imm; - translate_reg "rd" rd; - translate_uop "op" op; - ], - []) -| `RISCVJAL(imm, rd) -> - ("JAL", - [ - translate_imm21 "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_imm13 "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, aq, rl) -> - ("LOAD", - [ - translate_imm12 "imm" imm; - translate_reg "rs" rs; - translate_reg "rd" rd; - translate_bool "unsigned" unsigned; - translate_width "width" width; - translate_bool "aq" aq; - translate_bool "rl" rl; - ], - []) -| `RISCVStore(imm, rs2, rs1, width, aq, rl) -> - ("STORE", - [ - translate_imm12 "imm" imm; - translate_reg "rs2" rs2; - translate_reg "rs1" rs1; - translate_width "width" width; - translate_bool "aq" aq; - translate_bool "rl" rl; - ], - []) -| `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(mode, pred, succ) -> - ("FENCE", - [ - translate_fm_mode "mode" mode; - translate_imm4 "pred" pred; - translate_imm4 "succ" succ; - ], - []) -| `RISCVFENCEI -> - ("FENCEI", - [], - []) -| `RISCVLoadRes(aq, rl, rs1, width, rd) -> - ("LOADRES", - [ - translate_bool "aq" aq; - translate_bool "rl" rl; - translate_reg "rs1" rs1; - translate_width "width" width; - translate_reg "rd" rd; - ], - []) -| `RISCVStoreCon(aq, rl, rs2, rs1, width, rd) -> - ("STORECON", - [ - translate_bool "aq" aq; - translate_bool "rl" rl; - translate_reg "rs2" rs2; - translate_reg "rs1" rs1; - translate_width "width" width; - translate_reg "rd" rd; - ], - []) -| `RISCVAMO(op, aq, rl, rs2, rs1, width, rd) -> - ("AMO", - [ - translate_amoop "op" op; - translate_bool "aq" aq; - translate_bool "rl" rl; - translate_reg "rs2" rs2; - translate_reg "rs1" rs1; - translate_width "width" width; - translate_reg "rd" rd; - ], - []) diff --git a/riscv/gen/types.hgen b/riscv/gen/types.hgen deleted file mode 100644 index 5ad0b733..00000000 --- a/riscv/gen/types.hgen +++ /dev/null @@ -1,177 +0,0 @@ -type bit20 = int -type bit12 = int -type bit6 = int -type bit5 = int -type bit4 = 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_word_width width : string = - begin match width with - | RISCVBYTE -> "b" - | RISCVHALF -> "h" - | RISCVWORD -> "w" - | RISCVDOUBLE -> "d" - end - -let pp_riscv_load_op (unsigned, width, aq, rl) = - "l" ^ - (pp_word_width width) ^ - (if unsigned then "u" else "") ^ - (if aq then ".aq" else "") ^ - (if rl then ".rl" else "") - -let pp_riscv_store_op (width, aq, rl) = - "s" ^ - (pp_word_width width) ^ - (if aq then ".aq" else "") ^ - (if rl then ".rl" else "") - -let pp_riscv_load_reserved_op (aq, rl, width) = - "lr." ^ - (pp_word_width width) ^ - (if aq then ".aq" else "") ^ - (if rl then ".rl" else "") - -let pp_riscv_store_conditional_op (aq, rl, width) = - "sc." ^ - (pp_word_width width) ^ - (if aq then ".aq" else "") ^ - (if rl then ".rl" else "") - -type riscvAmoop = - | RISCVAMOSWAP - | RISCVAMOADD - | RISCVAMOXOR - | RISCVAMOAND - | RISCVAMOOR - | RISCVAMOMIN - | RISCVAMOMAX - | RISCVAMOMINU - | RISCVAMOMAXU - -let pp_riscv_amo_op_part = function - | RISCVAMOSWAP -> "swap" - | RISCVAMOADD -> "add" - | RISCVAMOXOR -> "xor" - | RISCVAMOAND -> "and" - | RISCVAMOOR -> "or" - | RISCVAMOMIN -> "min" - | RISCVAMOMAX -> "max" - | RISCVAMOMINU -> "minu" - | RISCVAMOMAXU -> "maxu" - -let pp_riscv_amo_op (op, aq, rl, width) = - "amo" ^ - pp_riscv_amo_op_part op ^ - begin match width with - | RISCVWORD -> ".w" - | RISCVDOUBLE -> ".d" - | _ -> assert false - end ^ - (if aq then ".aq" else "") ^ - (if rl then ".rl" else "") - -let pp_riscv_fence_option = function - | 0b0011 -> "rw" - | 0b0010 -> "r" - | 0b0001 -> "w" - | _ -> failwith "unexpected fence option" - -type riscv_fence_mode = - | RISCV_FM_NORMAL - | RISCV_FM_TSO - diff --git a/riscv/gen/types_sail_trans_out.hgen b/riscv/gen/types_sail_trans_out.hgen deleted file mode 100644 index 66e8eec2..00000000 --- a/riscv/gen/types_sail_trans_out.hgen +++ /dev/null @@ -1,103 +0,0 @@ -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_simm21 imm = translate_out_signed_int imm 21 -let translate_out_simm20 imm = translate_out_signed_int imm 20 -let translate_out_simm13 imm = translate_out_signed_int imm 13 -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_imm4 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" - -let translate_out_amoop op = match translate_out_enum op with -| 0 -> RISCVAMOSWAP -| 1 -> RISCVAMOADD -| 2 -> RISCVAMOXOR -| 3 -> RISCVAMOAND -| 4 -> RISCVAMOOR -| 5 -> RISCVAMOMIN -| 6 -> RISCVAMOMAX -| 7 -> RISCVAMOMINU -| 8 -> RISCVAMOMAXU -| _ -> failwith "Unknown amoop in sail translate out" - -let translate_out_fm_mode mode = match translate_out_enum mode with -| 0 -> RISCV_FM_NORMAL -| 1 -> RISCV_FM_TSO -| _ -> failwith "Unknown fm_mode in sail translate out" diff --git a/riscv/gen/types_trans_sail.hgen b/riscv/gen/types_trans_sail.hgen deleted file mode 100644 index eb6aa458..00000000 --- a/riscv/gen/types_trans_sail.hgen +++ /dev/null @@ -1,59 +0,0 @@ -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_amoop = translate_enum [RISCVAMOSWAP; RISCVAMOADD; RISCVAMOXOR; RISCVAMOAND; RISCVAMOOR; RISCVAMOMIN; RISCVAMOMAX; RISCVAMOMINU; RISCVAMOMAXU] - -let translate_width = translate_enum [RISCVBYTE; RISCVHALF; RISCVWORD; RISCVDOUBLE] - -let translate_fm_mode = translate_enum [RISCV_FM_NORMAL; RISCV_FM_TSO] - -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_imm21 name value = - (name, Bvector (Some 21), bit_list_of_integer 21 (Nat_big_num.of_int value)) - -let translate_imm20 name value = - (name, Bvector (Some 20), bit_list_of_integer 20 (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_imm13 name value = - (name, Bvector (Some 13), bit_list_of_integer 13 (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_imm4 name value = - (name, Bvector (Some 4), bit_list_of_integer 4 (Nat_big_num.of_int value)) - -let translate_bool name value = - (name, Bit, [if value then Bitc_one else Bitc_zero]) diff --git a/riscv/main.sail b/riscv/main.sail deleted file mode 100644 index dbf41f49..00000000 --- a/riscv/main.sail +++ /dev/null @@ -1,26 +0,0 @@ -val elf_tohost = { - ocaml: "Elf_loader.elf_tohost", - c: "elf_tohost" -} : unit -> int - -val elf_entry = { - ocaml: "Elf_loader.elf_entry", - c: "elf_entry" -} : unit -> int - -val main : unit -> unit effect {barr, eamem, escape, exmem, rmem, rreg, wmv, wreg} - -function main () = { - - // PC = __GetSlice_int(64, elf_entry(), 0); - PC = zero_extend(0x1000, 64); - print_bits("PC = ", PC); - try { - init_platform(); - init_sys(); - loop() - } catch { - Error_not_implemented(s) => print_string("Error: Not implemented: ", s), - Error_internal_error() => print("Error: internal error") - } -} diff --git a/riscv/main_rvfi.sail b/riscv/main_rvfi.sail deleted file mode 100644 index 0ba4acfc..00000000 --- a/riscv/main_rvfi.sail +++ /dev/null @@ -1,108 +0,0 @@ -// Alternative fetch and step for RVFI DII mode. - -val rvfi_fetch : unit -> FetchResult effect {escape, rmem, rreg, wmv, wreg} - -function rvfi_fetch() = - /* check for legal PC */ - if (PC[0] != 0b0 | (PC[1] != 0b0 & (~ (haveRVC())))) - then F_Error(E_Fetch_Addr_Align, PC) - else { - let i = rvfi_instruction.rvfi_insn(); - rvfi_exec->rvfi_order() = minstret; - rvfi_exec->rvfi_pc_rdata() = PC; - rvfi_exec->rvfi_insn() = zero_extend(i,64); - /* TODO: should we write these even if they're not really registers? */ - rvfi_exec->rvfi_rs1_data() = X(i[19 .. 15]); - rvfi_exec->rvfi_rs2_data() = X(i[24 .. 20]); - rvfi_exec->rvfi_rs1_addr() = zero_extend(i[19 .. 15],8); - rvfi_exec->rvfi_rs2_addr() = zero_extend(i[24 .. 20],8); - if (i[1 .. 0] == 0b11) - then F_Base(i) - else F_RVC(i[15 .. 0]) - } - -// This should be kept in sync with the normal step - at the moment the only -// changes are to replace fetch by rvfi_fetch and record the next PC. - -/* returns whether to increment the step count in the trace */ -val rvfi_step : int -> bool effect {barr, eamem, escape, exmem, rmem, rreg, wmv, wreg} -function rvfi_step(step_no) = { - minstret_written = false; /* see note for minstret */ - let (retired, stepped) : (bool, bool) = - match curInterrupt(cur_privilege, mip, mie, mideleg) { - Some(intr, priv) => { - print_bits("Handling interrupt: ", intr); - handle_interrupt(intr, priv); - (false, false) - }, - None() => { - match rvfi_fetch() { - F_Error(e, addr) => { - handle_mem_exception(addr, e); - (false, false) - }, - F_RVC(h) => { - match decodeCompressed(h) { - None() => { - print("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(h) ^ ") <no-decode>"); - instbits = EXTZ(h); - handle_illegal(); - (false, true) - }, - Some(ast) => { - print("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(h) ^ ") " ^ ast); - nextPC = PC + 2; - (execute(ast), true) - } - } - }, - F_Base(w) => { - match decode(w) { - None() => { - print("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(w) ^ ") <no-decode>"); - instbits = EXTZ(w); - handle_illegal(); - (false, true) - }, - Some(ast) => { - print("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(w) ^ ") " ^ ast); - nextPC = PC + 4; - (execute(ast), true) - } - } - } - } - } - }; - PC = nextPC; - rvfi_exec->rvfi_pc_wdata() = PC; -//print_rvfi_exec(); - if retired then retire_instruction(); - stepped -} - - -/* Dummy to make sure that sail doesn't throw functions away */ - -val main : unit -> unit effect {barr, eamem, escape, exmem, rmem, rreg, wmv, wreg} - -function main () = { - - // PC = __GetSlice_int(64, elf_entry(), 0); - rvfi_set_instr_packet(0x0000000000000000); - print_bits("", rvfi_get_cmd()); - let _ = rvfi_step(0); - rvfi_zero_exec_packet(); - rvfi_halt_exec_packet(); - let _ = rvfi_get_exec_packet(); - PC = zero_extend(0x1000, 64); - print_bits("PC = ", PC); - try { - init_platform(); - init_sys(); - loop() - } catch { - Error_not_implemented(s) => print_string("Error: Not implemented: ", s), - Error_internal_error() => print("Error: internal error") - } -} diff --git a/riscv/platform.ml b/riscv/platform.ml deleted file mode 100644 index bdd5bd04..00000000 --- a/riscv/platform.ml +++ /dev/null @@ -1,172 +0,0 @@ -(**************************************************************************) -(* Sail *) -(* *) -(* Copyright (c) 2013-2017 *) -(* Kathyrn Gray *) -(* Shaked Flur *) -(* Stephen Kell *) -(* Gabriel Kerneis *) -(* Robert Norton-Wright *) -(* Christopher Pulte *) -(* Peter Sewell *) -(* Alasdair Armstrong *) -(* Brian Campbell *) -(* Thomas Bauereiss *) -(* Anthony Fox *) -(* Jon French *) -(* Dominic Mulligan *) -(* Stephen Kell *) -(* Mark Wassell *) -(* *) -(* All rights reserved. *) -(* *) -(* This software was developed by the University of Cambridge Computer *) -(* Laboratory as part of the Rigorous Engineering of Mainstream Systems *) -(* (REMS) project, funded by EPSRC grant EP/K008528/1. *) -(* *) -(* Redistribution and use in source and binary forms, with or without *) -(* modification, are permitted provided that the following conditions *) -(* are met: *) -(* 1. Redistributions of source code must retain the above copyright *) -(* notice, this list of conditions and the following disclaimer. *) -(* 2. Redistributions in binary form must reproduce the above copyright *) -(* notice, this list of conditions and the following disclaimer in *) -(* the documentation and/or other materials provided with the *) -(* distribution. *) -(* *) -(* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' *) -(* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED *) -(* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A *) -(* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR *) -(* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) -(* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) -(* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF *) -(* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *) -(* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, *) -(* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT *) -(* OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF *) -(* SUCH DAMAGE. *) -(**************************************************************************) - -open Sail_lib;; -module P = Platform_impl;; -module Elf = Elf_loader;; - -(* Platform configuration *) - -let config_enable_dirty_update = ref false -let config_enable_misaligned_access = ref false -let config_mtval_has_illegal_inst_bits = ref false - -(* logging *) - -let config_print_instr = ref true -let config_print_reg = ref true -let config_print_mem_access = ref true -let config_print_platform = ref true - -let print_instr s = - if !config_print_instr - then print_endline s - else () - -let print_reg s = - if !config_print_reg - then print_endline s - else () - -let print_mem_access s = - if !config_print_mem_access - then print_endline s - else () - -let print_platform s = - if !config_print_platform - then print_endline s - else () - -(* Mapping to Sail externs *) - -let bits_of_int i = - get_slice_int (Big_int.of_int 64, Big_int.of_int i, Big_int.zero) - -let bits_of_int64 i = - get_slice_int (Big_int.of_int 64, Big_int.of_int64 i, Big_int.zero) - -let rom_size_ref = ref 0 -let make_rom start_pc = - let reset_vec = List.concat (List.map P.uint32_to_bytes (P.reset_vec_int start_pc)) in - let dtb = P.make_dtb (P.make_dts ()) in - let rom = reset_vec @ dtb in - ( rom_size_ref := List.length rom; - (* - List.iteri (fun i c -> - print_mem_access "rom[0x%Lx] <- %x\n" - (Int64.add P.rom_base (Int64.of_int i)) - c - ) rom; - *) - rom ) - -let enable_dirty_update () = !config_enable_dirty_update -let enable_misaligned_access () = !config_enable_misaligned_access -let mtval_has_illegal_inst_bits () = !config_mtval_has_illegal_inst_bits - -let rom_base () = bits_of_int64 P.rom_base -let rom_size () = bits_of_int !rom_size_ref - -let dram_base () = bits_of_int64 P.dram_base -let dram_size () = bits_of_int64 !P.dram_size_ref - -let htif_tohost () = - bits_of_int64 (Big_int.to_int64 (Elf.elf_tohost ())) - -let clint_base () = bits_of_int64 P.clint_base -let clint_size () = bits_of_int64 P.clint_size - -let insns_per_tick () = Big_int.of_int P.insns_per_tick - -(* load reservation *) - -let reservation = ref "none" (* shouldn't match any valid address *) - -let load_reservation addr = - print_platform (Printf.sprintf "reservation <- %s\n" (string_of_bits addr)); - reservation := string_of_bits addr - -let match_reservation addr = - print_platform (Printf.sprintf "reservation: %s, key=%s\n" (!reservation) (string_of_bits addr)); - string_of_bits addr = !reservation - -let cancel_reservation () = - print_platform (Printf.sprintf "reservation <- none\n"); - reservation := "none" - -(* terminal I/O *) - -let term_write char_bits = - let big_char = Big_int.bitwise_and (uint char_bits) (Big_int.of_int 255) in - P.term_write (char_of_int (Big_int.to_int big_char)) - -let term_read () = - let c = P.term_read () in - bits_of_int (int_of_char c) - -(* returns starting value for PC, i.e. start of reset vector *) -let init elf_file = - Elf.load_elf elf_file; - - print_platform (Printf.sprintf "\nRegistered htif_tohost at 0x%Lx.\n" (Big_int.to_int64 (Elf.elf_tohost ()))); - print_platform (Printf.sprintf "Registered clint at 0x%Lx (size 0x%Lx).\n%!" P.clint_base P.clint_size); - - let start_pc = Elf.Big_int.to_int64 (Elf.elf_entry ()) in - let rom = make_rom start_pc in - let rom_base = Big_int.of_int64 P.rom_base in - let rec write_rom ofs = function - | [] -> () - | h :: tl -> let addr = Big_int.add rom_base (Big_int.of_int ofs) in - (wram addr h); - write_rom (ofs + 1) tl - in ( write_rom 0 rom; - get_slice_int (Big_int.of_int 64, rom_base, Big_int.zero) - ) diff --git a/riscv/platform_impl.ml b/riscv/platform_impl.ml deleted file mode 100644 index 3eb82179..00000000 --- a/riscv/platform_impl.ml +++ /dev/null @@ -1,189 +0,0 @@ -(* FIXME: copyright header *) - -(* int->byte converters in little-endian order *) - -let uint32_to_bytes u = let open Int32 in - List.map to_int - [ logand u 0xffl; - logand (shift_right u 8) 0xffl; - logand (shift_right u 16) 0xffl; - logand (shift_right u 24) 0xffl; - ] - -let uint64_to_bytes u = let open Int64 in - List.map to_int - [ logand u 0xffL; - logand (shift_right u 8) 0xffL; - logand (shift_right u 16) 0xffL; - logand (shift_right u 24) 0xffL; - logand (shift_right u 32) 0xffL; - logand (shift_right u 40) 0xffL; - logand (shift_right u 48) 0xffL; - logand (shift_right u 56) 0xffL; - ] - -(* reset vector for the rom *) - -let reset_vec_size = 8l;; - -let reset_vec_int start_pc = [ - 0x297l; (* auipc t0, 0x0 *) - (let open Int32 in - add 0x28593l (shift_left (mul reset_vec_size 4l) 20)); (* addi a1, t0, ofs(dtb) *) - 0xf1402573l; (* csrr a0, mhartid *) - 0x0182b283l; (* ld t0, 24(t0) *) - 0x28067l; (* jr t0 *) - 0x0l; - (let open Int64 in to_int32 (logand start_pc 0xffffffffL)); - (let open Int64 in to_int32 (shift_right_logical start_pc 32)); -] - -(* address map *) - -let dram_base = 0x80000000L;; (* Spike::DRAM_BASE *) -let clint_base = 0x02000000L;; (* Spike::CLINT_BASE *) -let clint_size = 0x000c0000L;; (* Spike::CLINT_SIZE *) -let rom_base = 0x00001000L;; (* Spike::DEFAULT_RSTVEC *) - -let dram_size_ref = ref (Int64.(shift_left 2048L 20)) - -type mem_region = { - addr : Int64.t; - size : Int64.t -} - -(* dts from spike *) -let spike_dts isa_spec cpu_hz insns_per_rtc_tick mems = - "/dts-v1/;\n" - ^ "\n" - ^ "/ {\n" - ^ " #address-cells = <2>;\n" - ^ " #size-cells = <2>;\n" - ^ " compatible = \"ucbbar,spike-bare-dev\";\n" - ^ " model = \"ucbbar,spike-bare\";\n" - ^ " cpus {\n" - ^ " #address-cells = <1>;\n" - ^ " #size-cells = <0>;\n" - ^ " timebase-frequency = <" ^ string_of_int (cpu_hz/insns_per_rtc_tick) ^ ">;\n" - ^ " CPU0: cpu@0 {\n" - ^ " device_type = \"cpu\";\n" - ^ " reg = <0>;\n" - ^ " status = \"okay\";\n" - ^ " compatible = \"riscv\";\n" - ^ " riscv,isa = \"" ^ isa_spec ^ "\";\n" - ^ " mmu-type = \"riscv,sv39\";\n" - ^ " clock-frequency = <" ^ string_of_int cpu_hz ^ ">;\n" - ^ " CPU0_intc: interrupt-controller {\n" - ^ " #interrupt-cells = <1>;\n" - ^ " interrupt-controller;\n" - ^ " compatible = \"riscv,cpu-intc\";\n" - ^ " };\n" - ^ " };\n" - ^ " };\n" - ^ (List.fold_left (^) "" - (List.map (fun m -> - " memory@" ^ Printf.sprintf "%Lx" m.addr ^ " {\n" - ^ " device_type = \"memory\";\n" - ^ " reg = <0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical m.addr 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand m.addr 0xffffffffL) - ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical m.size 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand m.size 0xffffffffL) ^ ">;\n" - ^ " };\n") mems)) - ^ " soc {\n" - ^ " #address-cells = <2>;\n" - ^ " #size-cells = <2>;\n" - ^ " compatible = \"ucbbar,spike-bare-soc\", \"simple-bus\";\n" - ^ " ranges;\n" - ^ " clint@" ^ Printf.sprintf "%Lx" clint_base ^ " {\n" - ^ " compatible = \"riscv,clint0\";\n" - ^ " interrupts-extended = <&CPU0_intc 3 &CPU0_intc 7 >;\n" - ^ " reg = <0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical clint_base 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand clint_base 0xffffffffL) - ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical clint_size 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand clint_size 0xffffffffL) ^ ">;\n" - ^ " };\n" - ^ " };\n" - ^ " htif {\n" - ^ " compatible = \"ucb,htif0\";\n" - ^ " };\n" - ^ "};\n" - -let cpu_hz = 1000000000;; -let insns_per_tick = 100;; - -let make_mems () = [{ addr = dram_base; - size = !dram_size_ref }];; - -let make_dts () = spike_dts "rv64imac" cpu_hz insns_per_tick (make_mems ());; - -let bytes_to_string bytes = - String.init (List.length bytes) (fun i -> Char.chr (List.nth bytes i)) - -let dtc_path = ref "/usr/bin/dtc" - -let set_dtc path = - try let st = Unix.stat path in - if st.Unix.st_kind = Unix.S_REG && st.Unix.st_perm != 0 - then dtc_path := path - else ( Printf.eprintf "%s doesn't seem like a valid executable.\n%!" path; - exit 1) - with Unix.Unix_error (e, _, _) -> - ( Printf.eprintf "Error accessing %s: %s\n%!" path (Unix.error_message e); - exit 1) - -let set_dram_size mb = - dram_size_ref := Int64.(shift_left (Int64.of_int mb) 20) - -let make_dtb dts = (* Call the dtc compiler, assumed to be at /usr/bin/dtc *) - try - let cmd = Printf.sprintf "%s -I dts" !dtc_path in - let (cfrom, cto, cerr) = - Unix.open_process_full cmd [||] - in ( - output_string cto dts; - (* print_endline " sent dts to dtc ..."; *) - close_out cto; - (* simple and stupid for now *) - let rec accum_bytes cin acc = - match ( - try Some (input_byte cin) - with End_of_file -> None - ) with - | Some b -> accum_bytes cin (b :: acc) - | None -> List.rev acc - in - (* let _ = print_endline " accumulating dtb ..." in *) - let dtb = accum_bytes cfrom [] in - (* let _ = print_endline " accumulating emsg ..." in *) - let emsg = bytes_to_string (accum_bytes cerr []) in - match Unix.close_process_full (cfrom, cto, cerr) with - | Unix.WEXITED 0 -> dtb - | _ -> (Printf.printf "%s\n%!" ("Error executing dtc: " ^ emsg); - exit 1) - ) - with Unix.Unix_error (e, fn, _) -> - (Printf.printf "%s\n" ("Error executing dtc: " ^ fn ^ ": " ^ Unix.error_message e); - exit 1) - -(* Terminal I/O *) - -let term_write char = - ignore (Unix.write_substring Unix.stderr (String.make 1 char) 0 1) - -let rec term_read () = - let buf = Bytes.make 1 '\000' in - let nbytes = Unix.read Unix.stdin buf 0 1 in - (* todo: handle nbytes == 0 *) - Bytes.get buf 0 - -(* Platform diagnostics *) - -let show_bytes s = - output_string stdout s - -let dump_dts () = show_bytes (make_dts ()) -let dump_dtb () = show_bytes (bytes_to_string (make_dtb (make_dts ()))) - -(* -let save_string_to_file s fname = - let out = open_out fname in - output_string out s; - close_out out;; - - *) diff --git a/riscv/platform_main.ml b/riscv/platform_main.ml deleted file mode 100644 index 1c9ba209..00000000 --- a/riscv/platform_main.ml +++ /dev/null @@ -1,131 +0,0 @@ -(**************************************************************************) -(* Sail *) -(* *) -(* Copyright (c) 2013-2017 *) -(* Kathyrn Gray *) -(* Shaked Flur *) -(* Stephen Kell *) -(* Gabriel Kerneis *) -(* Robert Norton-Wright *) -(* Christopher Pulte *) -(* Peter Sewell *) -(* Alasdair Armstrong *) -(* Brian Campbell *) -(* Thomas Bauereiss *) -(* Anthony Fox *) -(* Jon French *) -(* Dominic Mulligan *) -(* Stephen Kell *) -(* Mark Wassell *) -(* *) -(* All rights reserved. *) -(* *) -(* This software was developed by the University of Cambridge Computer *) -(* Laboratory as part of the Rigorous Engineering of Mainstream Systems *) -(* (REMS) project, funded by EPSRC grant EP/K008528/1. *) -(* *) -(* Redistribution and use in source and binary forms, with or without *) -(* modification, are permitted provided that the following conditions *) -(* are met: *) -(* 1. Redistributions of source code must retain the above copyright *) -(* notice, this list of conditions and the following disclaimer. *) -(* 2. Redistributions in binary form must reproduce the above copyright *) -(* notice, this list of conditions and the following disclaimer in *) -(* the documentation and/or other materials provided with the *) -(* distribution. *) -(* *) -(* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' *) -(* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED *) -(* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A *) -(* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR *) -(* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, *) -(* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT *) -(* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF *) -(* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *) -(* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, *) -(* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT *) -(* OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF *) -(* SUCH DAMAGE. *) -(**************************************************************************) - -open Elf_loader -open Sail_lib -open Riscv -module PI = Platform_impl -module P = Platform - -(* OCaml driver for generated RISC-V model. *) - -let opt_file_arguments = ref ([] : string list) - -let opt_dump_dts = ref false -let opt_dump_dtb = ref false - -let options = Arg.align ([("-dump-dts", - Arg.Set opt_dump_dts, - " dump the platform device-tree source to stdout"); - ("-dump-dtb", - Arg.Set opt_dump_dtb, - " dump the *binary* platform device-tree blob to stdout"); - ("-enable-dirty-update", - Arg.Set P.config_enable_dirty_update, - " enable dirty-bit update during page-table walks"); - ("-enable-misaligned-access", - Arg.Set P.config_enable_misaligned_access, - " enable misaligned accesses without M-mode traps"); - ("-mtval-has-illegal-inst-bits", - Arg.Set P.config_mtval_has_illegal_inst_bits, - " mtval stores instruction bits on an illegal instruction exception"); - ("-ram-size", - Arg.Int PI.set_dram_size, - " size of physical ram memory to use (in MB)"); - ("-with-dtc", - Arg.String PI.set_dtc, - " full path to dtc to use") - ]) - -let usage_msg = "RISC-V platform options:" - -let elf_arg = - Arg.parse options (fun s -> opt_file_arguments := !opt_file_arguments @ [s]) - usage_msg; - if !opt_dump_dts then (PI.dump_dts (); exit 0); - if !opt_dump_dtb then (PI.dump_dtb (); exit 0); - ( match !opt_file_arguments with - | f :: _ -> prerr_endline ("Sail/RISC-V: running ELF file " ^ f); f - | _ -> (prerr_endline "Please provide an ELF file."; exit 0) - ) - -let run pc = - sail_call - (fun r -> - try ( zinit_platform (); (* devices *) - zinit_sys (); (* processor *) - zPC := pc; - zloop () - ) - with - | ZError_not_implemented (zs) -> - print_string ("Error: Not implemented: ", zs) - | ZError_internal_error (_) -> - prerr_endline "Error: internal error" - ) - -let show_times init_s init_e run_e insts = - let init_time = init_e.Unix.tms_utime -. init_s.Unix.tms_utime in - let exec_time = run_e.Unix.tms_utime -. init_e.Unix.tms_utime in - Printf.eprintf "\nInitialization: %g secs\n" init_time; - Printf.eprintf "Execution: %g secs\n" exec_time; - Printf.eprintf "Instructions retired: %Ld\n" insts; - Printf.eprintf "Perf: %g ips\n" ((Int64.to_float insts) /. exec_time) - -let () = - Random.self_init (); - - let init_start = Unix.times () in - let pc = Platform.init elf_arg in - let init_end = Unix.times () in - let _ = run pc in - let run_end = Unix.times () in - let insts = Big_int.to_int64 (uint (!Riscv.zminstret)) in - show_times init_start init_end run_end insts diff --git a/riscv/prelude.sail b/riscv/prelude.sail deleted file mode 100644 index 2547c33d..00000000 --- a/riscv/prelude.sail +++ /dev/null @@ -1,1154 +0,0 @@ -default Order dec - -$include <flow.sail> - -type bits ('n : Int) = vector('n, dec, bit) -union option ('a : Type) = {None : unit, Some : 'a} - -val spc : unit <-> string -val opt_spc : unit <-> string -val def_spc : unit <-> string - -val hex_bits : forall 'n . (atom('n), bits('n)) <-> string - -val string_startswith = "string_startswith" : (string, string) -> bool -val string_drop = "string_drop" : (string, nat) -> string -val string_take = "string_take" : (string, nat) -> string -val string_length = "string_length" : string -> nat -val string_append = {c: "concat_str", _: "string_append"} : (string, string) -> string -val maybe_int_of_prefix = "maybe_int_of_prefix" : string -> option((int, nat)) -val maybe_nat_of_prefix = "maybe_nat_of_prefix" : string -> option((nat, nat)) -val maybe_int_of_string = "maybe_int_of_string" : string -> option(int) - -/* Python: -f = """val hex_bits_{0} : bits({0}) <-> string -val hex_bits_{0}_forwards = "decimal_string_of_bits" : bits({0}) -> string -val hex_bits_{0}_forwards_matches : bits({0}) -> bool -function hex_bits_{0}_forwards_matches bv = true -val "hex_bits_{0}_matches_prefix" : string -> option((bits({0}), nat)) -val hex_bits_{0}_backwards_matches : string -> bool -function hex_bits_{0}_backwards_matches s = match s {{ - s if match hex_bits_{0}_matches_prefix(s) {{ - Some (_, n) if n == string_length(s) => true, - _ => false - }} => true, - _ => false -}} -val hex_bits_{0}_backwards : string -> bits({0}) -function hex_bits_{0}_backwards s = - match hex_bits_{0}_matches_prefix(s) {{ - Some (bv, n) if n == string_length(s) => bv - }} -""" - -for i in list(range(1, 34)) + [48, 64]: - print(f.format(i)) - -*/ -val hex_bits_1 : bits(1) <-> string -val hex_bits_1_forwards = "decimal_string_of_bits" : bits(1) -> string -val hex_bits_1_forwards_matches : bits(1) -> bool -function hex_bits_1_forwards_matches bv = true -val "hex_bits_1_matches_prefix" : string -> option((bits(1), nat)) -val hex_bits_1_backwards_matches : string -> bool -function hex_bits_1_backwards_matches s = match s { - s if match hex_bits_1_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_1_backwards : string -> bits(1) -function hex_bits_1_backwards s = - match hex_bits_1_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_2 : bits(2) <-> string -val hex_bits_2_forwards = "decimal_string_of_bits" : bits(2) -> string -val hex_bits_2_forwards_matches : bits(2) -> bool -function hex_bits_2_forwards_matches bv = true -val "hex_bits_2_matches_prefix" : string -> option((bits(2), nat)) -val hex_bits_2_backwards_matches : string -> bool -function hex_bits_2_backwards_matches s = match s { - s if match hex_bits_2_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_2_backwards : string -> bits(2) -function hex_bits_2_backwards s = - match hex_bits_2_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_3 : bits(3) <-> string -val hex_bits_3_forwards = "decimal_string_of_bits" : bits(3) -> string -val hex_bits_3_forwards_matches : bits(3) -> bool -function hex_bits_3_forwards_matches bv = true -val "hex_bits_3_matches_prefix" : string -> option((bits(3), nat)) -val hex_bits_3_backwards_matches : string -> bool -function hex_bits_3_backwards_matches s = match s { - s if match hex_bits_3_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_3_backwards : string -> bits(3) -function hex_bits_3_backwards s = - match hex_bits_3_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_4 : bits(4) <-> string -val hex_bits_4_forwards = "decimal_string_of_bits" : bits(4) -> string -val hex_bits_4_forwards_matches : bits(4) -> bool -function hex_bits_4_forwards_matches bv = true -val "hex_bits_4_matches_prefix" : string -> option((bits(4), nat)) -val hex_bits_4_backwards_matches : string -> bool -function hex_bits_4_backwards_matches s = match s { - s if match hex_bits_4_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_4_backwards : string -> bits(4) -function hex_bits_4_backwards s = - match hex_bits_4_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_5 : bits(5) <-> string -val hex_bits_5_forwards = "decimal_string_of_bits" : bits(5) -> string -val hex_bits_5_forwards_matches : bits(5) -> bool -function hex_bits_5_forwards_matches bv = true -val "hex_bits_5_matches_prefix" : string -> option((bits(5), nat)) -val hex_bits_5_backwards_matches : string -> bool -function hex_bits_5_backwards_matches s = match s { - s if match hex_bits_5_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_5_backwards : string -> bits(5) -function hex_bits_5_backwards s = - match hex_bits_5_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_6 : bits(6) <-> string -val hex_bits_6_forwards = "decimal_string_of_bits" : bits(6) -> string -val hex_bits_6_forwards_matches : bits(6) -> bool -function hex_bits_6_forwards_matches bv = true -val "hex_bits_6_matches_prefix" : string -> option((bits(6), nat)) -val hex_bits_6_backwards_matches : string -> bool -function hex_bits_6_backwards_matches s = match s { - s if match hex_bits_6_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_6_backwards : string -> bits(6) -function hex_bits_6_backwards s = - match hex_bits_6_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_7 : bits(7) <-> string -val hex_bits_7_forwards = "decimal_string_of_bits" : bits(7) -> string -val hex_bits_7_forwards_matches : bits(7) -> bool -function hex_bits_7_forwards_matches bv = true -val "hex_bits_7_matches_prefix" : string -> option((bits(7), nat)) -val hex_bits_7_backwards_matches : string -> bool -function hex_bits_7_backwards_matches s = match s { - s if match hex_bits_7_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_7_backwards : string -> bits(7) -function hex_bits_7_backwards s = - match hex_bits_7_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_8 : bits(8) <-> string -val hex_bits_8_forwards = "decimal_string_of_bits" : bits(8) -> string -val hex_bits_8_forwards_matches : bits(8) -> bool -function hex_bits_8_forwards_matches bv = true -val "hex_bits_8_matches_prefix" : string -> option((bits(8), nat)) -val hex_bits_8_backwards_matches : string -> bool -function hex_bits_8_backwards_matches s = match s { - s if match hex_bits_8_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_8_backwards : string -> bits(8) -function hex_bits_8_backwards s = - match hex_bits_8_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_9 : bits(9) <-> string -val hex_bits_9_forwards = "decimal_string_of_bits" : bits(9) -> string -val hex_bits_9_forwards_matches : bits(9) -> bool -function hex_bits_9_forwards_matches bv = true -val "hex_bits_9_matches_prefix" : string -> option((bits(9), nat)) -val hex_bits_9_backwards_matches : string -> bool -function hex_bits_9_backwards_matches s = match s { - s if match hex_bits_9_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_9_backwards : string -> bits(9) -function hex_bits_9_backwards s = - match hex_bits_9_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_10 : bits(10) <-> string -val hex_bits_10_forwards = "decimal_string_of_bits" : bits(10) -> string -val hex_bits_10_forwards_matches : bits(10) -> bool -function hex_bits_10_forwards_matches bv = true -val "hex_bits_10_matches_prefix" : string -> option((bits(10), nat)) -val hex_bits_10_backwards_matches : string -> bool -function hex_bits_10_backwards_matches s = match s { - s if match hex_bits_10_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_10_backwards : string -> bits(10) -function hex_bits_10_backwards s = - match hex_bits_10_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_11 : bits(11) <-> string -val hex_bits_11_forwards = "decimal_string_of_bits" : bits(11) -> string -val hex_bits_11_forwards_matches : bits(11) -> bool -function hex_bits_11_forwards_matches bv = true -val "hex_bits_11_matches_prefix" : string -> option((bits(11), nat)) -val hex_bits_11_backwards_matches : string -> bool -function hex_bits_11_backwards_matches s = match s { - s if match hex_bits_11_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_11_backwards : string -> bits(11) -function hex_bits_11_backwards s = - match hex_bits_11_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_12 : bits(12) <-> string -val hex_bits_12_forwards = "decimal_string_of_bits" : bits(12) -> string -val hex_bits_12_forwards_matches : bits(12) -> bool -function hex_bits_12_forwards_matches bv = true -val "hex_bits_12_matches_prefix" : string -> option((bits(12), nat)) -val hex_bits_12_backwards_matches : string -> bool -function hex_bits_12_backwards_matches s = match s { - s if match hex_bits_12_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_12_backwards : string -> bits(12) -function hex_bits_12_backwards s = - match hex_bits_12_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_13 : bits(13) <-> string -val hex_bits_13_forwards = "decimal_string_of_bits" : bits(13) -> string -val hex_bits_13_forwards_matches : bits(13) -> bool -function hex_bits_13_forwards_matches bv = true -val "hex_bits_13_matches_prefix" : string -> option((bits(13), nat)) -val hex_bits_13_backwards_matches : string -> bool -function hex_bits_13_backwards_matches s = match s { - s if match hex_bits_13_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_13_backwards : string -> bits(13) -function hex_bits_13_backwards s = - match hex_bits_13_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_14 : bits(14) <-> string -val hex_bits_14_forwards = "decimal_string_of_bits" : bits(14) -> string -val hex_bits_14_forwards_matches : bits(14) -> bool -function hex_bits_14_forwards_matches bv = true -val "hex_bits_14_matches_prefix" : string -> option((bits(14), nat)) -val hex_bits_14_backwards_matches : string -> bool -function hex_bits_14_backwards_matches s = match s { - s if match hex_bits_14_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_14_backwards : string -> bits(14) -function hex_bits_14_backwards s = - match hex_bits_14_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_15 : bits(15) <-> string -val hex_bits_15_forwards = "decimal_string_of_bits" : bits(15) -> string -val hex_bits_15_forwards_matches : bits(15) -> bool -function hex_bits_15_forwards_matches bv = true -val "hex_bits_15_matches_prefix" : string -> option((bits(15), nat)) -val hex_bits_15_backwards_matches : string -> bool -function hex_bits_15_backwards_matches s = match s { - s if match hex_bits_15_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_15_backwards : string -> bits(15) -function hex_bits_15_backwards s = - match hex_bits_15_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_16 : bits(16) <-> string -val hex_bits_16_forwards = "decimal_string_of_bits" : bits(16) -> string -val hex_bits_16_forwards_matches : bits(16) -> bool -function hex_bits_16_forwards_matches bv = true -val "hex_bits_16_matches_prefix" : string -> option((bits(16), nat)) -val hex_bits_16_backwards_matches : string -> bool -function hex_bits_16_backwards_matches s = match s { - s if match hex_bits_16_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_16_backwards : string -> bits(16) -function hex_bits_16_backwards s = - match hex_bits_16_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_17 : bits(17) <-> string -val hex_bits_17_forwards = "decimal_string_of_bits" : bits(17) -> string -val hex_bits_17_forwards_matches : bits(17) -> bool -function hex_bits_17_forwards_matches bv = true -val "hex_bits_17_matches_prefix" : string -> option((bits(17), nat)) -val hex_bits_17_backwards_matches : string -> bool -function hex_bits_17_backwards_matches s = match s { - s if match hex_bits_17_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_17_backwards : string -> bits(17) -function hex_bits_17_backwards s = - match hex_bits_17_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_18 : bits(18) <-> string -val hex_bits_18_forwards = "decimal_string_of_bits" : bits(18) -> string -val hex_bits_18_forwards_matches : bits(18) -> bool -function hex_bits_18_forwards_matches bv = true -val "hex_bits_18_matches_prefix" : string -> option((bits(18), nat)) -val hex_bits_18_backwards_matches : string -> bool -function hex_bits_18_backwards_matches s = match s { - s if match hex_bits_18_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_18_backwards : string -> bits(18) -function hex_bits_18_backwards s = - match hex_bits_18_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_19 : bits(19) <-> string -val hex_bits_19_forwards = "decimal_string_of_bits" : bits(19) -> string -val hex_bits_19_forwards_matches : bits(19) -> bool -function hex_bits_19_forwards_matches bv = true -val "hex_bits_19_matches_prefix" : string -> option((bits(19), nat)) -val hex_bits_19_backwards_matches : string -> bool -function hex_bits_19_backwards_matches s = match s { - s if match hex_bits_19_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_19_backwards : string -> bits(19) -function hex_bits_19_backwards s = - match hex_bits_19_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_20 : bits(20) <-> string -val hex_bits_20_forwards = "decimal_string_of_bits" : bits(20) -> string -val hex_bits_20_forwards_matches : bits(20) -> bool -function hex_bits_20_forwards_matches bv = true -val "hex_bits_20_matches_prefix" : string -> option((bits(20), nat)) -val hex_bits_20_backwards_matches : string -> bool -function hex_bits_20_backwards_matches s = match s { - s if match hex_bits_20_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_20_backwards : string -> bits(20) -function hex_bits_20_backwards s = - match hex_bits_20_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_21 : bits(21) <-> string -val hex_bits_21_forwards = "decimal_string_of_bits" : bits(21) -> string -val hex_bits_21_forwards_matches : bits(21) -> bool -function hex_bits_21_forwards_matches bv = true -val "hex_bits_21_matches_prefix" : string -> option((bits(21), nat)) -val hex_bits_21_backwards_matches : string -> bool -function hex_bits_21_backwards_matches s = match s { - s if match hex_bits_21_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_21_backwards : string -> bits(21) -function hex_bits_21_backwards s = - match hex_bits_21_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_22 : bits(22) <-> string -val hex_bits_22_forwards = "decimal_string_of_bits" : bits(22) -> string -val hex_bits_22_forwards_matches : bits(22) -> bool -function hex_bits_22_forwards_matches bv = true -val "hex_bits_22_matches_prefix" : string -> option((bits(22), nat)) -val hex_bits_22_backwards_matches : string -> bool -function hex_bits_22_backwards_matches s = match s { - s if match hex_bits_22_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_22_backwards : string -> bits(22) -function hex_bits_22_backwards s = - match hex_bits_22_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_23 : bits(23) <-> string -val hex_bits_23_forwards = "decimal_string_of_bits" : bits(23) -> string -val hex_bits_23_forwards_matches : bits(23) -> bool -function hex_bits_23_forwards_matches bv = true -val "hex_bits_23_matches_prefix" : string -> option((bits(23), nat)) -val hex_bits_23_backwards_matches : string -> bool -function hex_bits_23_backwards_matches s = match s { - s if match hex_bits_23_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_23_backwards : string -> bits(23) -function hex_bits_23_backwards s = - match hex_bits_23_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_24 : bits(24) <-> string -val hex_bits_24_forwards = "decimal_string_of_bits" : bits(24) -> string -val hex_bits_24_forwards_matches : bits(24) -> bool -function hex_bits_24_forwards_matches bv = true -val "hex_bits_24_matches_prefix" : string -> option((bits(24), nat)) -val hex_bits_24_backwards_matches : string -> bool -function hex_bits_24_backwards_matches s = match s { - s if match hex_bits_24_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_24_backwards : string -> bits(24) -function hex_bits_24_backwards s = - match hex_bits_24_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_25 : bits(25) <-> string -val hex_bits_25_forwards = "decimal_string_of_bits" : bits(25) -> string -val hex_bits_25_forwards_matches : bits(25) -> bool -function hex_bits_25_forwards_matches bv = true -val "hex_bits_25_matches_prefix" : string -> option((bits(25), nat)) -val hex_bits_25_backwards_matches : string -> bool -function hex_bits_25_backwards_matches s = match s { - s if match hex_bits_25_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_25_backwards : string -> bits(25) -function hex_bits_25_backwards s = - match hex_bits_25_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_26 : bits(26) <-> string -val hex_bits_26_forwards = "decimal_string_of_bits" : bits(26) -> string -val hex_bits_26_forwards_matches : bits(26) -> bool -function hex_bits_26_forwards_matches bv = true -val "hex_bits_26_matches_prefix" : string -> option((bits(26), nat)) -val hex_bits_26_backwards_matches : string -> bool -function hex_bits_26_backwards_matches s = match s { - s if match hex_bits_26_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_26_backwards : string -> bits(26) -function hex_bits_26_backwards s = - match hex_bits_26_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_27 : bits(27) <-> string -val hex_bits_27_forwards = "decimal_string_of_bits" : bits(27) -> string -val hex_bits_27_forwards_matches : bits(27) -> bool -function hex_bits_27_forwards_matches bv = true -val "hex_bits_27_matches_prefix" : string -> option((bits(27), nat)) -val hex_bits_27_backwards_matches : string -> bool -function hex_bits_27_backwards_matches s = match s { - s if match hex_bits_27_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_27_backwards : string -> bits(27) -function hex_bits_27_backwards s = - match hex_bits_27_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_28 : bits(28) <-> string -val hex_bits_28_forwards = "decimal_string_of_bits" : bits(28) -> string -val hex_bits_28_forwards_matches : bits(28) -> bool -function hex_bits_28_forwards_matches bv = true -val "hex_bits_28_matches_prefix" : string -> option((bits(28), nat)) -val hex_bits_28_backwards_matches : string -> bool -function hex_bits_28_backwards_matches s = match s { - s if match hex_bits_28_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_28_backwards : string -> bits(28) -function hex_bits_28_backwards s = - match hex_bits_28_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_29 : bits(29) <-> string -val hex_bits_29_forwards = "decimal_string_of_bits" : bits(29) -> string -val hex_bits_29_forwards_matches : bits(29) -> bool -function hex_bits_29_forwards_matches bv = true -val "hex_bits_29_matches_prefix" : string -> option((bits(29), nat)) -val hex_bits_29_backwards_matches : string -> bool -function hex_bits_29_backwards_matches s = match s { - s if match hex_bits_29_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_29_backwards : string -> bits(29) -function hex_bits_29_backwards s = - match hex_bits_29_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_30 : bits(30) <-> string -val hex_bits_30_forwards = "decimal_string_of_bits" : bits(30) -> string -val hex_bits_30_forwards_matches : bits(30) -> bool -function hex_bits_30_forwards_matches bv = true -val "hex_bits_30_matches_prefix" : string -> option((bits(30), nat)) -val hex_bits_30_backwards_matches : string -> bool -function hex_bits_30_backwards_matches s = match s { - s if match hex_bits_30_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_30_backwards : string -> bits(30) -function hex_bits_30_backwards s = - match hex_bits_30_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_31 : bits(31) <-> string -val hex_bits_31_forwards = "decimal_string_of_bits" : bits(31) -> string -val hex_bits_31_forwards_matches : bits(31) -> bool -function hex_bits_31_forwards_matches bv = true -val "hex_bits_31_matches_prefix" : string -> option((bits(31), nat)) -val hex_bits_31_backwards_matches : string -> bool -function hex_bits_31_backwards_matches s = match s { - s if match hex_bits_31_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_31_backwards : string -> bits(31) -function hex_bits_31_backwards s = - match hex_bits_31_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_32 : bits(32) <-> string -val hex_bits_32_forwards = "decimal_string_of_bits" : bits(32) -> string -val hex_bits_32_forwards_matches : bits(32) -> bool -function hex_bits_32_forwards_matches bv = true -val "hex_bits_32_matches_prefix" : string -> option((bits(32), nat)) -val hex_bits_32_backwards_matches : string -> bool -function hex_bits_32_backwards_matches s = match s { - s if match hex_bits_32_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_32_backwards : string -> bits(32) -function hex_bits_32_backwards s = - match hex_bits_32_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_33 : bits(33) <-> string -val hex_bits_33_forwards = "decimal_string_of_bits" : bits(33) -> string -val hex_bits_33_forwards_matches : bits(33) -> bool -function hex_bits_33_forwards_matches bv = true -val "hex_bits_33_matches_prefix" : string -> option((bits(33), nat)) -val hex_bits_33_backwards_matches : string -> bool -function hex_bits_33_backwards_matches s = match s { - s if match hex_bits_33_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_33_backwards : string -> bits(33) -function hex_bits_33_backwards s = - match hex_bits_33_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_48 : bits(48) <-> string -val hex_bits_48_forwards = "decimal_string_of_bits" : bits(48) -> string -val hex_bits_48_forwards_matches : bits(48) -> bool -function hex_bits_48_forwards_matches bv = true -val "hex_bits_48_matches_prefix" : string -> option((bits(48), nat)) -val hex_bits_48_backwards_matches : string -> bool -function hex_bits_48_backwards_matches s = match s { - s if match hex_bits_48_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_48_backwards : string -> bits(48) -function hex_bits_48_backwards s = - match hex_bits_48_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val hex_bits_64 : bits(64) <-> string -val hex_bits_64_forwards = "decimal_string_of_bits" : bits(64) -> string -val hex_bits_64_forwards_matches : bits(64) -> bool -function hex_bits_64_forwards_matches bv = true -val "hex_bits_64_matches_prefix" : string -> option((bits(64), nat)) -val hex_bits_64_backwards_matches : string -> bool -function hex_bits_64_backwards_matches s = match s { - s if match hex_bits_64_matches_prefix(s) { - Some (_, n) if n == string_length(s) => true, - _ => false - } => true, - _ => false -} -val hex_bits_64_backwards : string -> bits(64) -function hex_bits_64_backwards s = - match hex_bits_64_matches_prefix(s) { - Some (bv, n) if n == string_length(s) => bv - } - -val eq_vec = {ocaml: "eq_list", lem: "eq_vec", coq: "eq_vec", c: "eq_bits"} : forall 'n. (bits('n), bits('n)) -> bool - -val eq_string = {c: "eq_string", ocaml: "eq_string", lem: "eq", coq: "generic_eq"} : (string, string) -> bool - -val eq_real = {ocaml: "eq_real", lem: "eq"} : (real, real) -> bool - -val eq_anything = {ocaml: "(fun (x, y) -> x = y)", lem: "eq", coq: "generic_eq"} : forall ('a : Type). ('a, 'a) -> bool - -val bitvector_length = {ocaml: "length", lem: "length", coq: "length_mword"} : forall 'n. bits('n) -> atom('n) -val vector_length = {ocaml: "length", lem: "length_list", coq: "vec_length"} : forall 'n ('a : Type). vector('n, dec, 'a) -> atom('n) -val list_length = {ocaml: "length", lem: "length_list", coq: "length_list"} : forall ('a : Type). list('a) -> int - -overload length = {bitvector_length, vector_length, list_length} - -val "reg_deref" : forall ('a : Type). register('a) -> 'a effect {rreg} -/* sneaky deref with no effect necessary for bitfield writes */ -val _reg_deref = "reg_deref" : forall ('a : Type). register('a) -> 'a - -overload operator == = {eq_vec, eq_string, eq_real, eq_anything} - -val vector_subrange = { - ocaml: "subrange", - lem: "subrange_vec_dec", - c: "vector_subrange", - coq: "subrange_vec_dec" -} : forall ('n : Int) ('m : Int) ('o : Int), 0 <= 'o <= 'm < 'n. - (bits('n), atom('m), atom('o)) -> bits('m - 'o + 1) -/* -val vector_subrange = {ocaml: "subrange", lem: "subrange_vec_dec", coq: "subrange_vec_dec"} : forall ('n : Int) ('m : Int) ('o : Int), 'o <= 'm <= 'n. - (bits('n), atom('m), atom('o)) -> bits('m - ('o - 1)) -*/ - -val bitvector_access = {c: "bitvector_access", ocaml: "access", lem: "access_vec_dec", coq: "access_vec_dec"} : forall ('n : Int) ('m : Int), 0 <= 'm < 'n. - (bits('n), atom('m)) -> bit - -val any_vector_access = {ocaml: "access", lem: "access_list_dec", coq: "vec_access_dec"} : forall ('n : Int) ('m : Int) ('a : Type), 0 <= 'm < 'n. - (vector('n, dec, 'a), atom('m)) -> 'a - -overload vector_access = {bitvector_access, any_vector_access} - -val bitvector_update = {ocaml: "update", lem: "update_vec_dec", coq: "update_vec_dec"} : forall 'n. - (bits('n), int, bit) -> bits('n) - -val any_vector_update = {ocaml: "update", lem: "update_list_dec", coq: "vector_update"} : forall 'n ('a : Type). - (vector('n, dec, 'a), int, 'a) -> vector('n, dec, 'a) - -overload vector_update = {bitvector_update, any_vector_update} - -val update_subrange = {ocaml: "update_subrange", lem: "update_subrange_vec_dec", coq: "update_subrange_vec_dec"} : forall 'n 'm 'o. - (bits('n), atom('m), atom('o), bits('m - ('o - 1))) -> bits('n) - -val vcons = {lem: "cons_vec"} : forall ('n : Int) ('a : Type). - ('a, vector('n, dec, 'a)) -> vector('n + 1, dec, 'a) - -val bitvector_concat = {c: "append", ocaml: "append", lem: "concat_vec", coq: "concat_vec"} : forall ('n : Int) ('m : Int). - (bits('n), bits('m)) -> bits('n + 'm) - -val vector_concat = {ocaml: "append", lem: "append_list"} : forall ('n : Int) ('m : Int) ('a : Type). - (vector('n, dec, 'a), vector('m, dec, 'a)) -> vector('n + 'm, dec, 'a) - -overload append = {bitvector_concat, vector_concat} - -val not_vec = {c: "not_bits", _: "not_vec"} : forall 'n. bits('n) -> bits('n) - -overload ~ = {not_bool, not_vec} - -val neq_vec = {lem: "neq"} : forall 'n. (bits('n), bits('n)) -> bool - -function neq_vec (x, y) = not_bool(eq_vec(x, y)) - -val neq_anything = {lem: "neq", coq: "generic_neq"} : forall ('a : Type). ('a, 'a) -> bool - -function neq_anything (x, y) = not_bool(x == y) - -overload operator != = {neq_vec, neq_anything} - -val and_vec = {lem: "and_vec", c: "and_bits", coq: "and_vec", ocaml: "and_vec"} : forall 'n. (bits('n), bits('n)) -> bits('n) - -overload operator & = {and_vec} - -val or_vec = {lem: "or_vec", c: "or_bits", coq: "or_vec", ocaml: "or_vec"} : forall 'n. (bits('n), bits('n)) -> bits('n) - -overload operator | = {or_vec} - -val unsigned = {ocaml: "uint", lem: "uint", coq: "uint", c: "sail_unsigned"} : forall 'n. bits('n) -> range(0, 2 ^ 'n - 1) - -val signed = {ocaml: "sint", lem: "sint", coq: "sint", c: "sail_signed"} : forall 'n. bits('n) -> range(- (2 ^ ('n - 1)), 2 ^ ('n - 1) - 1) - -val hex_slice = "hex_slice" : forall 'n 'm, 'n >= 'm. (string, atom('n), atom('m)) -> bits('n - 'm) - -val __SetSlice_bits = "set_slice" : forall 'n 'm. - (atom('n), atom('m), bits('n), int, bits('m)) -> bits('n) - -val __SetSlice_int = "set_slice_int" : forall 'w. (atom('w), int, int, bits('w)) -> int - -val __raw_SetSlice_int : forall 'w. (atom('w), int, int, bits('w)) -> int - -val __raw_GetSlice_int = "get_slice_int" : forall 'w, 'w >= 0. (atom('w), int, int) -> bits('w) - -val __GetSlice_int : forall 'n, 'n >= 0. (atom('n), int, int) -> bits('n) - -function __GetSlice_int (n, m, o) = __raw_GetSlice_int(n, m, o) - -val __raw_SetSlice_bits : forall 'n 'w. - (atom('n), atom('w), bits('n), int, bits('w)) -> bits('n) - -val __raw_GetSlice_bits : forall 'n 'w, 'w >= 0. - (atom('n), atom('w), bits('n), int) -> bits('w) - -val "shiftl" : forall 'm. (bits('m), int) -> bits('m) -val "shiftr" : forall 'm. (bits('m), int) -> bits('m) - -val __SignExtendSlice = {lem: "exts_slice"} : forall 'm. (bits('m), int, int) -> bits('m) - -val __ZeroExtendSlice = {lem: "extz_slice"} : forall 'm. (bits('m), int, int) -> bits('m) - -val cast cast_unit_vec : bit -> bits(1) - -function cast_unit_vec b = match b { - bitzero => 0b0, - bitone => 0b1 -} - -val putchar = "putchar" : forall ('a : Type). 'a -> unit - -val concat_str = {c: "concat_str", ocaml: "concat_str", lem: "stringAppend", coq: "String.append"} : (string, string) -> string - -val string_of_int = {c: "string_of_int", ocaml: "string_of_int", lem: "stringFromInteger", coq: "string_of_int"} : int -> string - -val DecStr : int -> string - -val HexStr : int -> string - -val BitStr = "string_of_bits" : forall 'n. bits('n) -> string -val "decimal_string_of_bits" : forall 'n. bits('n) -> string - -val xor_vec = {c: "xor_bits", _: "xor_vec"} : forall 'n. (bits('n), bits('n)) -> bits('n) - -val int_power = {ocaml: "int_power", lem: "pow", coq: "pow", c: "pow_int"} : (int, int) -> int - -val real_power = {ocaml: "real_power", lem: "realPowInteger"} : (real, int) -> real - -overload operator ^ = {xor_vec, int_power, real_power, concat_str} - -val add_atom = {ocaml: "add_int", lem: "integerAdd", c: "add_int", coq: "Z.add"} : forall 'n 'm. - (int('n), int('m)) -> int('n + 'm) - -val add_vec = {c: "add_bits", _: "add_vec"} : forall 'n. (bits('n), bits('n)) -> bits('n) - -val add_vec_int = {c: "add_bits_int", _: "add_vec_int"} : forall 'n. (bits('n), int) -> bits('n) - -val add_real = {ocaml: "add_real", lem: "realAdd"} : (real, real) -> real - -overload operator + = {add_atom, add_vec, add_vec_int, add_real} - -val sub_atom = {ocaml: "sub_int", c: "sub_int", lem: "integerMinus", coq: "sub_range"} : forall 'n 'm. - (int('n), int('m)) -> int('n - 'm) - -val sub_int = {ocaml: "sub_int", c: "sub_int", lem: "integerMinus", coq: "Z.sub"} : (int, int) -> int -val sub_nat = {ocaml: "(fun (x,y) -> let n = sub_int (x,y) in if Big_int.less_equal n Big_int.zero then Big_int.zero else n)", - lem: "integerMinus", coq: "sub_nat", c: "sub_nat"} - : (nat, nat) -> nat - -val sub_vec = {c: "sub_bits", _: "sub_vec"} : forall 'n. (bits('n), bits('n)) -> bits('n) - -val sub_vec_int = {c: "sub_bits_int", _: "sub_vec_int"} : forall 'n. (bits('n), int) -> bits('n) - -val sub_real = {ocaml: "sub_real", lem: "realMinus"} : (real, real) -> real - -val negate_atom = {ocaml: "negate", lem: "integerNegate", coq: "negate_range"} : forall 'n 'm. atom('n) -> atom(- 'n) - -val negate_int = {ocaml: "negate", lem: "integerNegate", coq: "Z.opp"} : int -> int - -val negate_real = {ocaml: "Num.minus_num", lem: "realNegate"} : real -> real - -overload operator - = {sub_atom, sub_int, sub_vec, sub_vec_int, sub_real} - -overload negate = {negate_range, negate_int, negate_real} - -val mult_atom = {ocaml: "mult", lem: "integerMult", c: "mult_int", coq: "Z.mul"} : forall 'n 'm. - (atom('n), atom('m)) -> atom('n * 'm) - -val mult_int = {ocaml: "mult", lem: "integerMult", coq: "Z.mul"} : (int, int) -> int - -val mult_real = {ocaml: "mult_real", lem: "realMult"} : (real, real) -> real - -overload operator * = {mult_atom, mult_int, mult_real} - -val Sqrt = {ocaml: "sqrt_real", lem: "realSqrt"} : real -> real - -val gteq_real = {ocaml: "gteq_real", lem: "gteq"} : (real, real) -> bool - -overload operator >= = {gteq_real} - -val lteq_real = {ocaml: "lteq_real", lem: "lteq"} : (real, real) -> bool - -overload operator <= = {lteq_real} - -val gt_real = {ocaml: "gt_real", lem: "gt"} : (real, real) -> bool - -overload operator > = {gt_real} - -val lt_real = {ocaml: "lt_real", lem: "lt"} : (real, real) -> bool - -overload operator < = {lt_real} - -val RoundDown = {ocaml: "round_down", lem: "realFloor"} : real -> int - -val RoundUp = {ocaml: "round_up", lem: "realCeiling"} : real -> int - -val abs_int = {ocaml: "abs_int", lem: "abs", coq: "Z.abs"} : int -> int - -val abs_real = {ocaml: "abs_real", lem: "abs"} : real -> real - -overload abs = {abs_int, abs_real} - -val quotient_nat = {ocaml: "quotient", lem: "integerDiv"} : (nat, nat) -> nat - -val quotient_real = {ocaml: "quotient_real", lem: "realDiv"} : (real, real) -> real - -val quotient = {ocaml: "quotient", lem: "integerDiv"} : (int, int) -> int - -overload operator / = {quotient_nat, quotient, quotient_real} - -val quot_round_zero = {ocaml: "quot_round_zero", lem: "hardware_quot", c: "tdiv_int"} : (int, int) -> int -val rem_round_zero = {ocaml: "rem_round_zero", lem: "hardware_mod", c: "tmod_int"} : (int, int) -> int - -val modulus = {ocaml: "modulus", lem: "hardware_mod", c: "tmod_int"} : (int, int) -> int - -overload operator % = {modulus} - -val Real = {ocaml: "Num.num_of_big_int", lem: "realFromInteger"} : int -> real - -val shl_int = "shl_int" : (int, int) -> int -val shr_int = "shr_int" : (int, int) -> int -val lor_int = "lor_int" : (int, int) -> int -val land_int = "land_int" : (int, int) -> int -val lxor_int = "lxor_int" : (int, int) -> int - -val min_nat = {ocaml: "min_int", lem: "min", c: "min_int"} : (nat, nat) -> nat - -val min_int = {ocaml: "min_int", lem: "min", coq: "Z.min", c: "min_int"} : (int, int) -> int - -val max_nat = {ocaml: "max_int", lem: "max", c: "max_int"} : (nat, nat) -> nat - -val max_int = {ocaml: "max_int", lem: "max", coq: "Z.max", c: "max_int"} : (int, int) -> int - -overload min = {min_nat, min_int} - -overload max = {max_nat, max_int} - -val __WriteRAM = "write_ram" : forall 'n 'm. - (atom('m), atom('n), bits('m), bits('m), bits(8 * 'n)) -> bool effect {wmv} - -val __RISCV_write : forall 'n. (bits(64), atom('n), bits(8 * 'n)) -> bool effect {wmv} -function __RISCV_write (addr, width, data) = { - __WriteRAM(64, width, 0x0000_0000_0000_0000, addr, data) -} - -val __TraceMemoryWrite : forall 'n 'm. - (atom('n), bits('m), bits(8 * 'n)) -> unit - -val __ReadRAM = { lem: "MEMr", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __ReadRAM_acquire = { lem: "MEMr_acquire", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __ReadRAM_strong_acquire = { lem: "MEMr_strong_acquire", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __ReadRAM_reserved = { lem: "MEMr_reserved", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __ReadRAM_reserved_acquire = { lem: "MEMr_reserved_acquire", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __ReadRAM_reserved_strong_acquire = { lem: "MEMr_reserved_strong_acquire", _ : "read_ram" } : forall 'n 'm, 'n >= 0. - (atom('m), atom('n), bits('m), bits('m)) -> bits(8 * 'n) effect {rmem} - -val __RISCV_read : forall 'n, 'n >= 0. (bits(64), atom('n), bool, bool, bool) -> option(bits(8 * 'n)) effect {rmem} -function __RISCV_read (addr, width, aq, rl, res) = - match (aq, rl, res) { - (false, false, false) => Some(__ReadRAM(64, width, 0x0000_0000_0000_0000, addr)), - (true, false, false) => Some(__ReadRAM_acquire(64, width, 0x0000_0000_0000_0000, addr)), - (true, true, false) => Some(__ReadRAM_strong_acquire(64, width, 0x0000_0000_0000_0000, addr)), - (false, false, true) => Some(__ReadRAM_reserved(64, width, 0x0000_0000_0000_0000, addr)), - (true, false, true) => Some(__ReadRAM_reserved_acquire(64, width, 0x0000_0000_0000_0000, addr)), - (true, true, true) => Some(__ReadRAM_reserved_strong_acquire(64, width, 0x0000_0000_0000_0000, addr)), - (false, true, false) => None(), - (false, true, true) => None() - } - -val __TraceMemoryRead : forall 'n 'm. (atom('n), bits('m), bits(8 * 'n)) -> unit - -val replicate_bits = "replicate_bits" : forall 'n 'm, 'm >= 0. (bits('n), atom('m)) -> bits('n * 'm) - -val cast ex_nat : nat -> {'n, 'n >= 0. atom('n)} - -function ex_nat 'n = n - -val cast ex_int : int -> {'n, true. atom('n)} - -function ex_int 'n = n - -/* -val cast ex_range : forall 'n 'm. range('n, 'm) -> {'o, 'n <= 'o <= 'm. atom('o)} - -function ex_range (n as 'N) = n -*/ - -val coerce_int_nat : int -> nat effect {escape} - -function coerce_int_nat 'x = { - assert(constraint('x >= 0)); - x -} - -val slice = "slice" : forall ('n : Int) ('m : Int), 'm >= 0 & 'n >= 0. - (bits('m), int, atom('n)) -> bits('n) - -val pow2 = "pow2" : forall 'n. atom('n) -> atom(2 ^ 'n) - -val print = "print_endline" : string -> unit -val print_int = "print_int" : (string, int) -> unit -val print_bits = "print_bits" : forall 'n. (string, bits('n)) -> unit -val print_string = "print_string" : (string, string) -> unit - -val print_instr = {ocaml: "Platform.print_instr", c: "print_instr", _: "print_endline"} : string -> unit -val print_reg = {ocaml: "Platform.print_reg", c: "print_reg", _: "print_endline"} : string -> unit -val print_mem = {ocaml: "Platform.print_mem_access", c: "print_mem_access", _: "print_endline"} : string -> unit -val print_platform = {ocaml: "Platform.print_platform", c: "print_platform", _: "print_endline"} : string -> unit - -val "sign_extend" : forall 'n 'm, 'm >= 'n. (bits('n), atom('m)) -> bits('m) -val "zero_extend" : forall 'n 'm, 'm >= 'n. (bits('n), atom('m)) -> bits('m) - -val EXTS : forall 'n 'm , 'm >= 'n . bits('n) -> bits('m) -val EXTZ : forall 'n 'm , 'm >= 'n . bits('n) -> bits('m) - -function EXTS v = sign_extend(v, sizeof('m)) -function EXTZ v = zero_extend(v, sizeof('m)) - -infix 4 <_s -infix 4 >=_s -infix 4 <_u -infix 4 >=_u -infix 4 <=_u - -val operator <_s : forall 'n, 'n > 0. (bits('n), bits('n)) -> bool -val operator >=_s : forall 'n, 'n > 0. (bits('n), bits('n)) -> bool -val operator <_u : forall 'n. (bits('n), bits('n)) -> bool -val operator >=_u : forall 'n. (bits('n), bits('n)) -> bool -val operator <=_u : forall 'n. (bits('n), bits('n)) -> bool - -function operator <_s (x, y) = signed(x) < signed(y) -function operator >=_s (x, y) = signed(x) >= signed(y) -function operator <_u (x, y) = unsigned(x) < unsigned(y) -function operator >=_u (x, y) = unsigned(x) >= unsigned(y) -function operator <=_u (x, y) = unsigned(x) <= unsigned(y) - -val cast bool_to_bits : bool -> bits(1) -function bool_to_bits x = if x then 0b1 else 0b0 - -val cast bit_to_bool : bit -> bool -function bit_to_bool b = match b { - bitone => true, - bitzero => false -} - -infix 7 >> -infix 7 << - -val operator >> = "shift_bits_right" : forall 'n 'm. (bits('n), bits('m)) -> bits('n) -val operator << = "shift_bits_left" : forall 'n 'm. (bits('n), bits('m)) -> bits('n) - -val vector64 : int -> bits(64) - -function vector64 n = __raw_GetSlice_int(64, n, 0) - -val to_bits : forall 'l, 'l >= 0.(atom('l), int) -> bits('l) -function to_bits (l, n) = __raw_GetSlice_int(l, n, 0) - -val vector_update_subrange_dec = {ocaml: "update_subrange", c: "vector_update_subrange", lem: "update_subrange_vec_dec", coq: "update_subrange_vec_dec"} : forall 'n 'm 'o. - (bits('n), atom('m), atom('o), bits('m - ('o - 1))) -> bits('n) - -val vector_update_subrange_inc = {ocaml: "update_subrange", lem: "update_subrange_vec_inc"} : forall 'n 'm 'o. - (vector('n, inc, bit), atom('m), atom('o), vector('o - ('m - 1), inc, bit)) -> vector('n, inc, bit) - -overload vector_update_subrange = {vector_update_subrange_dec, vector_update_subrange_inc} - -/* Ideally these would be sail builtin */ - -function shift_right_arith64 (v : bits(64), shift : bits(6)) -> bits(64) = - let v128 : bits(128) = EXTS(v) in - (v128 >> shift)[63..0] - -function shift_right_arith32 (v : bits(32), shift : bits(5)) -> bits(32) = - let v64 : bits(64) = EXTS(v) in - (v64 >> shift)[31..0] - -/* Special version of zero_extend that the Lem back-end knows will be at a - case split on 'm and uses a more generic type for. (Temporary hack, honest) */ -val zero_extend_type_hack = "zero_extend" : forall 'n 'm, 'm >= 'n. (bits('n), atom('m)) -> bits('m) - - -val n_leading_spaces : string -> {'n, 'n >= 0. int('n)} -function n_leading_spaces s = - match s { - "" => 0, - _ => match string_take(s, 1) { - " " => 1 + n_leading_spaces(string_drop(s, 1)), - _ => 0 - } - } - -val spc_forwards : unit -> string -function spc_forwards () = " " -val spc_backwards : string -> unit -function spc_backwards s = () -val spc_matches_prefix : string -> option((unit, nat)) -function spc_matches_prefix s = { - let n = n_leading_spaces(s); - match n { - 0 => None(), - _ => Some((), n) - } -} - -val opt_spc_forwards : unit -> string -function opt_spc_forwards () = "" -val opt_spc_backwards : string -> unit -function opt_spc_backwards s = () -val opt_spc_matches_prefix : string -> option((unit, nat)) -function opt_spc_matches_prefix s = - Some((), n_leading_spaces(s)) - -val def_spc_forwards : unit -> string -function def_spc_forwards () = " " -val def_spc_backwards : string -> unit -function def_spc_backwards s = () -val def_spc_matches_prefix : string -> option((unit, nat)) -function def_spc_matches_prefix s = opt_spc_matches_prefix(s) diff --git a/riscv/reset_vec.S b/riscv/reset_vec.S deleted file mode 100644 index 526bbc79..00000000 --- a/riscv/reset_vec.S +++ /dev/null @@ -1,12 +0,0 @@ -.global _start - -.text - -_start: - auipc t0, 0x0 - addi a1, t0, 32 - csrr a0, mhartid - ld t0, 24(t0) - jr t0 -.short 0x0000 -.word 0x00000000, 0x80000000 diff --git a/riscv/reset_vec.bin b/riscv/reset_vec.bin Binary files differdeleted file mode 100755 index d2d3563c..00000000 --- a/riscv/reset_vec.bin +++ /dev/null diff --git a/riscv/riscv.sail b/riscv/riscv.sail deleted file mode 100644 index 37553299..00000000 --- a/riscv/riscv.sail +++ /dev/null @@ -1,1569 +0,0 @@ -/* ****************************************************************** */ -union clause ast = UTYPE : (bits(20), regbits, uop) - -mapping encdec_uop : uop <-> bits(7) = { - RISCV_LUI <-> 0b0110111, - RISCV_AUIPC <-> 0b0010111 -} - -mapping clause encdec = UTYPE(imm, rd, op) <-> imm @ rd @ encdec_uop(op) - -function clause execute UTYPE(imm, rd, op) = { - let off : xlenbits = EXTS(imm @ 0x000); - let ret : xlenbits = match op { - RISCV_LUI => off, - RISCV_AUIPC => PC + off - }; - X(rd) = ret; - true -} - -mapping utype_mnemonic : uop <-> string = { - RISCV_LUI <-> "lui", - RISCV_AUIPC <-> "auipc" -} - -mapping clause assembly = UTYPE(imm, rd, op) - <-> utype_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_20(imm) - -/* ****************************************************************** */ -union clause ast = RISCV_JAL : (bits(21), regbits) - -mapping clause encdec = RISCV_JAL(imm_19 @ imm_7_0 @ imm_8 @ imm_18_13 @ imm_12_9 @ 0b0, rd) - <-> imm_19 : bits(1) @ imm_18_13 : bits(6) @ imm_12_9 : bits(4) @ imm_8 : bits(1) @ imm_7_0 : bits(8) @ rd @ 0b1101111 - -/* -ideally we want some syntax like - -mapping clause encdec = RISCV_JAL(imm @ 0b0, rd) <-> imm[19] @ imm[9..0] @ imm[10] @ imm[18..11] @ rd @ 0b1101111 - -match bv { - imm[19] @ imm[9..0] @ imm[10] @ imm[18..11] -> imm @ 0b0 -} - -but this is difficult -*/ - -function clause execute (RISCV_JAL(imm, rd)) = { - let pc : xlenbits = PC; - let newPC : xlenbits = pc + EXTS(imm); - if newPC[1] & (~ (haveRVC())) then { - handle_mem_exception(newPC, E_Fetch_Addr_Align); - false - } else { - X(rd) = nextPC; /* compatible with JAL and C.JAL */ - nextPC = newPC; - true - } -} -/* TODO: handle 2-byte-alignment in mappings */ - -mapping clause assembly = RISCV_JAL(imm, rd) <-> "jal" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_21(imm) - -/* ****************************************************************** */ -union clause ast = RISCV_JALR : (bits(12), regbits, regbits) - -mapping clause encdec = RISCV_JALR(imm, rs1, rd) <-> imm @ rs1 @ 0b000 @ rd @ 0b1100111 - -mapping clause assembly = RISCV_JALR(imm, rs1, rd) - <-> "jalr" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_12(imm) - -/* see riscv_jalr_seq.sail or riscv_jalr_rmem.sail for the execute clause. */ - -/* ****************************************************************** */ -union clause ast = BTYPE : (bits(13), regbits, regbits, bop) - -mapping encdec_bop : bop <-> bits(3) = { - RISCV_BEQ <-> 0b000, - RISCV_BNE <-> 0b001, - RISCV_BLT <-> 0b100, - RISCV_BGE <-> 0b101, - RISCV_BLTU <-> 0b110, - RISCV_BGEU <-> 0b111 -} - -mapping clause encdec = BTYPE(imm7_6 @ imm5_0 @ imm7_5_0 @ imm5_4_1 @ 0b0, rs2, rs1, op) - <-> imm7_6 : bits(1) @ imm7_5_0 : bits(6) @ rs2 @ rs1 @ encdec_bop(op) @ imm5_4_1 : bits(4) @ imm5_0 : bits(1) @ 0b1100011 - -function clause execute (BTYPE(imm, rs2, rs1, op)) = { - let rs1_val = X(rs1); - let rs2_val = X(rs2); - let taken : bool = match op { - RISCV_BEQ => rs1_val == rs2_val, - RISCV_BNE => rs1_val != rs2_val, - RISCV_BLT => rs1_val <_s rs2_val, - RISCV_BGE => rs1_val >=_s rs2_val, - RISCV_BLTU => rs1_val <_u rs2_val, - RISCV_BGEU => rs1_val >=_u rs2_val - }; - let newPC = PC + EXTS(imm); - if taken then { - if newPC[1] & (~ (haveRVC())) then { - handle_mem_exception(newPC, E_Fetch_Addr_Align); - false; - } else { - nextPC = newPC; - true - } - } else true -} - -mapping btype_mnemonic : bop <-> string = { - RISCV_BEQ <-> "beq", - RISCV_BNE <-> "bne", - RISCV_BLT <-> "blt", - RISCV_BGE <-> "bge", - RISCV_BLTU <-> "bltu", - RISCV_BGEU <-> "bgeu" -} - -mapping clause assembly = BTYPE(imm, rs2, rs1, op) - <-> btype_mnemonic(op) ^ spc() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) ^ sep() ^ hex_bits_13(imm) - -/* ****************************************************************** */ -union clause ast = ITYPE : (bits(12), regbits, regbits, iop) - -mapping encdec_iop : iop <-> bits(3) = { - RISCV_ADDI <-> 0b000, - RISCV_SLTI <-> 0b010, - RISCV_SLTIU <-> 0b011, - RISCV_XORI <-> 0b100, - RISCV_ORI <-> 0b110, - RISCV_ANDI <-> 0b111 -} - -mapping clause encdec = ITYPE(imm, rs1, rd, op) <-> imm @ rs1 @ encdec_iop(op) @ rd @ 0b0010011 - -function clause execute (ITYPE (imm, rs1, rd, op)) = { - let rs1_val = X(rs1); - let immext : xlenbits = EXTS(imm); - let result : xlenbits = match op { - RISCV_ADDI => rs1_val + immext, - RISCV_SLTI => EXTZ(rs1_val <_s immext), - RISCV_SLTIU => EXTZ(rs1_val <_u immext), - RISCV_XORI => rs1_val ^ immext, - RISCV_ORI => rs1_val | immext, - RISCV_ANDI => rs1_val & immext - }; - X(rd) = result; - true -} - -mapping itype_mnemonic : iop <-> string = { - RISCV_ADDI <-> "addi", - RISCV_SLTI <-> "slti", - RISCV_SLTIU <-> "sltiu", - RISCV_XORI <-> "xori", - RISCV_ORI <-> "ori", - RISCV_ANDI <-> "andi" -} - -mapping clause assembly = ITYPE(imm, rs1, rd, op) - <-> itype_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_12(imm) - -/* ****************************************************************** */ -union clause ast = SHIFTIOP : (bits(6), regbits, regbits, sop) - -mapping encdec_sop : sop <-> bits(3) = { - RISCV_SLLI <-> 0b001, - RISCV_SRLI <-> 0b101, - RISCV_SRAI <-> 0b101 -} - -mapping clause encdec = SHIFTIOP(shamt, rs1, rd, RISCV_SLLI) <-> 0b000000 @ shamt @ rs1 @ 0b001 @ rd @ 0b0010011 -mapping clause encdec = SHIFTIOP(shamt, rs1, rd, RISCV_SRLI) <-> 0b000000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0010011 -mapping clause encdec = SHIFTIOP(shamt, rs1, rd, RISCV_SRAI) <-> 0b010000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0010011 - -function clause execute (SHIFTIOP(shamt, rs1, rd, op)) = { - let rs1_val = X(rs1); - let result : xlenbits = match op { - RISCV_SLLI => rs1_val << shamt, - RISCV_SRLI => rs1_val >> shamt, - RISCV_SRAI => shift_right_arith64(rs1_val, shamt) - }; - X(rd) = result; - true -} - -mapping shiftiop_mnemonic : sop <-> string = { - RISCV_SLLI <-> "slli", - RISCV_SRLI <-> "srli", - RISCV_SRAI <-> "srai" -} - -mapping clause assembly = SHIFTIOP(shamt, rs1, rd, op) - <-> shiftiop_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ hex_bits_6(shamt) - -/* ****************************************************************** */ -union clause ast = RTYPE : (regbits, regbits, regbits, rop) - -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_ADD) <-> 0b0000000 @ rs2 @ rs1 @ 0b000 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SUB) <-> 0b0100000 @ rs2 @ rs1 @ 0b000 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SLL) <-> 0b0000000 @ rs2 @ rs1 @ 0b001 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SLT) <-> 0b0000000 @ rs2 @ rs1 @ 0b010 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SLTU) <-> 0b0000000 @ rs2 @ rs1 @ 0b011 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_XOR) <-> 0b0000000 @ rs2 @ rs1 @ 0b100 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SRL) <-> 0b0000000 @ rs2 @ rs1 @ 0b101 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_SRA) <-> 0b0100000 @ rs2 @ rs1 @ 0b101 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_OR) <-> 0b0000000 @ rs2 @ rs1 @ 0b110 @ rd @ 0b0110011 -mapping clause encdec = RTYPE(rs2, rs1, rd, RISCV_AND) <-> 0b0000000 @ rs2 @ rs1 @ 0b111 @ rd @ 0b0110011 - -function clause execute (RTYPE(rs2, rs1, rd, op)) = { - let rs1_val = X(rs1); - let rs2_val = X(rs2); - let result : xlenbits = match op { - RISCV_ADD => rs1_val + rs2_val, - RISCV_SUB => rs1_val - rs2_val, - RISCV_SLL => rs1_val << (rs2_val[5..0]), - RISCV_SLT => EXTZ(rs1_val <_s rs2_val), - RISCV_SLTU => EXTZ(rs1_val <_u rs2_val), - RISCV_XOR => rs1_val ^ rs2_val, - RISCV_SRL => rs1_val >> (rs2_val[5..0]), - RISCV_SRA => shift_right_arith64(rs1_val, rs2_val[5..0]), - RISCV_OR => rs1_val | rs2_val, - RISCV_AND => rs1_val & rs2_val - }; - X(rd) = result; - true -} - -mapping rtype_mnemonic : rop <-> string = { - RISCV_ADD <-> "add", - RISCV_SUB <-> "sub", - RISCV_SLL <-> "sll", - RISCV_SLT <-> "slt", - RISCV_SLTU <-> "sltu", - RISCV_XOR <-> "xor", - RISCV_SRL <-> "srl", - RISCV_SRA <-> "sra", - RISCV_OR <-> "or", - RISCV_AND <-> "and" -} - -mapping clause assembly = RTYPE(rs2, rs1, rd, op) - <-> rtype_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = LOAD : (bits(12), regbits, regbits, bool, word_width, bool, bool) - -/* Load unsigned double is only present in RV128I, not RV64I */ -/* TODO: aq/rl */ -mapping clause encdec = LOAD(imm, rs1, rd, is_unsigned, size, false, false) if size_bits(size) != 0b11 | not_bool(is_unsigned) - <-> imm @ rs1 @ bool_bits(is_unsigned) @ size_bits(size) @ rd @ 0b0000011 if size_bits(size) != 0b11 | not_bool(is_unsigned) - -val extend_value : forall 'n, 0 < 'n <= 8. (bool, MemoryOpResult(bits(8 * 'n))) -> MemoryOpResult(xlenbits) -function extend_value(is_unsigned, value) = match (value) { - MemValue(v) => MemValue(if is_unsigned then EXTZ(v) else EXTS(v) : xlenbits), - MemException(e) => MemException(e) -} - -val process_load : forall 'n, 0 < 'n <= 8. (regbits, xlenbits, MemoryOpResult(bits(8 * 'n)), bool) -> bool effect {escape, rreg, wreg} -function process_load(rd, addr, value, is_unsigned) = - match extend_value(is_unsigned, value) { - MemValue(result) => { X(rd) = result; true }, - MemException(e) => { handle_mem_exception(addr, e); false } - } - -function check_misaligned(vaddr : xlenbits, width : word_width) -> bool = - if plat_enable_misaligned_access() then false - else match width { - BYTE => false, - HALF => vaddr[0] == true, - WORD => vaddr[0] == true | vaddr[1] == true, - DOUBLE => vaddr[0] == true | vaddr[1] == true | vaddr[2] == true - } - -function clause execute(LOAD(imm, rs1, rd, is_unsigned, width, aq, rl)) = - let vaddr : xlenbits = X(rs1) + EXTS(imm) in - if check_misaligned(vaddr, width) - then { handle_mem_exception(vaddr, E_Load_Addr_Align); false } - else match translateAddr(vaddr, Read, Data) { - TR_Failure(e) => { handle_mem_exception(vaddr, e); false }, - TR_Address(addr) => - match width { - BYTE => process_load(rd, vaddr, mem_read(addr, 1, aq, rl, false), is_unsigned), - HALF => process_load(rd, vaddr, mem_read(addr, 2, aq, rl, false), is_unsigned), - WORD => process_load(rd, vaddr, mem_read(addr, 4, aq, rl, false), is_unsigned), - DOUBLE => process_load(rd, vaddr, mem_read(addr, 8, aq, rl, false), is_unsigned) - } - } - -/* TODO FIXME: is this the actual aq/rl syntax? */ -val maybe_aq : bool <-> string -mapping maybe_aq = { - true <-> ".aq", - false <-> "" -} - -val maybe_rl : bool <-> string -mapping maybe_rl = { - true <-> ".rl", - false <-> "" -} - -val maybe_u : bool <-> string -mapping maybe_u = { - true <-> "u", - false <-> "" -} - - -mapping clause assembly = LOAD(imm, rs1, rd, is_unsigned, size, aq, rl) - <-> "l" ^ size_mnemonic(size) ^ maybe_u(is_unsigned) ^ maybe_aq(aq) ^ maybe_rl(rl) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_12(imm) - -/* ****************************************************************** */ -union clause ast = STORE : (bits(12), regbits, regbits, word_width, bool, bool) - -/* TODO: aq/rl */ -mapping clause encdec = STORE(imm7 @ imm5, rs2, rs1, size, false, false) - <-> imm7 : bits(7) @ rs2 @ rs1 @ 0b0 @ size_bits(size) @ imm5 : bits(5) @ 0b0100011 - -/* NOTE: Currently, we only EA if address translation is successful. - This may need revisiting. */ -function clause execute (STORE(imm, rs2, rs1, width, aq, rl)) = - let vaddr : xlenbits = X(rs1) + EXTS(imm) in - if check_misaligned(vaddr, width) - then { handle_mem_exception(vaddr, E_SAMO_Addr_Align); false } - else match translateAddr(vaddr, Write, Data) { - TR_Failure(e) => { handle_mem_exception(vaddr, e); false }, - TR_Address(addr) => { - let eares : MemoryOpResult(unit) = match width { - BYTE => mem_write_ea(addr, 1, aq, rl, false), - HALF => mem_write_ea(addr, 2, aq, rl, false), - WORD => mem_write_ea(addr, 4, aq, rl, false), - DOUBLE => mem_write_ea(addr, 8, aq, rl, false) - }; - match (eares) { - MemException(e) => { handle_mem_exception(addr, e); false }, - MemValue(_) => { - let rs2_val = X(rs2); - let res : MemoryOpResult(bool) = match width { - BYTE => mem_write_value(addr, 1, rs2_val[7..0], aq, rl, false), - HALF => mem_write_value(addr, 2, rs2_val[15..0], aq, rl, false), - WORD => mem_write_value(addr, 4, rs2_val[31..0], aq, rl, false), - DOUBLE => mem_write_value(addr, 8, rs2_val, aq, rl, false) - }; - match (res) { - MemValue(true) => true, - MemValue(false) => internal_error("store got false from mem_write_value"), - MemException(e) => { handle_mem_exception(addr, e); false } - } - } - } - } - } - -mapping clause assembly = STORE(imm, rs1, rd, size, aq, rl) - <-> "s" ^ size_mnemonic(size) ^ maybe_aq(aq) ^ maybe_rl(rl) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_12(imm) - - -/* ****************************************************************** */ -union clause ast = ADDIW : (bits(12), regbits, regbits) - -mapping clause encdec = ADDIW(imm, rs1, rd) <-> imm @ rs1 @ 0b000 @ rd @ 0b0011011 - -function clause execute (ADDIW(imm, rs1, rd)) = { - let result : xlenbits = EXTS(imm) + X(rs1); - X(rd) = EXTS(result[31..0]); - true -} - - -mapping clause assembly = ADDIW(imm, rs1, rd) <-> "addiw" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_12(imm) - -/* ****************************************************************** */ -union clause ast = SHIFTW : (bits(5), regbits, regbits, sop) - -mapping clause encdec = SHIFTW(shamt, rs1, rd, RISCV_SLLI) <-> 0b0000000 @ shamt @ rs1 @ 0b001 @ rd @ 0b0011011 -mapping clause encdec = SHIFTW(shamt, rs1, rd, RISCV_SRLI) <-> 0b0000000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0011011 -mapping clause encdec = SHIFTW(shamt, rs1, rd, RISCV_SRAI) <-> 0b0100000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0011011 - -function clause execute (SHIFTW(shamt, rs1, rd, op)) = { - let rs1_val = (X(rs1))[31..0]; - let result : bits(32) = match op { - RISCV_SLLI => rs1_val << shamt, - RISCV_SRLI => rs1_val >> shamt, - RISCV_SRAI => shift_right_arith32(rs1_val, shamt) - }; - X(rd) = EXTS(result); - true -} - -mapping shiftw_mnemonic : sop <-> string = { - RISCV_SLLI <-> "slli", - RISCV_SRLI <-> "srli", - RISCV_SRAI <-> "srai" -} - -mapping clause assembly = SHIFTW(shamt, rs1, rd, op) - <-> shiftw_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ hex_bits_5(shamt) - -/* ****************************************************************** */ -union clause ast = RTYPEW : (regbits, regbits, regbits, ropw) - -mapping clause encdec = RTYPEW(rs2, rs1, rd, RISCV_ADDW) <-> 0b0000000 @ rs2 @ rs1 @ 0b000 @ rd @ 0b0111011 -mapping clause encdec = RTYPEW(rs2, rs1, rd, RISCV_SUBW) <-> 0b0100000 @ rs2 @ rs1 @ 0b000 @ rd @ 0b0111011 -mapping clause encdec = RTYPEW(rs2, rs1, rd, RISCV_SLLW) <-> 0b0000000 @ rs2 @ rs1 @ 0b001 @ rd @ 0b0111011 -mapping clause encdec = RTYPEW(rs2, rs1, rd, RISCV_SRLW) <-> 0b0000000 @ rs2 @ rs1 @ 0b101 @ rd @ 0b0111011 -mapping clause encdec = RTYPEW(rs2, rs1, rd, RISCV_SRAW) <-> 0b0100000 @ rs2 @ rs1 @ 0b101 @ rd @ 0b0111011 - -function clause execute (RTYPEW(rs2, rs1, rd, op)) = { - let rs1_val = (X(rs1))[31..0]; - let rs2_val = (X(rs2))[31..0]; - let result : bits(32) = match op { - RISCV_ADDW => rs1_val + rs2_val, - RISCV_SUBW => rs1_val - rs2_val, - RISCV_SLLW => rs1_val << (rs2_val[4..0]), - RISCV_SRLW => rs1_val >> (rs2_val[4..0]), - RISCV_SRAW => shift_right_arith32(rs1_val, rs2_val[4..0]) - }; - X(rd) = EXTS(result); - true -} - -mapping rtypew_mnemonic : ropw <-> string = { - RISCV_ADDW <-> "addw", - RISCV_SUBW <-> "subw", - RISCV_SLLW <-> "sllw", - RISCV_SRLW <-> "srlw", - RISCV_SRAW <-> "sraw" -} - -mapping clause assembly = RTYPEW(rs2, rs1, rd, op) - <-> rtypew_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = SHIFTIWOP : (bits(5), regbits, regbits, sopw) - -mapping clause encdec = SHIFTIWOP(shamt, rs1, rd, RISCV_SLLIW) <-> 0b0000000 @ shamt @ rs1 @ 0b001 @ rd @ 0b0011011 -mapping clause encdec = SHIFTIWOP(shamt, rs1, rd, RISCV_SRLIW) <-> 0b0000000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0011011 -mapping clause encdec = SHIFTIWOP(shamt, rs1, rd, RISCV_SRAIW) <-> 0b0100000 @ shamt @ rs1 @ 0b101 @ rd @ 0b0011011 - -function clause execute (SHIFTIWOP(shamt, rs1, rd, op)) = { - let rs1_val = X(rs1); - let result : xlenbits = match op { - RISCV_SLLIW => EXTS(rs1_val[31..0] << shamt), - RISCV_SRLIW => EXTS(rs1_val[31..0] >> shamt), - RISCV_SRAIW => EXTS(shift_right_arith32(rs1_val[31..0], shamt)) - }; - X(rd) = result; - true -} - -mapping shiftiwop_mnemonic : sopw <-> string = { - RISCV_SLLIW <-> "slliw", - RISCV_SRLIW <-> "srliw", - RISCV_SRAIW <-> "sraiw" -} - -mapping clause assembly = SHIFTIWOP(shamt, rs1, rd, op) - <-> shiftiwop_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ hex_bits_5(shamt) - -/* ****************************************************************** */ -/* FIXME: separate these out into separate ast variants */ -union clause ast = MUL : (regbits, regbits, regbits, bool, bool, bool) - -mapping encdec_mul_op : (bool, bool, bool) <-> bits(3) = { - (false, true, true) <-> 0b000, - (true, true, true) <-> 0b001, - (true, true, false) <-> 0b010, - (true, false, false) <-> 0b011 -} - -/* for some reason the : bits(3) here is still necessary - BUG */ -mapping clause encdec = MUL(rs2, rs1, rd, high, signed1, signed2) - <-> 0b0000001 @ rs2 @ rs1 @ encdec_mul_op(high, signed1, signed2) : bits(3) @ rd @ 0b0110011 - -function clause execute (MUL(rs2, rs1, rd, high, signed1, signed2)) = { - let rs1_val = X(rs1); - let rs2_val = X(rs2); - let rs1_int : int = if signed1 then signed(rs1_val) else unsigned(rs1_val); - let rs2_int : int = if signed2 then signed(rs2_val) else unsigned(rs2_val); - let result128 = to_bits(128, rs1_int * rs2_int); - let result = if high then result128[127..64] else result128[63..0]; - X(rd) = result; - true -} - -mapping mul_mnemonic : (bool, bool, bool) <-> string = { - (false, true, true) <-> "mul", - (true, true, true) <-> "mulh", - (true, true, false) <-> "mulhsu", - (true, false, false) <-> "mulhu" -} - -mapping clause assembly = MUL(rs2, rs1, rd, high, signed1, signed2) <-> mul_mnemonic(high, signed1, signed2) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = DIV : (regbits, regbits, regbits, bool) - -mapping clause encdec = DIV(rs2, rs1, rd, s) <-> 0b0000001 @ rs2 @ rs1 @ 0b10 @ bool_not_bits(s) @ rd @ 0b0110011 - -function clause execute (DIV(rs2, rs1, rd, s)) = { - let rs1_val = X(rs1); - let rs2_val = X(rs2); - let rs1_int : int = if s then signed(rs1_val) else unsigned(rs1_val); - let rs2_int : int = if s then signed(rs2_val) else unsigned(rs2_val); - let q : int = if rs2_int == 0 then -1 else quot_round_zero(rs1_int, rs2_int); - let q': int = if s & q > xlen_max_signed then xlen_min_signed else q; /* check for signed overflow */ - X(rd) = to_bits(xlen, q'); - true -} - -mapping maybe_not_u : bool <-> string = { - false <-> "u", - true <-> "" -} - -mapping clause assembly = DIV(rs2, rs1, rd, s) - <-> "div" ^ maybe_not_u(s) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = REM : (regbits, regbits, regbits, bool) - -mapping clause encdec = REM(rs2, rs1, rd, s) <-> 0b0000001 @ rs2 @ rs1 @ 0b11 @ bool_not_bits(s) @ rd @ 0b0110011 - -function clause execute (REM(rs2, rs1, rd, s)) = { - let rs1_val = X(rs1); - let rs2_val = X(rs2); - let rs1_int : int = if s then signed(rs1_val) else unsigned(rs1_val); - let rs2_int : int = if s then signed(rs2_val) else unsigned(rs2_val); - let r : int = if rs2_int == 0 then rs1_int else rem_round_zero(rs1_int, rs2_int); - /* signed overflow case returns zero naturally as required due to -1 divisor */ - X(rd) = to_bits(xlen, r); - true -} - -mapping clause assembly = REM(rs2, rs1, rd, s) <-> "rem" ^ maybe_not_u(s) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = MULW : (regbits, regbits, regbits) - -mapping clause encdec = MULW(rs2, rs1, rd) <-> 0b0000001 @ rs2 @ rs1 @ 0b000 @ rd @ 0b0111011 - -function clause execute (MULW(rs2, rs1, rd)) = { - let rs1_val = X(rs1)[31..0]; - let rs2_val = X(rs2)[31..0]; - let rs1_int : int = signed(rs1_val); - let rs2_int : int = signed(rs2_val); - let result32 = to_bits(64, rs1_int * rs2_int)[31..0]; /* XXX surprising behaviour of to_bits requires expansion to 64 bits followed by truncation... */ - let result : xlenbits = EXTS(result32); - X(rd) = result; - true -} - -mapping clause assembly = MULW(rs2, rs1, rd) - <-> "mulw" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = DIVW : (regbits, regbits, regbits, bool) - -mapping clause encdec = DIVW(rs2, rs1, rd, s) <-> 0b0000001 @ rs2 @ rs1 @ 0b10 @ bool_not_bits(s) @ rd @ 0b0111011 - -function clause execute (DIVW(rs2, rs1, rd, s)) = { - let rs1_val = X(rs1)[31..0]; - let rs2_val = X(rs2)[31..0]; - let rs1_int : int = if s then signed(rs1_val) else unsigned(rs1_val); - let rs2_int : int = if s then signed(rs2_val) else unsigned(rs2_val); - let q : int = if rs2_int == 0 then -1 else quot_round_zero(rs1_int, rs2_int); - let q': int = if s & q > (2 ^ 31 - 1) then (0 - 2^31) else q; /* check for signed overflow */ - X(rd) = EXTS(to_bits(32, q')); - true -} - -mapping clause assembly = DIVW(rs2, rs1, rd, s) - <-> "div" ^ maybe_not_u(s) ^ "w" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = REMW : (regbits, regbits, regbits, bool) - -mapping clause encdec = REMW(rs2, rs1, rd, s) <-> 0b0000001 @ rs2 @ rs1 @ 0b11 @ bool_not_bits(s) @ rd @ 0b0111011 - -function clause execute (REMW(rs2, rs1, rd, s)) = { - let rs1_val = X(rs1)[31..0]; - let rs2_val = X(rs2)[31..0]; - let rs1_int : int = if s then signed(rs1_val) else unsigned(rs1_val); - let rs2_int : int = if s then signed(rs2_val) else unsigned(rs2_val); - let r : int = if rs2_int == 0 then rs1_int else rem_round_zero(rs1_int, rs2_int); - /* signed overflow case returns zero naturally as required due to -1 divisor */ - X(rd) = EXTS(to_bits(32, r)); - true -} - -mapping clause assembly = REMW(rs2, rs1, rd, s) <-> "rem" ^ maybe_not_u(s) ^ "w" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = FENCE : (bits(4), bits(4)) - -mapping clause encdec = FENCE(pred, succ) <-> 0b0000 @ pred @ succ @ 0b00000 @ 0b000 @ 0b00000 @ 0b0001111 - -function clause execute (FENCE(pred, succ)) = { - match (pred, succ) { - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b11) => MEM_fence_rw_rw(), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b11) => MEM_fence_r_rw(), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b10) => MEM_fence_r_r(), - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b01) => MEM_fence_rw_w(), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b01) => MEM_fence_w_w(), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b11) => MEM_fence_w_rw(), - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b10) => MEM_fence_rw_r(), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b01) => MEM_fence_r_w(), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b10) => MEM_fence_w_r(), - - (_ : bits(2) @ 0b00, _ : bits(2) @ 0b00) => (), - - _ => { print("FIXME: unsupported fence"); - () } - }; - true -} - -mapping bit_maybe_r : bits(1) <-> string = { - 0b1 <-> "r", - 0b0 <-> "" -} - -mapping bit_maybe_w : bits(1) <-> string = { - 0b1 <-> "w", - 0b0 <-> "" -} - -mapping bit_maybe_i : bits(1) <-> string = { - 0b1 <-> "i", - 0b0 <-> "" -} - -mapping bit_maybe_o : bits(1) <-> string = { - 0b1 <-> "o", - 0b0 <-> "" -} - -mapping fence_bits : bits(4) <-> string = { - i : bits(1) @ o : bits(1) @ r : bits(1) @ w : bits(1) <-> bit_maybe_i(i) ^ bit_maybe_o(o) ^ bit_maybe_r(r) ^ bit_maybe_w(w) -} - -mapping clause assembly = FENCE(pred, succ) <-> "fence" ^ spc() ^ fence_bits(pred) ^ sep() ^ fence_bits(succ) - -/* ****************************************************************** */ -union clause ast = FENCEI : unit - -mapping clause encdec = FENCEI() <-> 0b000000000000 @ 0b00000 @ 0b001 @ 0b00000 @ 0b0001111 - -/* fence.i is a nop for the memory model */ -function clause execute FENCEI() = { /* MEM_fence_i(); */ true } - - -mapping clause assembly = FENCEI() <-> "fence.i" - -/* ****************************************************************** */ -union clause ast = ECALL : unit - -mapping clause encdec = ECALL() <-> 0b000000000000 @ 0b00000 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute ECALL() = { - let t : sync_exception = - struct { trap = match (cur_privilege) { - User => E_U_EnvCall, - Supervisor => E_S_EnvCall, - Machine => E_M_EnvCall - }, - excinfo = (None() : option(xlenbits)) }; - nextPC = handle_exception(cur_privilege, CTL_TRAP(t), PC); - false -} - -mapping clause assembly = ECALL() <-> "ecall" - -/* ****************************************************************** */ -union clause ast = MRET : unit - -mapping clause encdec = MRET() <-> 0b0011000 @ 0b00010 @ 0b00000 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute MRET() = { - if cur_privilege == Machine - then nextPC = handle_exception(cur_privilege, CTL_MRET(), PC) - else handle_illegal(); - false -} - -mapping clause assembly = MRET() <-> "mret" - -/* ****************************************************************** */ -union clause ast = SRET : unit - -mapping clause encdec = SRET() <-> 0b0001000 @ 0b00010 @ 0b00000 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute SRET() = { - match cur_privilege { - User => handle_illegal(), - Supervisor => if mstatus.TSR() == true - then handle_illegal() - else nextPC = handle_exception(cur_privilege, CTL_SRET(), PC), - Machine => nextPC = handle_exception(cur_privilege, CTL_SRET(), PC) - }; - false -} - -mapping clause assembly = SRET() <-> "sret" - -/* ****************************************************************** */ -union clause ast = EBREAK : unit - -mapping clause encdec = EBREAK() <-> 0b000000000001 @ 0b00000 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute EBREAK() = { - handle_mem_exception(PC, E_Breakpoint); - false -} - -mapping clause assembly = EBREAK() <-> "ebreak" - -/* ****************************************************************** */ -union clause ast = WFI : unit - -mapping clause encdec = WFI() <-> 0b000100000101 @ 0b00000 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute WFI() = - match cur_privilege { - Machine => { platform_wfi(); true }, - Supervisor => if mstatus.TW() == true - then { handle_illegal(); false } - else { platform_wfi(); true }, - User => { handle_illegal(); false } - } - -mapping clause assembly = WFI() <-> "wfi" - -/* ****************************************************************** */ -union clause ast = SFENCE_VMA : (regbits, regbits) - -mapping clause encdec = SFENCE_VMA(rs1, rs2) <-> 0b0001001 @ rs2 @ rs1 @ 0b000 @ 0b00000 @ 0b1110011 - -function clause execute SFENCE_VMA(rs1, rs2) = { - /* TODO: handle PMP/TLB synchronization when executed in M-mode. */ - if cur_privilege == User - then { handle_illegal(); false } - else match (architecture(mstatus.SXL()), mstatus.TVM()) { - (Some(RV64), true) => { handle_illegal(); false }, - (Some(RV64), false) => { - let addr : option(vaddr39) = if rs1 == 0 then None() else Some(X(rs1)[38 .. 0]); - let asid : option(asid64) = if rs2 == 0 then None() else Some(X(rs2)[15 .. 0]); - flushTLB(asid, addr); - true - }, - (_, _) => internal_error("unimplemented sfence architecture") - } -} - -mapping clause assembly = SFENCE_VMA(rs1, rs2) - <-> "sfence.vma" ^ spc() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -// Some print utils for lr/sc. - -function aqrl_str(aq : bool, rl : bool) -> string = - match (aq, rl) { - (false, false) => "", - (false, true) => ".rl", - (true, false) => ".aq", - (true, true) => ".aqrl" - } - -function lrsc_width_str(width : word_width) -> string = - match (width) { - BYTE => ".b", - HALF => ".h", - WORD => ".w", - DOUBLE => ".d" - } - -/* ****************************************************************** */ -union clause ast = LOADRES : (bool, bool, regbits, word_width, regbits) - -mapping clause encdec = LOADRES(aq, rl, rs1, size, rd) <-> 0b00010 @ bool_bits(aq) @ bool_bits(rl) @ 0b00000 @ rs1 @ 0b0 @ size_bits(size) @ rd @ 0b0101111 - -/* We could set load-reservations on physical or virtual addresses. - * For now we set them on virtual addresses, since it makes the - * sequential model of SC a bit simpler, at the cost of an explicit - * call to load_reservation in LR and cancel_reservation in SC. - */ - -val process_loadres : forall 'n, 0 < 'n <= 8. (regbits, xlenbits, MemoryOpResult(bits(8 * 'n)), bool) -> bool effect {escape, rreg, wreg} -function process_loadres(rd, addr, value, is_unsigned) = - match extend_value(is_unsigned, value) { - MemValue(result) => { load_reservation(addr); X(rd) = result; true }, - MemException(e) => { handle_mem_exception(addr, e); false } - } - -function clause execute(LOADRES(aq, rl, rs1, width, rd)) = - let vaddr : xlenbits = X(rs1) in - let aligned : bool = - /* BYTE and HALF would only occur due to invalid decodes, but it doesn't hurt - * to treat them as valid here; otherwise we'd need to throw an internal_error. - * May need to revisit for latex output. - */ - match width { - BYTE => true, - HALF => vaddr[0] == 0b0, - WORD => vaddr[1..0] == 0b00, - DOUBLE => vaddr[2..0] == 0b000 - } in - /* "LR faults like a normal load, even though it's in the AMO major opcode space." - - Andrew Waterman, isa-dev, 10 Jul 2018. - */ - if (~ (aligned)) - then { handle_mem_exception(vaddr, E_Load_Addr_Align); false } - else match translateAddr(vaddr, Read, Data) { - TR_Failure(e) => { handle_mem_exception(vaddr, e); false }, - TR_Address(addr) => - match width { - WORD => process_loadres(rd, vaddr, mem_read(addr, 4, aq, rl, true), false), - DOUBLE => process_loadres(rd, vaddr, mem_read(addr, 8, aq, rl, true), false), - _ => internal_error("LOADRES expected WORD or DOUBLE") - } - } - -mapping clause assembly = LOADRES(aq, rl, rs1, size, rd) - <-> "lr." ^ size_mnemonic(size) ^ maybe_aq(aq) ^ maybe_rl(rl) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) - -/* ****************************************************************** */ -union clause ast = STORECON : (bool, bool, regbits, regbits, word_width, regbits) - -mapping clause encdec = STORECON(aq, rl, rs2, rs1, size, rd) - <-> 0b00011 @ bool_bits(aq) @ bool_bits(rl) @ rs2 @ rs1 @ 0b0 @ size_bits(size) @ rd @ 0b0101111 - -/* NOTE: Currently, we only EA if address translation is successful. - This may need revisiting. */ -function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { - /* RMEM FIXME: This definition differs from the Sail1 version: - * rs1 is read *before* speculate_conditional_success - * (called via match_reservation), partly due to the current api of - * match_reservation. Reverting back to the weaker Sail1 version - * will require changes to the API for the ghost reservation state. - */ - vaddr : xlenbits = X(rs1); - let aligned : bool = - /* BYTE and HALF would only occur due to invalid decodes, but it doesn't hurt - * to treat them as valid here; otherwise we'd need to throw an internal_error. - * May need to revisit for latex output. - */ - match width { - BYTE => true, - HALF => vaddr[0] == 0b0, - WORD => vaddr[1..0] == 0b00, - DOUBLE => vaddr[2..0] == 0b000 - } in - if (~ (aligned)) - then { handle_mem_exception(vaddr, E_SAMO_Addr_Align); false } - else { - if match_reservation(vaddr) == false - then { X(rd) = EXTZ(0b1); true } - else { - match translateAddr(vaddr, Write, Data) { - TR_Failure(e) => { handle_mem_exception(vaddr, e); false }, - TR_Address(addr) => { - let eares : MemoryOpResult(unit) = match width { - WORD => mem_write_ea(addr, 4, aq, rl, true), - DOUBLE => mem_write_ea(addr, 8, aq, rl, true), - _ => internal_error("STORECON expected word or double") - }; - match (eares) { - MemException(e) => { handle_mem_exception(addr, e); false }, - MemValue(_) => { - rs2_val = X(rs2); - let res : MemoryOpResult(bool) = match width { - WORD => mem_write_value(addr, 4, rs2_val[31..0], aq, rl, true), - DOUBLE => mem_write_value(addr, 8, rs2_val, aq, rl, true), - _ => internal_error("STORECON expected word or double") - }; - match (res) { - MemValue(true) => { X(rd) = EXTZ(0b0); cancel_reservation(); true }, - MemValue(false) => { X(rd) = EXTZ(0b1); cancel_reservation(); true }, - MemException(e) => { handle_mem_exception(addr, e); false } - } - } - } - } - } - } - } -} - -mapping clause assembly = STORECON(aq, rl, rs2, rs1, size, rd) <-> "sc." ^ size_mnemonic(size) ^ maybe_aq(aq) ^ maybe_rl(rl) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = AMO : (amoop, bool, bool, regbits, regbits, word_width, regbits) - -mapping encdec_amoop : amoop <-> bits(5) = { - AMOSWAP <-> 0b00001, - AMOADD <-> 0b00000, - AMOXOR <-> 0b00100, - AMOAND <-> 0b01100, - AMOOR <-> 0b01000, - AMOMIN <-> 0b10000, - AMOMAX <-> 0b10100, - AMOMINU <-> 0b11000, - AMOMAXU <-> 0b11100 -} - -mapping clause encdec = AMO(op, aq, rl, rs2, rs1, size, rd) <-> encdec_amoop(op) @ bool_bits(aq) @ bool_bits(rl) @ rs2 @ rs1 @ 0b0 @ size_bits(size) @ rd @ 0b0101111 - -/* NOTE: Currently, we only EA if address translation is successful. - This may need revisiting. */ -function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { - vaddr : xlenbits = X(rs1); - match translateAddr(vaddr, ReadWrite, Data) { - TR_Failure(e) => { handle_mem_exception(vaddr, e); false }, - TR_Address(addr) => { - let eares : MemoryOpResult(unit) = match width { - WORD => mem_write_ea(addr, 4, aq & rl, rl, true), - DOUBLE => mem_write_ea(addr, 8, aq & rl, rl, true), - _ => internal_error ("AMO expected WORD or DOUBLE") - }; - match (eares) { - MemException(e) => { handle_mem_exception(addr, e); false }, - MemValue(_) => { - let rval : MemoryOpResult(xlenbits) = match width { - WORD => extend_value(false, mem_read(addr, 4, aq, aq & rl, true)), - DOUBLE => extend_value(false, mem_read(addr, 8, aq, aq & rl, true)), - _ => internal_error ("AMO expected WORD or DOUBLE") - }; - match (rval) { - MemException(e) => { handle_mem_exception(addr, e); false }, - MemValue(loaded) => { - rs2_val : xlenbits = X(rs2); - result : xlenbits = - match op { - AMOSWAP => rs2_val, - AMOADD => rs2_val + loaded, - AMOXOR => rs2_val ^ loaded, - AMOAND => rs2_val & loaded, - AMOOR => rs2_val | loaded, - - /* Have to convert number to vector here. Check this */ - AMOMIN => vector64(min(signed(rs2_val), signed(loaded))), - AMOMAX => vector64(max(signed(rs2_val), signed(loaded))), - AMOMINU => vector64(min(unsigned(rs2_val), unsigned(loaded))), - AMOMAXU => vector64(max(unsigned(rs2_val), unsigned(loaded))) - }; - - let wval : MemoryOpResult(bool) = match width { - WORD => mem_write_value(addr, 4, result[31..0], aq & rl, rl, true), - DOUBLE => mem_write_value(addr, 8, result, aq & rl, rl, true), - _ => internal_error("AMO expected WORD or DOUBLE") - }; - match (wval) { - MemValue(true) => { X(rd) = loaded; true }, - MemValue(false) => { internal_error("AMO got false from mem_write_value") }, - MemException(e) => { handle_mem_exception(addr, e); false } - } - } - } - } - } - } - } -} - - -mapping amo_mnemonic : amoop <-> string = { - AMOSWAP <-> "amoswap", - AMOADD <-> "amoadd", - AMOXOR <-> "amoxor", - AMOAND <-> "amoand", - AMOOR <-> "amoor", - AMOMIN <-> "amomin", - AMOMAX <-> "amomax", - AMOMINU <-> "amominu", - AMOMAXU <-> "amomaxu" -} - -mapping clause assembly = AMO(op, aq, rl, rs2, rs1, width, rd) - <-> amo_mnemonic(op) ^ "." ^ size_mnemonic(width) ^ maybe_aq(aq) ^ maybe_rl(rl) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ reg_name(rs2) - -/* ****************************************************************** */ -union clause ast = CSR : (bits(12), regbits, regbits, bool, csrop) - -mapping encdec_csrop : csrop <-> bits(2) = { - CSRRW <-> 0b01, - CSRRS <-> 0b10, - CSRRC <-> 0b11 -} - -mapping clause encdec = CSR(csr, rs1, rd, is_imm, op) <-> csr @ rs1 @ bool_bits(is_imm) @ encdec_csrop(op) @ rd @ 0b1110011 - -function readCSR csr : csreg -> xlenbits = - let res : xlenbits = - match csr { - /* machine mode */ - 0xF11 => mvendorid, - 0xF12 => marchid, - 0xF13 => mimpid, - 0xF14 => mhartid, - 0x300 => mstatus.bits(), - 0x301 => misa.bits(), - 0x302 => medeleg.bits(), - 0x303 => mideleg.bits(), - 0x304 => mie.bits(), - 0x305 => mtvec.bits(), - 0x306 => EXTZ(mcounteren.bits()), - 0x340 => mscratch, - 0x341 => mepc & pc_alignment_mask(), - 0x342 => mcause.bits(), - 0x343 => mtval, - 0x344 => mip.bits(), - - 0x3A0 => pmpcfg0, - 0x3B0 => pmpaddr0, - - /* supervisor mode */ - 0x100 => lower_mstatus(mstatus).bits(), - 0x102 => sedeleg.bits(), - 0x103 => sideleg.bits(), - 0x104 => lower_mie(mie, mideleg).bits(), - 0x105 => stvec.bits(), - 0x106 => EXTZ(scounteren.bits()), - 0x140 => sscratch, - 0x141 => sepc & pc_alignment_mask(), - 0x142 => scause.bits(), - 0x143 => stval, - 0x144 => lower_mip(mip, mideleg).bits(), - 0x180 => satp, - - /* others */ - 0xC00 => mcycle, - 0xC01 => mtime, - 0xC02 => minstret, - - /* trigger/debug */ - 0x7a0 => ~(tselect), /* this indicates we don't have any trigger support */ - - _ => { print_bits("unhandled read to CSR ", csr); - 0x0000_0000_0000_0000 } - } in { - print_reg("CSR " ^ csr ^ " -> " ^ BitStr(res)); - res - } - -function writeCSR (csr : csreg, value : xlenbits) -> unit = - let res : option(xlenbits) = - match csr { - /* machine mode */ - 0x300 => { mstatus = legalize_mstatus(mstatus, value); Some(mstatus.bits()) }, - 0x301 => { misa = legalize_misa(misa, value); Some(misa.bits()) }, - 0x302 => { medeleg = legalize_medeleg(medeleg, value); Some(medeleg.bits()) }, - 0x303 => { mideleg = legalize_mideleg(mideleg, value); Some(mideleg.bits()) }, - 0x304 => { mie = legalize_mie(mie, value); Some(mie.bits()) }, - 0x305 => { mtvec = legalize_tvec(mtvec, value); Some(mtvec.bits()) }, - 0x306 => { mcounteren = legalize_mcounteren(mcounteren, value); Some(EXTZ(mcounteren.bits())) }, - 0x340 => { mscratch = value; Some(mscratch) }, - 0x341 => { mepc = legalize_xepc(value); Some(mepc) }, - 0x342 => { mcause->bits() = value; Some(mcause.bits()) }, - 0x343 => { mtval = value; Some(mtval) }, - 0x344 => { mip = legalize_mip(mip, value); Some(mip.bits()) }, - - 0x3A0 => { pmpcfg0 = value; Some(pmpcfg0) }, /* FIXME: legalize */ - 0x3B0 => { pmpaddr0 = value; Some(pmpaddr0) }, /* FIXME: legalize */ - - /* supervisor mode */ - 0x100 => { mstatus = legalize_sstatus(mstatus, value); Some(mstatus.bits()) }, - 0x102 => { sedeleg = legalize_sedeleg(sedeleg, value); Some(sedeleg.bits()) }, - 0x103 => { sideleg->bits() = value; Some(sideleg.bits()) }, /* TODO: does this need legalization? */ - 0x104 => { mie = legalize_sie(mie, mideleg, value); Some(mie.bits()) }, - 0x105 => { stvec = legalize_tvec(stvec, value); Some(stvec.bits()) }, - 0x106 => { scounteren = legalize_scounteren(scounteren, value); Some(EXTZ(scounteren.bits())) }, - 0x140 => { sscratch = value; Some(sscratch) }, - 0x141 => { sepc = legalize_xepc(value); Some(sepc) }, - 0x142 => { scause->bits() = value; Some(scause.bits()) }, - 0x143 => { stval = value; Some(stval) }, - 0x144 => { mip = legalize_sip(mip, mideleg, value); Some(mip.bits()) }, - 0x180 => { satp = legalize_satp(cur_Architecture(), satp, value); Some(satp) }, - - /* trigger/debug */ - 0x7a0 => { tselect = value; Some(tselect) }, - - /* counters */ - 0xC00 => { mcycle = value; Some(mcycle) }, - /* FIXME: it is not clear whether writable mtime is platform-dependent. */ - 0xC02 => { minstret = value; minstret_written = true; Some(minstret) }, - - _ => None() - } in - match res { - Some(v) => print_reg("CSR " ^ csr ^ " <- " ^ BitStr(v) ^ " (input: " ^ BitStr(value) ^ ")"), - None() => print_bits("unhandled write to CSR ", csr) - } - -function clause execute CSR(csr, rs1, rd, is_imm, op) = - let rs1_val : xlenbits = if is_imm then EXTZ(rs1) else X(rs1) in - let isWrite : bool = match op { - CSRRW => true, - _ => if is_imm then unsigned(rs1_val) != 0 else unsigned(rs1) != 0 - } in - if ~ (check_CSR(csr, cur_privilege, isWrite)) - then { handle_illegal(); false } - else { - let csr_val = readCSR(csr); /* could have side-effects, so technically shouldn't perform for CSRW[I] with rd == 0 */ - if isWrite then { - let new_val : xlenbits = match op { - CSRRW => rs1_val, - CSRRS => csr_val | rs1_val, - CSRRC => csr_val & ~(rs1_val) - } in - writeCSR(csr, new_val) - }; - X(rd) = csr_val; - true - } - - -mapping maybe_i : bool <-> string = { - true <-> "i", - false <-> "" -} - -mapping csr_mnemonic : csrop <-> string = { - CSRRW <-> "csrrw", - CSRRS <-> "csrrs", - CSRRC <-> "csrrc" -} - -mapping clause assembly = CSR(csr, rs1, rd, true, op) <-> csr_mnemonic(op) ^ "i" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_5(rs1) ^ sep() ^ csr_name_map(csr) -mapping clause assembly = CSR(csr, rs1, rd, false, op) <-> csr_mnemonic(op) ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs1) ^ sep() ^ csr_name_map(csr) - -/* ****************************************************************** */ -union clause ast = C_NOP : unit - -mapping clause encdec_compressed = C_NOP() <-> 0b000 @ 0b0 @ 0b00000 @ 0b00000 @ 0b01 - -function clause execute C_NOP() = true - -mapping clause assembly = C_NOP() <-> "c.nop" - -/* ****************************************************************** */ - -union clause ast = C_ADDI4SPN : (cregbits, bits(8)) - -mapping clause encdec_compressed = C_ADDI4SPN(rd, nz96 @ nz54 @ nz3 @ nz2) - if nz96 @ nz54 @ nz3 @ nz2 != 0b00000000 <-> - 0b000 @ nz54 : bits(2) @ nz96 : bits(4) @ nz2 : bits(1) @ nz3 : bits(1) @ rd : cregbits @ 0b00 - if nz96 @ nz54 @ nz3 @ nz2 != 0b00000000 - -function clause execute (C_ADDI4SPN(rdc, nzimm)) = - let imm : bits(12) = (0b00 @ nzimm @ 0b00) in - let rd = creg2reg_bits(rdc) in - execute(ITYPE(imm, sp, rd, RISCV_ADDI)) - -mapping clause assembly = C_ADDI4SPN(rdc, nzimm) if nzimm != 0b00000000 <-> "c.addi4spn" ^ spc() ^ creg_name(rdc) ^ sep() ^ hex_bits_10(nzimm @ 0b00) if nzimm != 0b00000000 - -/* ****************************************************************** */ -union clause ast = C_LW : (bits(5), cregbits, cregbits) - -mapping clause encdec_compressed = C_LW(ui6 @ ui53 @ ui2, rs1, rd) <-> 0b010 @ ui53 : bits(3) @ rs1 : cregbits @ ui2 : bits(1) @ ui6 : bits(1) @ rd : cregbits @ 0b00 - -function clause execute (C_LW(uimm, rsc, rdc)) = - let imm : bits(12) = EXTZ(uimm @ 0b00) in - let rd = creg2reg_bits(rdc) in - let rs = creg2reg_bits(rsc) in - execute(LOAD(imm, rs, rd, false, WORD, false, false)) - -mapping clause assembly = C_LW(uimm, rsc, rdc) <-> "c.lw" ^ spc() ^ creg_name(rdc) ^ sep() ^ creg_name(rsc) ^ sep() ^ hex_bits_7(uimm @ 0b00) - -/* ****************************************************************** */ -union clause ast = C_LD : (bits(5), cregbits, cregbits) - -mapping clause encdec_compressed = C_LD(ui76 @ ui53, rs1, rd) <-> 0b011 @ ui53 : bits(3) @ rs1 : cregbits @ ui76 : bits(2) @ rd : cregbits @ 0b00 - -function clause execute (C_LD(uimm, rsc, rdc)) = - let imm : bits(12) = EXTZ(uimm @ 0b000) in - let rd = creg2reg_bits(rdc) in - let rs = creg2reg_bits(rsc) in - execute(LOAD(imm, rs, rd, false, DOUBLE, false, false)) - -mapping clause assembly = C_LD(uimm, rsc, rdc) <-> "c.ld" ^ spc() ^ creg_name(rdc) ^ sep() ^ creg_name(rsc) ^ sep() ^ hex_bits_8(uimm @ 0b000) - -/* ****************************************************************** */ -union clause ast = C_SW : (bits(5), cregbits, cregbits) - -mapping clause encdec_compressed = C_SW(ui6 @ ui53 @ ui2, rs1, rs2) <-> 0b110 @ ui53 : bits(3) @ rs1 : cregbits @ ui2 : bits(1) @ ui6 : bits(1) @ rs2 : cregbits @ 0b00 - -function clause execute (C_SW(uimm, rsc1, rsc2)) = - let imm : bits(12) = EXTZ(uimm @ 0b00) in - let rs1 = creg2reg_bits(rsc1) in - let rs2 = creg2reg_bits(rsc2) in - execute(STORE(imm, rs2, rs1, WORD, false, false)) - -mapping clause assembly = C_SW(uimm, rsc1, rsc2) <-> "c.sw" ^ spc() ^ creg_name(rsc1) ^ sep() ^ creg_name(rsc2) ^ sep() ^ hex_bits_7(uimm @ 0b00) - -/* ****************************************************************** */ -union clause ast = C_SD : (bits(5), cregbits, cregbits) - -mapping clause encdec_compressed = C_SD(ui76 @ ui53, rs1, rs2) <-> 0b111 @ ui53 : bits(3) @ rs1 : bits(3) @ ui76 : bits(2) @ rs2 : bits(3) @ 0b00 - -function clause execute (C_SD(uimm, rsc1, rsc2)) = - let imm : bits(12) = EXTZ(uimm @ 0b000) in - let rs1 = creg2reg_bits(rsc1) in - let rs2 = creg2reg_bits(rsc2) in - execute(STORE(imm, rs2, rs1, DOUBLE, false, false)) - -mapping clause assembly = C_SD(uimm, rsc1, rsc2) <-> "c.sd" ^ spc() ^ creg_name(rsc1) ^ sep() ^ creg_name(rsc2) ^ sep() ^ hex_bits_8(uimm @ 0b000) - -/* ****************************************************************** */ -union clause ast = C_ADDI : (bits(6), regbits) - -mapping clause encdec_compressed = C_ADDI(nzi5 @ nzi40, rsd) if nzi5 @ nzi40 != 0b000000 & rsd != zreg <-> 0b000 @ nzi5 : bits(1) @ rsd : regbits @ nzi40 : bits(5) @ 0b01 if nzi5 @ nzi40 != 0b000000 & rsd != zreg - -function clause execute (C_ADDI(nzi, rsd)) = - let imm : bits(12) = EXTS(nzi) in - execute(ITYPE(imm, rsd, rsd, RISCV_ADDI)) - -mapping clause assembly = C_ADDI(nzi, rsd) if nzi != 0b000000 & rsd != zreg <-> "c.addi" ^ spc() ^ reg_name(rsd) ^ sep() ^ hex_bits_6(nzi) if nzi != 0b000000 & rsd != zreg - -/* ****************************************************************** */ -union clause ast = C_JAL : (bits(11)) -union clause ast = C_ADDIW : (bits(6), regbits) - -/* FIXME: decoding differs for RVC32/RVC64. Below, we are assuming - * RV64, and C_JAL is RV32 only. */ - -mapping clause encdec_compressed = C_ADDIW(imm5 @ imm40, rsd) if rsd != zreg <-> 0b001 @ imm5 : bits(1) @ rsd : regbits @ imm40 : bits(5) @ 0b01 if rsd != zreg - -function clause execute (C_JAL(imm)) = - execute(RISCV_JAL(EXTS(imm @ 0b0), ra)) - -function clause execute (C_ADDIW(imm, rsd)) = { - let imm : bits(32) = EXTS(imm); - let rs_val = X(rsd); - let res : bits(32) = rs_val[31..0] + imm; - X(rsd) = EXTS(res); - true -} - -mapping clause assembly = C_JAL(imm) <-> "c.jal" ^ spc() ^ hex_bits_12(imm @ 0b0) - -mapping clause assembly = C_ADDIW(imm, rsd) <-> "c.addiw" ^ spc() ^ reg_name(rsd) ^ sep() ^ hex_bits_6(imm) - -/* ****************************************************************** */ -union clause ast = C_LI : (bits(6), regbits) - -mapping clause encdec_compressed = C_LI(imm5 @ imm40, rd) if rd != zreg <-> 0b010 @ imm5 : bits(1) @ rd : regbits @ imm40 : bits(5) @ 0b01 if rd != zreg - -function clause execute (C_LI(imm, rd)) = - let imm : bits(12) = EXTS(imm) in - execute(ITYPE(imm, zreg, rd, RISCV_ADDI)) - -mapping clause assembly = C_LI(imm, rd) if rd != zreg <-> "c.li" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_6(imm) if rd != zreg - -/* ****************************************************************** */ -union clause ast = C_ADDI16SP : (bits(6)) - -mapping clause encdec_compressed = C_ADDI16SP(nzi9 @ nzi87 @ nzi6 @ nzi5 @ nzi4) - if nzi9 @ nzi87 @ nzi6 @ nzi5 @ nzi4 != 0b000000 - <-> 0b011 @ nzi9 : bits(1) @ /* x2 */ 0b00010 @ nzi4 : bits(1) @ nzi6 : bits(1) @ nzi87 : bits(2) @ nzi5 : bits(1) @ 0b01 - if nzi9 @ nzi87 @ nzi6 @ nzi5 @ nzi4 != 0b000000 - -function clause execute (C_ADDI16SP(imm)) = - let imm : bits(12) = EXTS(imm @ 0x0) in - execute(ITYPE(imm, sp, sp, RISCV_ADDI)) - -mapping clause assembly = C_ADDI16SP(imm) if imm != 0b000000 <-> "c.addi16sp" ^ spc() ^ hex_bits_6(imm) if imm != 0b000000 - -/* ****************************************************************** */ -union clause ast = C_LUI : (bits(6), regbits) - -mapping clause encdec_compressed = C_LUI(imm17 @ imm1612, rd) if rd != zreg & rd != sp & imm17 @ imm1612 != 0b000000 <-> 0b011 @ imm17 : bits(1) @ rd : regbits @ imm1612 : bits(5) @ 0b01 if rd != zreg & rd != sp & imm17 @ imm1612 != 0b000000 - -function clause execute (C_LUI(imm, rd)) = - let res : bits(20) = EXTS(imm) in - execute(UTYPE(res, rd, RISCV_LUI)) - -mapping clause assembly = C_LUI(imm, rd) if rd != zreg & rd != sp & imm != 0b000000 <-> "c.lui" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_6(imm) if rd != zreg & rd != sp & imm != 0b000000 - -/* ****************************************************************** */ -union clause ast = C_SRLI : (bits(6), cregbits) - -mapping clause encdec_compressed = C_SRLI(nzui5 @ nzui40, rsd) if nzui5 @ nzui40 != 0b000000 <-> 0b100 @ nzui5 : bits(1) @ 0b00 @ rsd : cregbits @ nzui40 : bits(5) @ 0b01 if nzui5 @ nzui40 != 0b000000 - -function clause execute (C_SRLI(shamt, rsd)) = - let rsd = creg2reg_bits(rsd) in - execute(SHIFTIOP(shamt, rsd, rsd, RISCV_SRLI)) - -mapping clause assembly = C_SRLI(shamt, rsd) if shamt != 0b000000 <-> "c.srli" ^ spc() ^ creg_name(rsd) ^ sep() ^ hex_bits_6(shamt) if shamt != 0b000000 - -/* ****************************************************************** */ -union clause ast = C_SRAI : (bits(6), cregbits) - -mapping clause encdec_compressed = C_SRAI(nzui5 @ nzui40, rsd) if nzui5 @ nzui40 != 0b000000 <-> 0b100 @ nzui5 : bits(1) @ 0b01 @ rsd : cregbits @ nzui40 : bits(5) @ 0b01 if nzui5 @ nzui40 != 0b000000 - -function clause execute (C_SRAI(shamt, rsd)) = - let rsd = creg2reg_bits(rsd) in - execute(SHIFTIOP(shamt, rsd, rsd, RISCV_SRAI)) - -mapping clause assembly = C_SRAI(shamt, rsd) if shamt != 0b000000 <-> "c.srai" ^ spc() ^ creg_name(rsd) ^ sep() ^ hex_bits_6(shamt) if shamt != 0b000000 - -/* ****************************************************************** */ -union clause ast = C_ANDI : (bits(6), cregbits) - -mapping clause encdec_compressed = C_ANDI(i5 @ i40, rsd) <-> 0b100 @ i5 : bits(1) @ 0b10 @ rsd : cregbits @ i40 : bits(5) @ 0b01 - -function clause execute (C_ANDI(imm, rsd)) = - let rsd = creg2reg_bits(rsd) in - execute(ITYPE(EXTS(imm), rsd, rsd, RISCV_ANDI)) - -mapping clause assembly = C_ANDI(imm, rsd) <-> "c.andi" ^ spc() ^ creg_name(rsd) ^ sep() ^ hex_bits_6(imm) - -/* ****************************************************************** */ -union clause ast = C_SUB : (cregbits, cregbits) - -mapping clause encdec_compressed = C_SUB(rsd, rs2) <-> 0b100 @ 0b0 @ 0b11 @ rsd : cregbits @ 0b00 @ rs2 : cregbits @ 0b01 - -function clause execute (C_SUB(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPE(rs2, rsd, rsd, RISCV_SUB)) - -mapping clause assembly = C_SUB(rsd, rs2) <-> "c.sub" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_XOR : (cregbits, cregbits) - -mapping clause encdec_compressed = C_XOR(rsd, rs2) <-> 0b100 @ 0b0 @ 0b11 @ rsd : cregbits @ 0b01 @ rs2 : cregbits @ 0b01 - -function clause execute (C_XOR(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPE(rs2, rsd, rsd, RISCV_XOR)) - -mapping clause assembly = C_XOR(rsd, rs2) <-> "c.xor" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_OR : (cregbits, cregbits) - -mapping clause encdec_compressed = C_OR(rsd, rs2) <-> 0b100 @ 0b0 @ 0b11 @ rsd : cregbits @ 0b10 @ rs2 : cregbits @ 0b01 - -function clause execute (C_OR(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPE(rs2, rsd, rsd, RISCV_OR)) - -mapping clause assembly = C_OR(rsd, rs2) <-> "c.or" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_AND : (cregbits, cregbits) - -mapping clause encdec_compressed = C_AND(rsd, rs2) <-> 0b100 @ 0b0 @ 0b11 @ rsd : cregbits @ 0b11 @ rs2 : cregbits @ 0b01 - -function clause execute (C_AND(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPE(rs2, rsd, rsd, RISCV_AND)) - -mapping clause assembly = C_AND(rsd, rs2) <-> "c.and" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_SUBW : (cregbits, cregbits) - -/* TODO: invalid on RV32 */ -mapping clause encdec_compressed = C_SUBW(rsd, rs2) <-> 0b100 @ 0b1 @ 0b11 @ rsd : cregbits @ 0b00 @ rs2 : cregbits @ 0b01 - -function clause execute (C_SUBW(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPEW(rs2, rsd, rsd, RISCV_SUBW)) - -mapping clause assembly = C_SUBW(rsd, rs2) <-> "c.subw" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_ADDW : (cregbits, cregbits) - -/* TODO: invalid on RV32 */ -mapping clause encdec_compressed = C_ADDW(rsd, rs2) <-> 0b100 @ 0b1 @ 0b11 @ rsd : cregbits @ 0b01 @ rs2 : cregbits @ 0b01 - -function clause execute (C_ADDW(rsd, rs2)) = - let rsd = creg2reg_bits(rsd) in - let rs2 = creg2reg_bits(rs2) in - execute(RTYPEW(rs2, rsd, rsd, RISCV_ADDW)) - -mapping clause assembly = C_ADDW(rsd, rs2) <-> "c.addw" ^ spc() ^ creg_name(rsd) ^ sep() ^ creg_name(rs2) - -/* ****************************************************************** */ -union clause ast = C_J : (bits(11)) - -mapping clause encdec_compressed = C_J(i11 @ i10 @ i98 @ i7 @ i6 @ i5 @ i4 @ i31) <-> 0b101 @ i11 : bits(1) @ i4 : bits(1) @ i98 : bits(2) @ i10 : bits(1) @ i6 : bits(1) @ i7 : bits(1) @ i31 : bits(3) @ i5 : bits(1) @ 0b01 - -function clause execute (C_J(imm)) = - execute(RISCV_JAL(EXTS(imm @ 0b0), zreg)) - -mapping clause assembly = C_J(imm) <-> "c.j" ^ spc() ^ hex_bits_11(imm) - -/* ****************************************************************** */ -union clause ast = C_BEQZ : (bits(8), cregbits) - -mapping clause encdec_compressed = C_BEQZ(i8 @ i76 @ i5 @ i43 @ i21, rs) <-> 0b110 @ i8 : bits(1) @ i43 : bits(2) @ rs : cregbits @ i76 : bits(2) @ i21 : bits(2) @ i5 : bits(1) @ 0b01 - -function clause execute (C_BEQZ(imm, rs)) = - execute(BTYPE(EXTS(imm @ 0b0), zreg, creg2reg_bits(rs), RISCV_BEQ)) - -mapping clause assembly = C_BEQZ(imm, rs) <-> "c.beqz" ^ spc() ^ creg_name(rs) ^ sep() ^ hex_bits_8(imm) - -/* ****************************************************************** */ -union clause ast = C_BNEZ : (bits(8), cregbits) - -mapping clause encdec_compressed = C_BNEZ(i8 @ i76 @ i5 @ i43 @ i21, rs) <-> 0b111 @ i8 : bits(1) @ i43 : bits(2) @ rs : cregbits @ i76 : bits(2) @ i21 : bits(2) @ i5 : bits(1) @ 0b01 - -function clause execute (C_BNEZ(imm, rs)) = - execute(BTYPE(EXTS(imm @ 0b0), zreg, creg2reg_bits(rs), RISCV_BNE)) - -mapping clause assembly = C_BNEZ(imm, rs) <-> "c.bnez" ^ spc() ^ creg_name(rs) ^ sep() ^ hex_bits_8(imm) - -/* ****************************************************************** */ -union clause ast = C_SLLI : (bits(6), regbits) - -/* TODO: On RV32, also need shamt[5] == 0 */ -mapping clause encdec_compressed = C_SLLI(nzui5 @ nzui40, rsd) if nzui5 @ nzui40 != 0b000000 & rsd != zreg - <-> 0b000 @ nzui5 : bits(1) @ rsd : regbits @ nzui40 : bits(5) @ 0b10 if nzui5 @ nzui40 != 0b000000 & rsd != zreg - -function clause execute (C_SLLI(shamt, rsd)) = - execute(SHIFTIOP(shamt, rsd, rsd, RISCV_SLLI)) - -mapping clause assembly = C_SLLI(shamt, rsd) if shamt != 0b000000 & rsd != zreg - <-> "c.slli" ^ spc() ^ reg_name(rsd) ^ sep() ^ hex_bits_6(shamt) if shamt != 0b000000 & rsd != zreg - -/* ****************************************************************** */ -union clause ast = C_LWSP : (bits(6), regbits) - -mapping clause encdec_compressed = C_LWSP(ui76 @ ui5 @ ui42, rd) if rd != zreg - <-> 0b010 @ ui5 : bits(1) @ rd : regbits @ ui42 : bits(3) @ ui76 : bits(2) @ 0b10 if rd != zreg - -function clause execute (C_LWSP(uimm, rd)) = - let imm : bits(12) = EXTZ(uimm @ 0b00) in - execute(LOAD(imm, sp, rd, false, WORD, false, false)) - -mapping clause assembly = C_LWSP(uimm, rd) if rd != zreg <-> "c.lwsp" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_6(uimm) if rd != zreg - -/* ****************************************************************** */ -union clause ast = C_LDSP : (bits(6), regbits) - -mapping clause encdec_compressed = C_LDSP(ui86 @ ui5 @ ui43, rd) if rd != zreg <-> 0b011 @ ui5 : bits(1) @ rd : regbits @ ui43 : bits(2) @ ui86 : bits(3) @ 0b10 if rd != zreg - -function clause execute (C_LDSP(uimm, rd)) = - let imm : bits(12) = EXTZ(uimm @ 0b000) in - execute(LOAD(imm, sp, rd, false, DOUBLE, false, false)) - -mapping clause assembly = C_LDSP(uimm, rd) if rd != zreg <-> "c.ldsp" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_6(uimm) if rd != zreg - -/* ****************************************************************** */ -union clause ast = C_SWSP : (bits(6), regbits) - -mapping clause encdec_compressed = C_SWSP(ui76 @ ui52, rs2) <-> 0b110 @ ui52 : bits(4) @ ui76 : bits(2) @ rs2 : regbits @ 0b10 - -function clause execute (C_SWSP(uimm, rs2)) = - let imm : bits(12) = EXTZ(uimm @ 0b00) in - execute(STORE(imm, rs2, sp, WORD, false, false)) - -mapping clause assembly = C_SWSP(uimm, rd) <-> "c.swsp" ^ spc() ^ reg_name(rd) ^ sep() ^ hex_bits_6(uimm) - -/* ****************************************************************** */ -union clause ast = C_SDSP : (bits(6), regbits) - -mapping clause encdec_compressed = C_SDSP(ui86 @ ui53, rs2) <-> 0b111 @ ui53 : bits(3) @ ui86 : bits(3) @ rs2 : regbits @ 0b10 - -function clause execute (C_SDSP(uimm, rs2)) = - let imm : bits(12) = EXTZ(uimm @ 0b000) in - execute(STORE(imm, rs2, sp, DOUBLE, false, false)) - -mapping clause assembly = C_SDSP(uimm, rs2) <-> "c.sdsp" ^ spc() ^ reg_name(rs2) ^ sep() ^ hex_bits_6(uimm) - -/* ****************************************************************** */ -union clause ast = C_JR : (regbits) - -mapping clause encdec_compressed = C_JR(rs1) if rs1 != zreg <-> 0b100 @ 0b0 @ rs1 : regbits @ 0b00000 @ 0b10 if rs1 != zreg - -function clause execute (C_JR(rs1)) = - execute(RISCV_JALR(EXTZ(0b0), rs1, zreg)) - -mapping clause assembly = C_JR(rs1) if rs1 != zreg <-> "c.jr" ^ spc() ^ reg_name(rs1) if rs1 != zreg - -/* ****************************************************************** */ -union clause ast = C_JALR : (regbits) - -mapping clause encdec_compressed = C_JALR(rs1) if rs1 != zreg <-> 0b100 @ 0b1 @ rs1 : regbits @ 0b00000 @ 0b10 if rs1 != zreg - -function clause execute (C_JALR(rs1)) = - execute(RISCV_JALR(EXTZ(0b0), rs1, ra)) - -mapping clause assembly = C_JALR(rs1) if rs1 != zreg <-> "c.jalr" ^ spc() ^ reg_name(rs1) if rs1 != zreg - -/* ****************************************************************** */ -union clause ast = C_MV : (regbits, regbits) - -mapping clause encdec_compressed = C_MV(rd, rs2) if rd != zreg & rs2 != zreg <-> 0b100 @ 0b0 @ rd : regbits @ rs2 : regbits @ 0b10 if rd != zreg & rs2 != zreg - -function clause execute (C_MV(rd, rs2)) = - execute(RTYPE(rs2, zreg, rd, RISCV_ADD)) - -mapping clause assembly = C_MV(rd, rs2) if rd != zreg & rs2 != zreg <-> "c.mv" ^ spc() ^ reg_name(rd) ^ sep() ^ reg_name(rs2) if rd != zreg & rs2 != zreg - -/* ****************************************************************** */ -union clause ast = C_EBREAK : unit - -mapping clause encdec_compressed = C_EBREAK() <-> 0b100 @ 0b1 @ 0b00000 @ 0b00000 @ 0b10 - -function clause execute C_EBREAK() = - execute(EBREAK()) - -mapping clause assembly = C_EBREAK() <-> "c.ebreak" - -/* ****************************************************************** */ -union clause ast = C_ADD : (regbits, regbits) - -mapping clause encdec_compressed = C_ADD(rsd, rs2) if rsd != zreg & rs2 != zreg <-> 0b100 @ 0b1 @ rsd : regbits @ rs2 : regbits @ 0b10 if rsd != zreg & rs2 != zreg - -function clause execute (C_ADD(rsd, rs2)) = - execute(RTYPE(rs2, rsd, rsd, RISCV_ADD)) - -mapping clause assembly = C_ADD(rsd, rs2) if rsd != zreg & rs2 != zreg <-> "c.add" ^ spc() ^ reg_name(rsd) ^ sep() ^ reg_name(rs2) if rsd != zreg & rs2 != zreg - -/* ****************************************************************** */ - -union clause ast = STOP_FETCHING : unit - -/* RMEM stop fetching sentinel, using RISCV encoding space custom-0 */ -mapping clause encdec = STOP_FETCHING() <-> 0xfade @ 0b00000000 @ 0b0 @ 0b00 @ 0b010 @ 0b11 - -function clause execute (STOP_FETCHING()) = true - -mapping clause assembly = STOP_FETCHING() <-> "stop_fetching" - -union clause ast = THREAD_START : unit - -/* RMEM thread start sentinel, using RISCV encoding space custom-0 */ -mapping clause encdec = THREAD_START() <-> 0xc0de @ 0b00000000 @ 0b0 @ 0b00 @ 0b010 @ 0b11 - -function clause execute (THREAD_START()) = true - -mapping clause assembly = THREAD_START() <-> "thread_start" - - -/* ****************************************************************** */ - -union clause ast = ILLEGAL : word - -mapping clause encdec = ILLEGAL(s) <-> s - -function clause execute (ILLEGAL(s)) = { handle_illegal(); false } - -mapping clause assembly = ILLEGAL(s) <-> "illegal" ^ spc() ^ hex_bits_32(s) - - - -/* ****************************************************************** */ - -union clause ast = C_ILLEGAL : half - -mapping clause encdec_compressed = C_ILLEGAL(s) <-> s - -function clause execute C_ILLEGAL(s) = { handle_illegal(); false } - -mapping clause assembly = C_ILLEGAL(s) <-> "c.illegal" ^ spc() ^ hex_bits_16(s) - -/* ****************************************************************** */ diff --git a/riscv/riscv_analysis.sail b/riscv/riscv_analysis.sail deleted file mode 100644 index e374933a..00000000 --- a/riscv/riscv_analysis.sail +++ /dev/null @@ -1,179 +0,0 @@ -$include <regfp.sail> - -/* in reverse order because inc vectors don't seem to work (bug) */ -let GPRstr : vector(32, dec, string) = [ "x31", "x30", "x29", "x28", "x27", "x26", "x25", "x24", "x23", "x22", "x21", - "x20", "x19", "x18", "x17", "x16", "x15", "x14", "x13", "x12", "x11", - "x10", "x9", "x8", "x7", "x6", "x5", "x4", "x3", "x2", "x1", "x0" - ] - - -let CIA_fp = RFull("CIA") -let NIA_fp = RFull("NIA") - -function initial_analysis (instr:ast) -> (regfps,regfps,regfps,niafps,diafp,instruction_kind) = { - iR = [| |] : regfps; - oR = [| |] : regfps; - aR = [| |] : regfps; - ik = IK_simple() : instruction_kind; - Nias = [| NIAFP_successor() |] : niafps; - Dia = DIAFP_none() : diafp; - - match instr { - EBREAK() => (), - UTYPE(imm, rd, op) => { - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - }, - RISCV_JAL(imm, rd) => { - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - let offset : bits(64) = EXTS(imm) in - Nias = [| NIAFP_concrete_address (PC + offset) |]; - ik = IK_branch(); - }, - RISCV_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 offset : bits(64) = EXTS(imm) in - Nias = [| NIAFP_indirect_address() |]; - ik = IK_branch(); - }, - 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_branch(); - let offset : bits(64) = EXTS(imm) in - Nias = [| NIAFP_concrete_address(PC + offset), NIAFP_successor() |]; - }, - 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; - }, - 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; - }, - 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; - }, - CSR(csr, rs1, rd, is_imm, op) => { - let isWrite : bool = match op { - CSRRW => true, - _ => if is_imm then unsigned(rs1) != 0 else unsigned(rs1) != 0 - }; - iR = RFull(csr_name(csr)) :: iR; - if ~(is_imm) then { - iR = RFull(GPRstr[rs1]) :: iR; - }; - if isWrite then { - oR = RFull(csr_name(csr)) :: oR; - }; - oR = RFull(GPRstr[rd]) :: oR; - }, - LOAD(imm, rs, rd, unsign, width, aq, rl) => { /* 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 = - match (aq, rl) { - (false, false) => IK_mem_read (Read_plain), - (true, false) => IK_mem_read (Read_RISCV_acquire), - (true, true) => IK_mem_read (Read_RISCV_strong_acquire), - - _ => internal_error("LOAD type not implemented in initial_analysis") - } - }, - STORE(imm, rs2, rs1, width, aq, rl) => { - 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 = - match (aq, rl) { - (false, false) => IK_mem_write (Write_plain), - (false, true) => IK_mem_write (Write_RISCV_release), - (true, true) => IK_mem_write (Write_RISCV_strong_release), - - _ => internal_error("STORE type not implemented in initial_analysis") - } - }, - ADDIW(imm, rs, rd) => { - if (rs == 0) then () else iR = RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - }, - 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; - }, - 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; - }, - FENCE(pred, succ) => { - ik = - match (pred, succ) { - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b11) => IK_barrier (Barrier_RISCV_rw_rw), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b11) => IK_barrier (Barrier_RISCV_r_rw), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b10) => IK_barrier (Barrier_RISCV_r_r), - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b01) => IK_barrier (Barrier_RISCV_rw_w), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b01) => IK_barrier (Barrier_RISCV_w_w), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b11) => IK_barrier (Barrier_RISCV_w_rw), - (_ : bits(2) @ 0b11, _ : bits(2) @ 0b10) => IK_barrier (Barrier_RISCV_rw_r), - (_ : bits(2) @ 0b10, _ : bits(2) @ 0b01) => IK_barrier (Barrier_RISCV_r_w), - (_ : bits(2) @ 0b01, _ : bits(2) @ 0b10) => IK_barrier (Barrier_RISCV_w_r), - - - (_ : bits(2) @ 0b00, _ : bits(2) @ 0b00) => IK_simple (), - - _ => internal_error("barrier type not implemented in initial_analysis") - // case (FM_NORMAL, _, _) -> exit "not implemented" - - // case (FM_TSO, 0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_tso) - // case (FM_TSO, _, _) -> exit "not implemented" - }; - }, - FENCEI() => { - ik = IK_simple (); // for RMEM, should morally be Barrier_RISCV_i - }, - LOADRES(aq, rl, rs1, width, rd) => { - if (rs1 == 0) then () else iR = RFull(GPRstr[rs1]) :: iR; - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - aR = iR; - ik = match (aq, rl) { - (false, false) => IK_mem_read (Read_RISCV_reserved), - (true, false) => IK_mem_read (Read_RISCV_reserved_acquire), - (true, true) => IK_mem_read (Read_RISCV_reserved_strong_acquire), - (false, true) => internal_error("LOADRES type not implemented in initial_analysis") - }; - }, - STORECON(aq, rl, rs2, rs1, width, rd) => { - 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; - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - ik = match (aq, rl) { - (false, false) => IK_mem_write (Write_RISCV_conditional), - (false, true) => IK_mem_write (Write_RISCV_conditional_release), - (true, true) => IK_mem_write (Write_RISCV_conditional_strong_release), - - (true, false) => internal_error("STORECON type not implemented in initial_analysis") - }; - }, - AMO(op, aq, rl, rs2, rs1, width, rd) => { - 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; - if (rd == 0) then () else oR = RFull(GPRstr[rd]) :: oR; - ik = match (aq, rl) { - (false, false) => IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional), - (false, true) => IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional_release), - (true, false) => IK_mem_rmw (Read_RISCV_reserved_acquire, - Write_RISCV_conditional), - (true, true) => IK_mem_rmw (Read_RISCV_reserved_acquire, - Write_RISCV_conditional_release) - }; - }, - _ => () - }; - (iR,oR,aR,Nias,Dia,ik) -} diff --git a/riscv/riscv_config.h b/riscv/riscv_config.h deleted file mode 100644 index f8f3eb30..00000000 --- a/riscv/riscv_config.h +++ /dev/null @@ -1,7 +0,0 @@ -#pragma once -#include <stdbool.h> - -extern bool config_print_instr; -extern bool config_print_reg; -extern bool config_print_mem_access; -extern bool config_print_platform; diff --git a/riscv/riscv_duopod.sail b/riscv/riscv_duopod.sail deleted file mode 100644 index 0a5a7f8c..00000000 --- a/riscv/riscv_duopod.sail +++ /dev/null @@ -1,86 +0,0 @@ - -type xlen = atom(64) -type xlen_t = bits(64) - -type regno ('n : Int), 0 <= 'n < 32 = atom('n) -type regbits = bits(5) - -val zeros : forall 'n, 'n >= 0. atom('n) -> bits('n) -function zeros n = replicate_bits(0b0, n) - -val cast regbits_to_regno : bits(5) -> {'n, 0 <= 'n < 32. regno('n)} -function regbits_to_regno b = let r as atom(_) = unsigned(b) in r - -/* Architectural state */ - -register PC : xlen_t -register nextPC : xlen_t - -register Xs : vector(32, dec, xlen_t) - -/* Getters and setters for X registers (special case for zeros register, x0) */ -val rX : forall 'n, 0 <= 'n < 32. regno('n) -> xlen_t effect {rreg} - -function rX 0 = 0x0000000000000000 -and rX (r if r > 0) = Xs[r] - -val wX : forall 'n, 0 <= 'n < 32. (regno('n), xlen_t) -> unit effect {wreg} - -function wX (r, v) = - if (r != 0) then { - Xs[r] = v; - } - -overload X = {rX, wX} - -/* Accessors for memory */ - -val MEMr : forall 'n, 'n >= 0. (xlen_t, atom('n)) -> bits(8 * 'n) effect {rmem} -function MEMr (addr, width) = - match __RISCV_read(addr, width, false, false, false) { Some(v) => v, None() => zeros(8 * width) } - -/* Instruction decode and execute */ -enum iop = {RISCV_ADDI, RISCV_SLTI, RISCV_SLTIU, RISCV_XORI, RISCV_ORI, RISCV_ANDI} /* immediate ops */ -scattered union ast - -val decode : bits(32) -> option(ast) effect pure -scattered function decode - -val execute : ast -> unit effect {rmem, rreg, wreg} -scattered function execute - -/* ****************************************************************** */ - -/* ADDI */ - -union clause ast = ITYPE : (bits(12), regbits, regbits, iop) - -function clause decode imm : bits(12) @ rs1 : regbits @ 0b000 @ rd : regbits @ 0b0010011 - = Some(ITYPE(imm, rs1, rd, RISCV_ADDI)) - -function clause execute (ITYPE (imm, rs1, rd, RISCV_ADDI)) = - let rs1_val = X(rs1) in - let imm_ext : xlen_t = EXTS(imm) in - let result = rs1_val + imm_ext in - X(rd) = result - -/* ****************************************************************** */ - -/* Load double */ -union clause ast = LOAD : (bits(12), regbits, regbits) - -function clause decode imm : bits(12) @ rs1 : regbits @ 0b011 @ rd : regbits @ 0b0000011 - = Some(LOAD(imm, rs1, rd)) - -function clause execute(LOAD(imm, rs1, rd)) = - let addr : xlen_t = X(rs1) + EXTS(imm) in - let result : xlen_t = MEMr(addr, 8) in - X(rd) = result - -/* ****************************************************************** */ - -function clause decode _ = None() - -end ast -end decode -end execute diff --git a/riscv/riscv_extras.lem b/riscv/riscv_extras.lem deleted file mode 100644 index 7028d5b8..00000000 --- a/riscv/riscv_extras.lem +++ /dev/null @@ -1,135 +0,0 @@ -open import Pervasives -open import Pervasives_extra -open import Sail2_instr_kinds -open import Sail2_values -open import Sail2_operators_mwords -open import Sail2_prompt_monad -open import Sail2_prompt - -type bitvector 'a = mword 'a - -let MEM_fence_rw_rw () = barrier Barrier_RISCV_rw_rw -let MEM_fence_r_rw () = barrier Barrier_RISCV_r_rw -let MEM_fence_r_r () = barrier Barrier_RISCV_r_r -let MEM_fence_rw_w () = barrier Barrier_RISCV_rw_w -let MEM_fence_w_w () = barrier Barrier_RISCV_w_w -let MEM_fence_w_rw () = barrier Barrier_RISCV_w_rw -let MEM_fence_rw_r () = barrier Barrier_RISCV_rw_r -let MEM_fence_r_w () = barrier Barrier_RISCV_r_w -let MEM_fence_w_r () = barrier Barrier_RISCV_w_r -let MEM_fence_i () = barrier Barrier_RISCV_i - -val MEMea : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e - -let MEMea addr size = write_mem_ea Write_plain addr size -let MEMea_release addr size = write_mem_ea Write_RISCV_release addr size -let MEMea_strong_release addr size = write_mem_ea Write_RISCV_strong_release addr size -let MEMea_conditional addr size = write_mem_ea Write_RISCV_conditional addr size -let MEMea_conditional_release addr size = write_mem_ea Write_RISCV_conditional_release addr size -let MEMea_conditional_strong_release addr size - = write_mem_ea Write_RISCV_conditional_strong_release addr size - -val MEMr : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_strong_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved_strong_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e - -let MEMr addrsize size hexRAM addr = read_mem Read_plain addr size -let MEMr_acquire addrsize size hexRAM addr = read_mem Read_RISCV_acquire addr size -let MEMr_strong_acquire addrsize size hexRAM addr = read_mem Read_RISCV_strong_acquire addr size -let MEMr_reserved addrsize size hexRAM addr = read_mem Read_RISCV_reserved addr size -let MEMr_reserved_acquire addrsize size hexRAM addr = read_mem Read_RISCV_reserved_acquire addr size -let MEMr_reserved_strong_acquire addrsize size hexRAM addr = read_mem Read_RISCV_reserved_strong_acquire addr size - -val write_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b => - integer -> integer -> bitvector 'a -> bitvector 'a -> bitvector 'b -> monad 'rv bool 'e -let write_ram addrsize size hexRAM address value = - write_mem_val value - -val read_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b => - integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -let read_ram addrsize size hexRAM address = - read_mem Read_plain address size - -val load_reservation : forall 'a. Size 'a => bitvector 'a -> unit -let load_reservation addr = () - -let speculate_conditional_success _ = excl_result () - -let cancel_reservation () = () - -val plat_ram_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_ram_base () = wordFromInteger 0 -declare ocaml target_rep function plat_ram_base = `Platform.dram_base` - -val plat_ram_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_ram_size () = wordFromInteger 0 -declare ocaml target_rep function plat_ram_size = `Platform.dram_size` - -val plat_rom_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_rom_base () = wordFromInteger 0 -declare ocaml target_rep function plat_rom_base = `Platform.rom_base` - -val plat_rom_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_rom_size () = wordFromInteger 0 -declare ocaml target_rep function plat_rom_size = `Platform.rom_size` - -val plat_clint_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_clint_base () = wordFromInteger 0 -declare ocaml target_rep function plat_clint_base = `Platform.clint_base` - -val plat_clint_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_clint_size () = wordFromInteger 0 -declare ocaml target_rep function plat_clint_size = `Platform.clint_size` - -val plat_enable_dirty_update : unit -> bool -let plat_enable_dirty_update () = false -declare ocaml target_rep function plat_enable_dirty_update = `Platform.enable_dirty_update` - -val plat_enable_misaligned_access : unit -> bool -let plat_enable_misaligned_access () = false -declare ocaml target_rep function plat_enable_misaligned_access = `Platform.enable_misaligned_access` - -val plat_mtval_has_illegal_inst_bits : unit -> bool -let plat_mtval_has_illegal_inst_bits () = false -declare ocaml target_rep function plat_mtval_has_illegal_inst_bits = `Platform.mtval_has_illegal_inst_bits` - -val plat_insns_per_tick : unit -> integer -let plat_insns_per_tick () = 1 -declare ocaml target_rep function plat_insns_per_tick = `Platform.insns_per_tick` - -val plat_htif_tohost : forall 'a. Size 'a => unit -> bitvector 'a -let plat_htif_tohost () = wordFromInteger 0 -declare ocaml target_rep function plat_htif_tohost = `Platform.htif_tohost` - -val plat_term_write : forall 'a. Size 'a => bitvector 'a -> unit -let plat_term_write _ = () -declare ocaml target_rep function plat_term_write = `Platform.term_write` - -val plat_term_read : forall 'a. Size 'a => unit -> bitvector 'a -let plat_term_read () = wordFromInteger 0 -declare ocaml target_rep function plat_term_read = `Platform.term_read` - -val shift_bits_right : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a -let shift_bits_right v m = shiftr v (uint m) -val shift_bits_left : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a -let shift_bits_left v m = shiftl v (uint m) - -val print_string : string -> string -> unit -let print_string msg s = () (* print_endline (msg ^ s) *) - -val prerr_string : string -> string -> unit -let prerr_string msg s = prerr_endline (msg ^ s) - -val prerr_bits : forall 'a. Size 'a => string -> bitvector 'a -> unit -let prerr_bits msg bs = prerr_endline (msg ^ (show_bitlist (bits_of bs))) - -val print_bits : forall 'a. Size 'a => string -> bitvector 'a -> unit -let print_bits msg bs = () (* print_endline (msg ^ (show_bitlist (bits_of bs))) *) diff --git a/riscv/riscv_extras.v b/riscv/riscv_extras.v deleted file mode 100644 index 820e3f3a..00000000 --- a/riscv/riscv_extras.v +++ /dev/null @@ -1,134 +0,0 @@ -Require Import Sail2_instr_kinds. -Require Import Sail2_values. -Require Import Sail2_operators_mwords. -Require Import Sail2_prompt_monad. -Require Import Sail2_prompt. -Require Import String. -Require Import List. -Import List.ListNotations. - -Axiom real : Type. - -Definition MEM_fence_rw_rw {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_rw_rw. -Definition MEM_fence_r_rw {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_r_rw. -Definition MEM_fence_r_r {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_r_r. -Definition MEM_fence_rw_w {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_rw_w. -Definition MEM_fence_w_w {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_w_w. -Definition MEM_fence_w_rw {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_w_rw. -Definition MEM_fence_rw_r {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_rw_r. -Definition MEM_fence_r_w {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_r_w. -Definition MEM_fence_w_r {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_w_r. -Definition MEM_fence_i {rv e} (_:unit) : monad rv unit e := barrier Barrier_RISCV_i. -(* -val MEMea : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -*) -Definition MEMea {rv a e} (addr : mword a) size : monad rv unit e := write_mem_ea Write_plain addr size. -Definition MEMea_release {rv a e} (addr : mword a) size : monad rv unit e := write_mem_ea Write_RISCV_release addr size. -Definition MEMea_strong_release {rv a e} (addr : mword a) size : monad rv unit e := write_mem_ea Write_RISCV_strong_release addr size. -Definition MEMea_conditional {rv a e} (addr : mword a) size : monad rv unit e := write_mem_ea Write_RISCV_conditional addr size. -Definition MEMea_conditional_release {rv a e} (addr : mword a) size : monad rv unit e := write_mem_ea Write_RISCV_conditional_release addr size. -Definition MEMea_conditional_strong_release {rv a e} (addr : mword a) size : monad rv unit e - := write_mem_ea Write_RISCV_conditional_strong_release addr size. - - -(* Some wrappers copied from aarch64_extras *) -(* TODO: Harmonise into a common library *) -(* -Definition get_slice_int_bl len n lo := - (* TODO: Is this the intended behaviour? *) - let hi := lo + len - 1 in - let bs := bools_of_int (hi + 1) n in - subrange_list false bs hi lo - -val get_slice_int : forall 'a. Bitvector 'a => integer -> integer -> integer -> 'a -Definition get_slice_int len n lo := of_bools (get_slice_int_bl len n lo) -*) -Definition write_ram {rv e} m size (hexRAM : mword m) (addr : mword m) (data : mword (8 * size)) : monad rv bool e := - write_mem_val data. - -Definition read_ram {rv e} m size `{ArithFact (size >= 0)} (_ : mword m) (addr : mword m) : monad rv (mword (8 * size)) e := - read_mem Read_plain addr size. -(* -Definition string_of_bits bs := string_of_bv (bits_of bs). -Definition string_of_int := show - -Definition _sign_extend bits len := maybe_failwith (of_bits (exts_bv len bits)) -Definition _zero_extend bits len := maybe_failwith (of_bits (extz_bv len bits)) -*) -Definition shift_bits_left {a b} (v : mword a) (n : mword b) : mword a := - shiftl v (int_of_mword false n). - -Definition shift_bits_right {a b} (v : mword a) (n : mword b) : mword a := - shiftr v (int_of_mword false n). - -Definition shift_bits_right_arith {a b} (v : mword a) (n : mword b) : mword a := - arith_shiftr v (int_of_mword false n). - -(* Use constants for undefined values for now *) -Definition internal_pick {rv a e} (vs : list a) : monad rv a e := -match vs with -| (h::_) => returnm h -| _ => Fail "empty list in internal_pick" -end. -Definition undefined_string {rv e} (_:unit) : monad rv string e := returnm ""%string. -Definition undefined_unit {rv e} (_:unit) : monad rv unit e := returnm tt. -Definition undefined_int {rv e} (_:unit) : monad rv Z e := returnm (0:ii). -(*val undefined_vector : forall 'rv 'a 'e. integer -> 'a -> monad 'rv (list 'a) 'e*) -Definition undefined_vector {rv a e} len (u : a) `{ArithFact (len >= 0)} : monad rv (vec a len) e := returnm (vec_init u len). -(*val undefined_bitvector : forall 'rv 'a 'e. Bitvector 'a => integer -> monad 'rv 'a 'e*) -Definition undefined_bitvector {rv e} len `{ArithFact (len >= 0)} : monad rv (mword len) e := returnm (mword_of_int 0). -(*val undefined_bits : forall 'rv 'a 'e. Bitvector 'a => integer -> monad 'rv 'a 'e*) -Definition undefined_bits {rv e} := @undefined_bitvector rv e. -Definition undefined_bit {rv e} (_:unit) : monad rv bitU e := returnm BU. -(*Definition undefined_real {rv e} (_:unit) : monad rv real e := returnm (realFromFrac 0 1).*) -Definition undefined_range {rv e} i j `{ArithFact (i <= j)} : monad rv {z : Z & ArithFact (i <= z /\ z <= j)} e := returnm (build_ex i). -Definition undefined_atom {rv e} i : monad rv Z e := returnm i. -Definition undefined_nat {rv e} (_:unit) : monad rv Z e := returnm (0:ii). - -Definition skip {rv e} (_:unit) : monad rv unit e := returnm tt. - -(*val elf_entry : unit -> integer*) -Definition elf_entry (_:unit) : Z := 0. -(*declare ocaml target_rep function elf_entry := `Elf_loader.elf_entry`*) - -Definition print_bits {n} msg (bs : mword n) := prerr_endline (msg ++ (string_of_bits bs)). - -(*val get_time_ns : unit -> integer*) -Definition get_time_ns (_:unit) : Z := 0. -(*declare ocaml target_rep function get_time_ns := `(fun () -> Big_int.of_int (int_of_float (1e9 *. Unix.gettimeofday ())))`*) - -Definition eq_bit (x : bitU) (y : bitU) : bool := - match x, y with - | B0, B0 => true - | B1, B1 => true - | BU, BU => true - | _,_ => false - end. - -Require Import Zeuclid. -Definition euclid_modulo (m n : Z) `{ArithFact (n > 0)} : {z : Z & ArithFact (0 <= z <= n-1)}. -apply existT with (x := ZEuclid.modulo m n). -constructor. -destruct H. -assert (Z.abs n = n). { rewrite Z.abs_eq; auto with zarith. } -rewrite <- H at 3. -lapply (ZEuclid.mod_always_pos m n); omega. -Qed. - -(* Override the more general version *) - -Definition mults_vec {n} (l : mword n) (r : mword n) : mword (2 * n) := mults_vec l r. -Definition mult_vec {n} (l : mword n) (r : mword n) : mword (2 * n) := mult_vec l r. - - -Definition print_endline (_:string) : unit := tt. -Definition prerr_endline (_:string) : unit := tt. -Definition prerr_string (_:string) : unit := tt. -Definition putchar {T} (_:T) : unit := tt. -Require DecimalString. -Definition string_of_int z := DecimalString.NilZero.string_of_int (Z.to_int z). diff --git a/riscv/riscv_extras_sequential.lem b/riscv/riscv_extras_sequential.lem deleted file mode 100644 index 7028d5b8..00000000 --- a/riscv/riscv_extras_sequential.lem +++ /dev/null @@ -1,135 +0,0 @@ -open import Pervasives -open import Pervasives_extra -open import Sail2_instr_kinds -open import Sail2_values -open import Sail2_operators_mwords -open import Sail2_prompt_monad -open import Sail2_prompt - -type bitvector 'a = mword 'a - -let MEM_fence_rw_rw () = barrier Barrier_RISCV_rw_rw -let MEM_fence_r_rw () = barrier Barrier_RISCV_r_rw -let MEM_fence_r_r () = barrier Barrier_RISCV_r_r -let MEM_fence_rw_w () = barrier Barrier_RISCV_rw_w -let MEM_fence_w_w () = barrier Barrier_RISCV_w_w -let MEM_fence_w_rw () = barrier Barrier_RISCV_w_rw -let MEM_fence_rw_r () = barrier Barrier_RISCV_rw_r -let MEM_fence_r_w () = barrier Barrier_RISCV_r_w -let MEM_fence_w_r () = barrier Barrier_RISCV_w_r -let MEM_fence_i () = barrier Barrier_RISCV_i - -val MEMea : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e -val MEMea_conditional_strong_release : forall 'rv 'a 'e. Size 'a => bitvector 'a -> integer -> monad 'rv unit 'e - -let MEMea addr size = write_mem_ea Write_plain addr size -let MEMea_release addr size = write_mem_ea Write_RISCV_release addr size -let MEMea_strong_release addr size = write_mem_ea Write_RISCV_strong_release addr size -let MEMea_conditional addr size = write_mem_ea Write_RISCV_conditional addr size -let MEMea_conditional_release addr size = write_mem_ea Write_RISCV_conditional_release addr size -let MEMea_conditional_strong_release addr size - = write_mem_ea Write_RISCV_conditional_strong_release addr size - -val MEMr : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_strong_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -val MEMr_reserved_strong_acquire : forall 'rv 'a 'b 'e. Size 'a, Size 'b => integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e - -let MEMr addrsize size hexRAM addr = read_mem Read_plain addr size -let MEMr_acquire addrsize size hexRAM addr = read_mem Read_RISCV_acquire addr size -let MEMr_strong_acquire addrsize size hexRAM addr = read_mem Read_RISCV_strong_acquire addr size -let MEMr_reserved addrsize size hexRAM addr = read_mem Read_RISCV_reserved addr size -let MEMr_reserved_acquire addrsize size hexRAM addr = read_mem Read_RISCV_reserved_acquire addr size -let MEMr_reserved_strong_acquire addrsize size hexRAM addr = read_mem Read_RISCV_reserved_strong_acquire addr size - -val write_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b => - integer -> integer -> bitvector 'a -> bitvector 'a -> bitvector 'b -> monad 'rv bool 'e -let write_ram addrsize size hexRAM address value = - write_mem_val value - -val read_ram : forall 'rv 'a 'b 'e. Size 'a, Size 'b => - integer -> integer -> bitvector 'a -> bitvector 'a -> monad 'rv (bitvector 'b) 'e -let read_ram addrsize size hexRAM address = - read_mem Read_plain address size - -val load_reservation : forall 'a. Size 'a => bitvector 'a -> unit -let load_reservation addr = () - -let speculate_conditional_success _ = excl_result () - -let cancel_reservation () = () - -val plat_ram_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_ram_base () = wordFromInteger 0 -declare ocaml target_rep function plat_ram_base = `Platform.dram_base` - -val plat_ram_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_ram_size () = wordFromInteger 0 -declare ocaml target_rep function plat_ram_size = `Platform.dram_size` - -val plat_rom_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_rom_base () = wordFromInteger 0 -declare ocaml target_rep function plat_rom_base = `Platform.rom_base` - -val plat_rom_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_rom_size () = wordFromInteger 0 -declare ocaml target_rep function plat_rom_size = `Platform.rom_size` - -val plat_clint_base : forall 'a. Size 'a => unit -> bitvector 'a -let plat_clint_base () = wordFromInteger 0 -declare ocaml target_rep function plat_clint_base = `Platform.clint_base` - -val plat_clint_size : forall 'a. Size 'a => unit -> bitvector 'a -let plat_clint_size () = wordFromInteger 0 -declare ocaml target_rep function plat_clint_size = `Platform.clint_size` - -val plat_enable_dirty_update : unit -> bool -let plat_enable_dirty_update () = false -declare ocaml target_rep function plat_enable_dirty_update = `Platform.enable_dirty_update` - -val plat_enable_misaligned_access : unit -> bool -let plat_enable_misaligned_access () = false -declare ocaml target_rep function plat_enable_misaligned_access = `Platform.enable_misaligned_access` - -val plat_mtval_has_illegal_inst_bits : unit -> bool -let plat_mtval_has_illegal_inst_bits () = false -declare ocaml target_rep function plat_mtval_has_illegal_inst_bits = `Platform.mtval_has_illegal_inst_bits` - -val plat_insns_per_tick : unit -> integer -let plat_insns_per_tick () = 1 -declare ocaml target_rep function plat_insns_per_tick = `Platform.insns_per_tick` - -val plat_htif_tohost : forall 'a. Size 'a => unit -> bitvector 'a -let plat_htif_tohost () = wordFromInteger 0 -declare ocaml target_rep function plat_htif_tohost = `Platform.htif_tohost` - -val plat_term_write : forall 'a. Size 'a => bitvector 'a -> unit -let plat_term_write _ = () -declare ocaml target_rep function plat_term_write = `Platform.term_write` - -val plat_term_read : forall 'a. Size 'a => unit -> bitvector 'a -let plat_term_read () = wordFromInteger 0 -declare ocaml target_rep function plat_term_read = `Platform.term_read` - -val shift_bits_right : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a -let shift_bits_right v m = shiftr v (uint m) -val shift_bits_left : forall 'a 'b. Size 'a, Size 'b => bitvector 'a -> bitvector 'b -> bitvector 'a -let shift_bits_left v m = shiftl v (uint m) - -val print_string : string -> string -> unit -let print_string msg s = () (* print_endline (msg ^ s) *) - -val prerr_string : string -> string -> unit -let prerr_string msg s = prerr_endline (msg ^ s) - -val prerr_bits : forall 'a. Size 'a => string -> bitvector 'a -> unit -let prerr_bits msg bs = prerr_endline (msg ^ (show_bitlist (bits_of bs))) - -val print_bits : forall 'a. Size 'a => string -> bitvector 'a -> unit -let print_bits msg bs = () (* print_endline (msg ^ (show_bitlist (bits_of bs))) *) diff --git a/riscv/riscv_insts_begin.sail b/riscv/riscv_insts_begin.sail deleted file mode 100644 index 56fd8b43..00000000 --- a/riscv/riscv_insts_begin.sail +++ /dev/null @@ -1,19 +0,0 @@ -/* Instruction definitions. - * - * This includes decoding, execution, and assembly parsing and printing. - */ - -scattered union ast - -/* returns whether an instruction was retired, used for computing minstret */ -val execute : ast -> bool effect {escape, wreg, rreg, wmv, eamem, rmem, barr, exmem} -scattered function execute - -val assembly : ast <-> string -scattered mapping assembly - -val encdec : ast <-> bits(32) -scattered mapping encdec - -val encdec_compressed : ast <-> bits(16) -scattered mapping encdec_compressed diff --git a/riscv/riscv_insts_end.sail b/riscv/riscv_insts_end.sail deleted file mode 100644 index 144f06e3..00000000 --- a/riscv/riscv_insts_end.sail +++ /dev/null @@ -1,15 +0,0 @@ -/* End definitions */ -end ast -end execute -end assembly -end encdec -end encdec_compressed - -val cast print_insn : ast -> string -function print_insn insn = assembly(insn) - -val decode : bits(32) -> option(ast) effect pure -function decode bv = Some(encdec(bv)) - -val decodeCompressed : bits(16) -> option(ast) effect pure -function decodeCompressed bv = Some(encdec_compressed(bv)) diff --git a/riscv/riscv_jalr_rmem.sail b/riscv/riscv_jalr_rmem.sail deleted file mode 100644 index daf4bb01..00000000 --- a/riscv/riscv_jalr_rmem.sail +++ /dev/null @@ -1,10 +0,0 @@ -/* The definition for the memory model. */ - -function clause execute (RISCV_JALR(imm, rs1, rd)) = { - /* FIXME: this does not check for a misaligned target address. See riscv_jalr_seq.sail. */ - /* write rd before anything else to prevent unintended strength */ - X(rd) = nextPC; /* compatible with JALR, C.JR and C.JALR */ - let newPC : xlenbits = X(rs1) + EXTS(imm); - nextPC = newPC[63..1] @ 0b0; - true -} diff --git a/riscv/riscv_jalr_seq.sail b/riscv/riscv_jalr_seq.sail deleted file mode 100644 index fcf9526e..00000000 --- a/riscv/riscv_jalr_seq.sail +++ /dev/null @@ -1,19 +0,0 @@ -/* The definition for the sequential model. */ - -function clause execute (RISCV_JALR(imm, rs1, rd)) = { -/* For the sequential model, the memory-model definition doesn't work directly - if rs1 = rd. We would effectively have to keep a regfile for reads and another for - writes, and swap on instruction completion. This could perhaps be optimized in - some manner, but for now, we just keep a reordered definition to improve simulator - performance. -*/ - let newPC : xlenbits = (X(rs1) + EXTS(imm))[63..1] @ 0b0; - if newPC[1] & (~ (haveRVC())) then { - handle_mem_exception(newPC, E_Fetch_Addr_Align); - false; - } else { - X(rd) = nextPC; - nextPC = newPC; - true - } -} diff --git a/riscv/riscv_mem.sail b/riscv/riscv_mem.sail deleted file mode 100644 index 3d380380..00000000 --- a/riscv/riscv_mem.sail +++ /dev/null @@ -1,190 +0,0 @@ -/* Physical memory model. - * - * This assumes that the platform memory map has been defined, so that accesses - * to MMIO regions can be dispatched. - */ - -function is_aligned_addr forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - unsigned(addr) % width == 0 - -// only used for actual memory regions, to avoid MMIO effects -function phys_mem_read forall 'n, 'n >= 0. (t : ReadType, addr : xlenbits, width : atom('n), aq : bool, rl: bool, res : bool) -> MemoryOpResult(bits(8 * 'n)) = - match (t, __RISCV_read(addr, width, aq, rl, res)) { - (Instruction, None()) => MemException(E_Fetch_Access_Fault), - (Data, None()) => MemException(E_Load_Access_Fault), - (_, Some(v)) => { print_mem("mem[" ^ t ^ "," ^ BitStr(addr) ^ "] -> " ^ BitStr(v)); - MemValue(v) } - } - -function checked_mem_read forall 'n, 'n > 0. (t : ReadType, addr : xlenbits, width : atom('n), aq : bool, rl : bool, res: bool) -> MemoryOpResult(bits(8 * 'n)) = - /* treat MMIO regions as not executable for now. TODO: this should actually come from PMP/PMA. */ - if t == Data & within_mmio_readable(addr, width) - then mmio_read(addr, width) - else if within_phys_mem(addr, width) - then phys_mem_read(t, addr, width, aq, rl, res) - else MemException(E_Load_Access_Fault) - -/* Atomic accesses can be done to MMIO regions, e.g. in kernel access to device registers. */ - -val MEMr : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} -val MEMr_acquire : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} -val MEMr_strong_acquire : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} -val MEMr_reserved : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} -val MEMr_reserved_acquire : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} -val MEMr_reserved_strong_acquire : forall 'n, 'n > 0. (xlenbits, atom('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg} - -function MEMr (addr, width) = checked_mem_read(Data, addr, width, false, false, false) -function MEMr_acquire (addr, width) = checked_mem_read(Data, addr, width, true, false, false) -function MEMr_strong_acquire (addr, width) = checked_mem_read(Data, addr, width, true, true, false) -function MEMr_reserved (addr, width) = checked_mem_read(Data, addr, width, false, false, true) -function MEMr_reserved_acquire (addr, width) = checked_mem_read(Data, addr, width, true, false, true) -function MEMr_reserved_strong_acquire (addr, width) = checked_mem_read(Data, addr, width, true, true, true) - -$ifdef RVFI_DII -val rvfi_read : forall 'n, 'n > 0. (xlenbits, atom('n), MemoryOpResult(bits(8 * 'n))) -> unit effect {wreg} -function rvfi_read (addr, width, result) = { - rvfi_exec->rvfi_mem_addr() = addr; - match result { - MemValue(v) => - if width <= 8 - then { - rvfi_exec->rvfi_mem_wdata() = zero_extend(v,64); - rvfi_exec->rvfi_mem_wmask() = to_bits(8,width) - } else (), - MemException(_) => () - }; -} -$else -val rvfi_read : forall 'n, 'n > 0. (xlenbits, atom('n), MemoryOpResult(bits(8 * 'n))) -> unit -function rvfi_read (addr, width, value) = () -$endif - -/* NOTE: The rreg effect is due to MMIO. */ -$ifdef RVFI_DII -val mem_read : forall 'n, 'n > 0. (xlenbits, atom('n), bool, bool, bool) -> MemoryOpResult(bits(8 * 'n)) effect {wreg, rmem, rreg, escape} -$else -val mem_read : forall 'n, 'n > 0. (xlenbits, atom('n), bool, bool, bool) -> MemoryOpResult(bits(8 * 'n)) effect {rmem, rreg, escape} -$endif - -function mem_read (addr, width, aq, rl, res) = { - let result : MemoryOpResult(bits(8 * 'n)) = - if (aq | res) & (~ (is_aligned_addr(addr, width))) - then MemException(E_Load_Addr_Align) - else match (aq, rl, res) { - (false, false, false) => checked_mem_read(Data, addr, width, false, false, false), - (true, false, false) => MEMr_acquire(addr, width), - (false, false, true) => MEMr_reserved(addr, width), - (true, false, true) => MEMr_reserved_acquire(addr, width), - (false, true, false) => throw(Error_not_implemented("load.rl")), - (true, true, false) => MEMr_strong_acquire(addr, width), - (false, true, true) => throw(Error_not_implemented("lr.rl")), - (true, true, true) => MEMr_reserved_strong_acquire(addr, width) - }; - rvfi_read(addr, width, result); - result -} - -val MEMea = {lem: "MEMea", coq: "MEMea", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} -val MEMea_release = {lem: "MEMea_release", coq: "MEMea_release", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} -val MEMea_strong_release = {lem: "MEMea_strong_release", coq: "MEMea_strong_release", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} -val MEMea_conditional = {lem: "MEMea_conditional", coq: "MEMea_conditional", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} -val MEMea_conditional_release = {lem: "MEMea_conditional_release", coq: "MEMea_conditional_release", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} -val MEMea_conditional_strong_release = {lem: "MEMea_conditional_strong_release", coq: "MEMea_conditional_strong_release", _: "memea"} : forall 'n. - (xlenbits, atom('n)) -> unit effect {eamem} - -val mem_write_ea : forall 'n. (xlenbits, atom('n), bool, bool, bool) -> MemoryOpResult(unit) effect {eamem, escape} - -function mem_write_ea (addr, width, aq, rl, con) = { - if (rl | con) & (~ (is_aligned_addr(addr, width))) - then MemException(E_SAMO_Addr_Align) - else match (aq, rl, con) { - (false, false, false) => MemValue(MEMea(addr, width)), - (false, true, false) => MemValue(MEMea_release(addr, width)), - (false, false, true) => MemValue(MEMea_conditional(addr, width)), - (false, true , true) => MemValue(MEMea_conditional_release(addr, width)), - (true, false, false) => throw(Error_not_implemented("store.aq")), - (true, true, false) => MemValue(MEMea_strong_release(addr, width)), - (true, false, true) => throw(Error_not_implemented("sc.aq")), - (true, true , true) => MemValue(MEMea_conditional_strong_release(addr, width)) - } -} - -// only used for actual memory regions, to avoid MMIO effects -function phys_mem_write forall 'n. (addr : xlenbits, width : atom('n), data: bits(8 * 'n)) -> MemoryOpResult(bool) = { - print_mem("mem[" ^ BitStr(addr) ^ "] <- " ^ BitStr(data)); - MemValue(__RISCV_write(addr, width, data)) -} - -// dispatches to MMIO regions or physical memory regions depending on physical memory map -function checked_mem_write forall 'n, 'n > 0. (addr : xlenbits, width : atom('n), data: bits(8 * 'n)) -> MemoryOpResult(bool) = - if within_mmio_writable(addr, width) - then mmio_write(addr, width, data) - else if within_phys_mem(addr, width) - then phys_mem_write(addr, width, data) - else MemException(E_SAMO_Access_Fault) - -/* Atomic accesses can be done to MMIO regions, e.g. in kernel access to device registers. */ - -val MEMval : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} -val MEMval_release : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} -val MEMval_strong_release : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} -val MEMval_conditional : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} -val MEMval_conditional_release : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} -val MEMval_conditional_strong_release : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wmv, rreg, wreg} - -function MEMval (addr, width, data) = checked_mem_write(addr, width, data) -function MEMval_release (addr, width, data) = checked_mem_write(addr, width, data) -function MEMval_strong_release (addr, width, data) = checked_mem_write(addr, width, data) -function MEMval_conditional (addr, width, data) = checked_mem_write(addr, width, data) -function MEMval_conditional_release (addr, width, data) = checked_mem_write(addr, width, data) -function MEMval_conditional_strong_release (addr, width, data) = checked_mem_write(addr, width, data) - - -$ifdef RVFI_DII -val rvfi_write : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> unit effect {wreg} -function rvfi_write (addr, width, value) = { - rvfi_exec->rvfi_mem_addr() = addr; - if width <= 8 then { - rvfi_exec->rvfi_mem_wdata() = zero_extend(value,64); - rvfi_exec->rvfi_mem_wmask() = to_bits(8,width); - } -} -$else -val rvfi_write : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n)) -> unit -function rvfi_write (addr, width, value) = () -$endif - -/* NOTE: The wreg effect is due to MMIO, the rreg is due to checking mtime. */ -val mem_write_value : forall 'n, 'n > 0. (xlenbits, atom('n), bits(8 * 'n), bool, bool, bool) -> MemoryOpResult(bool) effect {wmv, rreg, wreg, escape} - -function mem_write_value (addr, width, value, aq, rl, con) = { - rvfi_write(addr, width, value); - if (rl | con) & (~ (is_aligned_addr(addr, width))) - then MemException(E_SAMO_Addr_Align) - else match (aq, rl, con) { - (false, false, false) => checked_mem_write(addr, width, value), - (false, true, false) => MEMval_release(addr, width, value), - (false, false, true) => MEMval_conditional(addr, width, value), - (false, true, true) => MEMval_conditional_release(addr, width, value), - (true, false, false) => throw(Error_not_implemented("store.aq")), - (true, true, false) => MEMval_strong_release(addr, width, value), - (true, false, true) => throw(Error_not_implemented("sc.aq")), - (true, true, true) => MEMval_conditional_strong_release(addr, width, value) - } -} - -val MEM_fence_rw_rw = {lem: "MEM_fence_rw_rw", coq: "MEM_fence_rw_rw", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_r_rw = {lem: "MEM_fence_r_rw", coq: "MEM_fence_r_rw", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_r_r = {lem: "MEM_fence_r_r", coq: "MEM_fence_r_r", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_rw_w = {lem: "MEM_fence_rw_w", coq: "MEM_fence_rw_w", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_w_w = {lem: "MEM_fence_w_w", coq: "MEM_fence_w_w", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_w_rw = {lem: "MEM_fence_w_rw", coq: "MEM_fence_w_rw", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_rw_r = {lem: "MEM_fence_rw_r", coq: "MEM_fence_rw_r", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_r_w = {lem: "MEM_fence_r_w", coq: "MEM_fence_r_w", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_w_r = {lem: "MEM_fence_w_r", coq: "MEM_fence_w_r", _: "skip"} : unit -> unit effect {barr} -val MEM_fence_i = {lem: "MEM_fence_i", coq: "MEM_fence_i", _: "skip"} : unit -> unit effect {barr} diff --git a/riscv/riscv_platform.c b/riscv/riscv_platform.c deleted file mode 100644 index f0aff76a..00000000 --- a/riscv/riscv_platform.c +++ /dev/null @@ -1,71 +0,0 @@ -#include "sail.h" -#include "rts.h" -#include "riscv_prelude.h" -#include "riscv_platform_impl.h" - -/* This file contains the definitions of the C externs of Sail model. */ - -static mach_bits reservation = 0; -static bool reservation_valid = false; - -bool plat_enable_dirty_update(unit u) -{ return rv_enable_dirty_update; } - -bool plat_enable_misaligned_access(unit u) -{ return rv_enable_misaligned; } - -bool plat_mtval_has_illegal_inst_bits(unit u) -{ return rv_mtval_has_illegal_inst_bits; } - -mach_bits plat_ram_base(unit u) -{ return rv_ram_base; } - -mach_bits plat_ram_size(unit u) -{ return rv_ram_size; } - -mach_bits plat_rom_base(unit u) -{ return rv_rom_base; } - -mach_bits plat_rom_size(unit u) -{ return rv_rom_size; } - -mach_bits plat_clint_base(unit u) -{ return rv_clint_base; } - -mach_bits plat_clint_size(unit u) -{ return rv_clint_size; } - -unit load_reservation(mach_bits addr) -{ - reservation = addr; - reservation_valid = true; - return UNIT; -} - -bool match_reservation(mach_bits addr) -{ return reservation_valid && reservation == addr; } - -unit cancel_reservation(unit u) -{ - reservation_valid = false; - return UNIT; -} - -unit plat_term_write(mach_bits s) -{ char c = s & 0xff; - plat_term_write_impl(c); - return UNIT; -} - -void plat_insns_per_tick(sail_int *rop, unit u) -{ } - -mach_bits plat_htif_tohost(unit u) -{ - return rv_htif_tohost; -} - -unit memea(mach_bits len, sail_int n) -{ - return UNIT; -} diff --git a/riscv/riscv_platform.h b/riscv/riscv_platform.h deleted file mode 100644 index 93782660..00000000 --- a/riscv/riscv_platform.h +++ /dev/null @@ -1,28 +0,0 @@ -#pragma once -#include "sail.h" - -bool plat_enable_dirty_update(unit); -bool plat_enable_misaligned_access(unit); -bool plat_mtval_has_illegal_inst_bits(unit); - -mach_bits plat_ram_base(unit); -mach_bits plat_ram_size(unit); -bool within_phys_mem(mach_bits, sail_int); - -mach_bits plat_rom_base(unit); -mach_bits plat_rom_size(unit); - -mach_bits plat_clint_base(unit); -mach_bits plat_clint_size(unit); - -unit load_reservation(mach_bits); -bool match_reservation(mach_bits); -unit cancel_reservation(unit); - -void plat_insns_per_tick(sail_int *rop, unit); - -unit plat_term_write(mach_bits); -mach_bits plat_htif_tohost(unit); - -unit memea(mach_bits, sail_int); - diff --git a/riscv/riscv_platform.sail b/riscv/riscv_platform.sail deleted file mode 100644 index aee72e47..00000000 --- a/riscv/riscv_platform.sail +++ /dev/null @@ -1,295 +0,0 @@ -/* Platform-specific definitions, and basic MMIO devices. */ - -/* Current constraints on this implementation are: - - it cannot access memory directly, but instead provides definitions for the physical memory model - - it can access system register state, needed to manipulate interrupt bits - - it relies on externs to get platform address information and doesn't hardcode them. -*/ - -/* Main memory */ -val plat_ram_base = {c: "plat_ram_base", ocaml: "Platform.dram_base", lem: "plat_ram_base"} : unit -> xlenbits -val plat_ram_size = {c: "plat_ram_size", ocaml: "Platform.dram_size", lem: "plat_ram_size"} : unit -> xlenbits - -/* whether the MMU should update dirty bits in PTEs */ -val plat_enable_dirty_update = {ocaml: "Platform.enable_dirty_update", - c: "plat_enable_dirty_update", - lem: "plat_enable_dirty_update"} : unit -> bool - -/* whether the platform supports misaligned accesses without trapping to M-mode. if false, - * misaligned loads/stores are trapped to Machine mode. - */ -val plat_enable_misaligned_access = {ocaml: "Platform.enable_misaligned_access", - c: "plat_enable_misaligned_access", - lem: "plat_enable_misaligned_access"} : unit -> bool - -/* whether mtval stores the bits of a faulting instruction on illegal instruction exceptions */ -val plat_mtval_has_illegal_inst_bits = {ocaml: "Platform.mtval_has_illegal_inst_bits", - c: "plat_mtval_has_illegal_inst_bits", - lem: "plat_mtval_has_illegal_inst_bits"} : unit -> bool - -/* ROM holding reset vector and device-tree DTB */ -val plat_rom_base = {ocaml: "Platform.rom_base", c: "plat_rom_base", lem: "plat_rom_base"} : unit -> xlenbits -val plat_rom_size = {ocaml: "Platform.rom_size", c: "plat_rom_size", lem: "plat_rom_size"} : unit -> xlenbits - -/* Location of clock-interface, which should match with the spec in the DTB */ -val plat_clint_base = {ocaml: "Platform.clint_base", c: "plat_clint_base", lem: "plat_clint_base"} : unit -> xlenbits -val plat_clint_size = {ocaml: "Platform.clint_size", c: "plat_clint_size", lem: "plat_clint_size"} : unit -> xlenbits - -/* Location of HTIF ports */ -val plat_htif_tohost = {ocaml: "Platform.htif_tohost", c: "plat_htif_tohost", lem: "plat_htif_tohost"} : unit -> xlenbits -// todo: fromhost - -val phys_mem_segments : unit -> list((xlenbits, xlenbits)) -function phys_mem_segments() = - (plat_rom_base (), plat_rom_size ()) :: - (plat_ram_base (), plat_ram_size ()) :: - [||] - -/* Physical memory map predicates */ - -function within_phys_mem forall 'n. (addr : xlenbits, width : atom('n)) -> bool = { - let ram_base = plat_ram_base (); - let rom_base = plat_rom_base (); - let ram_size = plat_ram_size (); - let rom_size = plat_rom_size (); - - /* todo: iterate over segment list */ - if ( ram_base <=_u addr - & (addr + sizeof('n)) <=_u (ram_base + ram_size)) - then true - else if ( rom_base <=_u addr - & (addr + sizeof('n)) <=_u (rom_base + rom_size)) - then true - else { - print_platform("within_phys_mem: " ^ BitStr(addr) ^ " not within phys-mem:"); - print_platform(" plat_rom_base: " ^ BitStr(rom_base)); - print_platform(" plat_rom_size: " ^ BitStr(rom_size)); - print_platform(" plat_ram_base: " ^ BitStr(ram_base)); - print_platform(" plat_ram_size: " ^ BitStr(ram_size)); - false - } -} - -function within_clint forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - plat_clint_base() <=_u addr - & (addr + sizeof('n)) <=_u (plat_clint_base() + plat_clint_size()) - -function within_htif_writable forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - plat_htif_tohost() == addr - -function within_htif_readable forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - plat_htif_tohost() == addr - -/* CLINT (Core Local Interruptor), based on Spike. */ - -val plat_insns_per_tick = {ocaml: "Platform.insns_per_tick", c: "plat_insns_per_tick", lem: "plat_insns_per_tick"} : unit -> int - -// assumes a single hart, since this typically is a vector of per-hart registers. -register mtimecmp : xlenbits // memory-mapped internal clint register. - -/* CLINT memory-mapped IO */ - -/* relative address map: - * - * 0000 msip hart 0 -- memory-mapped software interrupt - * 0004 msip hart 1 - * 4000 mtimecmp hart 0 lo -- memory-mapped timer thresholds - * 4004 mtimecmp hart 0 hi - * 4008 mtimecmp hart 1 lo - * 400c mtimecmp hart 1 hi - * bff8 mtime lo -- memory-mapped clocktimer value - * bffc mtime hi - */ - -let MSIP_BASE : xlenbits = 0x0000000000000000 -let MTIMECMP_BASE : xlenbits = 0x0000000000004000 -let MTIME_BASE : xlenbits = 0x000000000000bff8 - -val clint_load : forall 'n, 'n > 0. (xlenbits, int('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rreg} -function clint_load(addr, width) = { - let addr = addr - plat_clint_base (); - /* FIXME: For now, only allow exact aligned access. */ - if addr == MSIP_BASE & ('n == 8 | 'n == 4) - then { - print_platform("clint[" ^ BitStr(addr) ^ "] -> " ^ BitStr(mip.MSI())); - MemValue(zero_extend_type_hack(mip.MSI(), sizeof(8 * 'n))) - } - else if addr == MTIMECMP_BASE & ('n == 8) - then { - print_platform("clint[" ^ BitStr(addr) ^ "] -> " ^ BitStr(mtimecmp)); - MemValue(zero_extend_type_hack(mtimecmp, 64)) /* FIXME: Redundant zero_extend currently required by Lem backend */ - } - else if addr == MTIME_BASE & ('n == 8) - then { - print_platform("clint[" ^ BitStr(addr) ^ "] -> " ^ BitStr(mtime)); - MemValue(zero_extend_type_hack(mtime, 64)) - } - else { - print_platform("clint[" ^ BitStr(addr) ^ "] -> <not-mapped>"); - MemException(E_Load_Access_Fault) - } -} - -function clint_dispatch() -> unit = { - print_platform("clint::tick mtime <- " ^ BitStr(mtime)); - mip->MTI() = false; - if mtimecmp <=_u mtime then { - print_platform(" clint timer pending at mtime " ^ BitStr(mtime)); - mip->MTI() = true - } -} - -/* The rreg effect is due to checking mtime. */ -val clint_store: forall 'n, 'n > 0. (xlenbits, int('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {rreg,wreg} -function clint_store(addr, width, data) = { - let addr = addr - plat_clint_base (); - if addr == MSIP_BASE & ('n == 8 | 'n == 4) then { - print_platform("clint[" ^ BitStr(addr) ^ "] <- " ^ BitStr(data) ^ " (mip.MSI <- " ^ BitStr(data[0]) ^ ")"); - mip->MSI() = data[0] == 0b1; - clint_dispatch(); - MemValue(true) - } else if addr == MTIMECMP_BASE & 'n == 8 then { - print_platform("clint[" ^ BitStr(addr) ^ "] <- " ^ BitStr(data) ^ " (mtimecmp)"); - mtimecmp = zero_extend(data, 64); /* FIXME: Redundant zero_extend currently required by Lem backend */ - clint_dispatch(); - MemValue(true) - } else { - print_platform("clint[" ^ BitStr(addr) ^ "] <- " ^ BitStr(data) ^ " (<unmapped>)"); - MemException(E_SAMO_Access_Fault) - } -} - -val tick_clock : unit -> unit effect {rreg, wreg} -function tick_clock() = { - mcycle = mcycle + 1; - mtime = mtime + 1; - clint_dispatch() -} - -/* Basic terminal character I/O. */ - -val plat_term_write = {ocaml: "Platform.term_write", c: "plat_term_write", lem: "plat_term_write"} : bits(8) -> unit -val plat_term_read = {ocaml: "Platform.term_read", c: "plat_term_read", lem: "plat_term_read"} : unit -> bits(8) - -/* Spike's HTIF device interface, which multiplexes the above MMIO devices. */ - -bitfield htif_cmd : bits(64) = { - device : 63 .. 56, - cmd : 55 .. 48, - payload : 47 .. 0 -} - -register htif_tohost : xlenbits -register htif_done : bool -register htif_exit_code : xlenbits - - -/* Since the htif tohost port is only available at a single address, - * we'll assume here that physical memory model has correctly - * dispatched the address. - */ - -val htif_load : forall 'n, 'n > 0. (xlenbits, int('n)) -> MemoryOpResult(bits(8 * 'n)) effect {rreg} -function htif_load(addr, width) = { - print_platform("htif[" ^ BitStr(addr) ^ "] -> " ^ BitStr(htif_tohost)); - /* FIXME: For now, only allow the expected access widths. */ - if width == 8 - then MemValue(zero_extend_type_hack(htif_tohost, 64)) /* FIXME: Redundant zero_extend currently required by Lem backend */ - else MemException(E_Load_Access_Fault) -} - -/* The wreg effect is an artifact of using 'register' to implement device state. */ -val htif_store: forall 'n, 0 < 'n <= 8. (xlenbits, int('n), bits(8 * 'n)) -> MemoryOpResult(bool) effect {wreg} -function htif_store(addr, width, data) = { - print_platform("htif[" ^ BitStr(addr) ^ "] <- " ^ BitStr(data)); - /* Store the written value so that we can ack it later. */ - let cbits : xlenbits = EXTZ(data); - htif_tohost = cbits; - /* Process the cmd immediately; this is needed for terminal output. */ - let cmd = Mk_htif_cmd(cbits); - match cmd.device() { - 0x00 => { /* syscall-proxy */ - print_platform("htif-syscall-proxy cmd: " ^ BitStr(cmd.payload())); - if cmd.payload()[0] == 0b1 - then { - htif_done = true; - htif_exit_code = (zero_extend(cmd.payload(), xlen) >> 0b01) : xlenbits - } - else () - }, - 0x01 => { /* terminal */ - print_platform("htif-term cmd: " ^ BitStr(cmd.payload())); - match cmd.cmd() { - 0x00 => /* TODO: terminal input handling */ (), - 0x01 => plat_term_write(cmd.payload()[7..0]), - c => print("Unknown term cmd: " ^ BitStr(c)) - } - }, - d => print("htif-???? cmd: " ^ BitStr(data)) - }; - MemValue(true) -} - -val htif_tick : unit -> unit effect {rreg, wreg} -function htif_tick() = { - print_platform("htif::tick " ^ BitStr(htif_tohost)); - htif_tohost = EXTZ(0b0) /* htif ack */ -} - -/* Top-level MMIO dispatch */ - -function within_mmio_readable forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - within_clint(addr, width) | (within_htif_readable(addr, width) & 1 <= 'n) - -function within_mmio_writable forall 'n. (addr : xlenbits, width : atom('n)) -> bool = - within_clint(addr, width) | (within_htif_writable(addr, width) & 'n <= 8) - -function mmio_read forall 'n, 'n > 0. (addr : xlenbits, width : atom('n)) -> MemoryOpResult(bits(8 * 'n)) = - if within_clint(addr, width) - then clint_load(addr, width) - else if within_htif_readable(addr, width) & (1 <= 'n) - then htif_load(addr, width) - else MemException(E_Load_Access_Fault) - -function mmio_write forall 'n, 'n > 0. (addr : xlenbits, width : atom('n), data: bits(8 * 'n)) -> MemoryOpResult(bool) = - if within_clint(addr, width) - then clint_store(addr, width, data) - else if within_htif_writable(addr, width) & 'n <= 8 - then htif_store(addr, width, data) - else MemException(E_SAMO_Access_Fault) - -/* Platform initialization and ticking. */ - -function init_platform() -> unit = { - htif_tohost = EXTZ(0b0); - htif_done = false; - htif_exit_code = EXTZ(0b0) -} - -function tick_platform() -> unit = { - cancel_reservation(); - htif_tick(); -} - -/* Platform-specific handling of instruction faults */ - -function handle_illegal() -> unit = { - let info = if plat_mtval_has_illegal_inst_bits () - then Some(instbits) - else None(); - let t : sync_exception = struct { trap = E_Illegal_Instr, - excinfo = info }; - nextPC = handle_exception(cur_privilege, CTL_TRAP(t), PC) -} - -/* Platform-specific wait-for-interrupt */ - -function platform_wfi() -> unit = { - /* speed execution by getting the timer to fire at the next instruction, - * since we currently don't have any other devices raising interrupts. - */ - if mtime <_u mtimecmp then { - mtime = mtimecmp; - mcycle = mtimecmp; - } -}
\ No newline at end of file diff --git a/riscv/riscv_platform_impl.c b/riscv/riscv_platform_impl.c deleted file mode 100644 index 04a661c0..00000000 --- a/riscv/riscv_platform_impl.c +++ /dev/null @@ -1,29 +0,0 @@ -#include "riscv_platform_impl.h" -#include <unistd.h> -#include <stdio.h> - -/* Settings of the platform implementation, with common defaults. */ - -bool rv_enable_dirty_update = false; -bool rv_enable_misaligned = false; -bool rv_mtval_has_illegal_inst_bits = false; - -uint64_t rv_ram_base = UINT64_C(0x80000000); -uint64_t rv_ram_size = UINT64_C(0x80000000); - -uint64_t rv_rom_base = UINT64_C(0x1000); -uint64_t rv_rom_size = UINT64_C(0x100); - -uint64_t rv_clint_base = UINT64_C(0x2000000); -uint64_t rv_clint_size = UINT64_C(0xc0000); - -uint64_t rv_htif_tohost = UINT64_C(0x80001000); -uint64_t rv_insns_per_tick = UINT64_C(100); - -int term_fd = 1; // set during startup -void plat_term_write_impl(char c) -{ - if (write(term_fd, &c, sizeof(c)) < 0) { - fprintf(stderr, "Unable to write to terminal!\n"); - } -} diff --git a/riscv/riscv_platform_impl.h b/riscv/riscv_platform_impl.h deleted file mode 100644 index 85e25c95..00000000 --- a/riscv/riscv_platform_impl.h +++ /dev/null @@ -1,28 +0,0 @@ -#pragma once - -#include <stdbool.h> -#include <stdint.h> - -/* Settings of the platform implementation. */ - -#define DEFAULT_RSTVEC 0x00001000 -#define SAIL_XLEN 64 - -extern bool rv_enable_dirty_update; -extern bool rv_enable_misaligned; -extern bool rv_mtval_has_illegal_inst_bits; - -extern uint64_t rv_ram_base; -extern uint64_t rv_ram_size; - -extern uint64_t rv_rom_base; -extern uint64_t rv_rom_size; - -extern uint64_t rv_clint_base; -extern uint64_t rv_clint_size; - -extern uint64_t rv_htif_tohost; -extern uint64_t rv_insns_per_tick; - -extern int term_fd; -void plat_term_write_impl(char c); diff --git a/riscv/riscv_prelude.c b/riscv/riscv_prelude.c deleted file mode 100644 index 16219137..00000000 --- a/riscv/riscv_prelude.c +++ /dev/null @@ -1,32 +0,0 @@ -#include "riscv_prelude.h" -#include "riscv_config.h" - -unit print_string(sail_string prefix, sail_string msg) -{ - printf("%s%s\n", prefix, msg); - return UNIT; -} - -unit print_instr(sail_string s) -{ - if (config_print_instr) printf("%s\n", s); - return UNIT; -} - -unit print_reg(sail_string s) -{ - if (config_print_reg) printf("%s\n", s); - return UNIT; -} - -unit print_mem_access(sail_string s) -{ - if (config_print_mem_access) printf("%s\n", s); - return UNIT; -} - -unit print_platform(sail_string s) -{ - if (config_print_platform) printf("%s\n", s); - return UNIT; -} diff --git a/riscv/riscv_prelude.h b/riscv/riscv_prelude.h deleted file mode 100644 index a296c7e9..00000000 --- a/riscv/riscv_prelude.h +++ /dev/null @@ -1,10 +0,0 @@ -#pragma once -#include "sail.h" -#include "rts.h" - -unit print_string(sail_string prefix, sail_string msg); - -unit print_instr(sail_string s); -unit print_reg(sail_string s); -unit print_mem_access(sail_string s); -unit print_platform(sail_string s); diff --git a/riscv/riscv_sail.h b/riscv/riscv_sail.h deleted file mode 100644 index 424b64b0..00000000 --- a/riscv/riscv_sail.h +++ /dev/null @@ -1,54 +0,0 @@ -/* Top-level interfaces to the Sail model. - Ideally, this would be autogenerated. - */ - -typedef int unit; -#define UNIT 0 -typedef uint64_t mach_bits; - -struct zMisa {mach_bits zMisa_chunk_0;}; -struct zMisa zmisa; - -void model_init(void); -void model_fini(void); - -unit zinit_platform(unit); -unit zinit_sys(unit); -bool zstep(sail_int); -unit ztick_clock(unit); -unit ztick_platform(unit); -unit z_set_Misa_C(struct zMisa*, mach_bits); - -#ifdef RVFI_DII -unit zrvfi_set_instr_packet(mach_bits); -mach_bits zrvfi_get_cmd(unit); -bool zrvfi_step(sail_int); -unit zrvfi_zzero_exec_packet(unit); -unit zrvfi_halt_exec_packet(unit); -void zrvfi_get_exec_packet(sail_bits *rop, unit); -#endif - -extern bool zhtif_done; -extern mach_bits zhtif_exit_code; -extern bool have_exception; - -/* machine state */ - -extern uint32_t zcur_privilege; - -extern mach_bits zPC; - -extern mach_bits - zx1, zx2, zx3, zx4, zx5, zx6, zx7, - zx8, zx9, zx10, zx11, zx12, zx13, zx14, zx15, - zx16, zx17, zx18, zx19, zx20, zx21, zx22, zx23, - zx24, zx25, zx26, zx27, zx28, zx29, zx30, zx31; - -extern mach_bits zmstatus; -extern mach_bits zmepc, zmtval; -extern mach_bits zsepc, zstval; - -struct zMcause {mach_bits zMcause_chunk_0;}; -struct zMcause zmcause, zscause; - -extern mach_bits zminstret; diff --git a/riscv/riscv_sim.c b/riscv/riscv_sim.c deleted file mode 100644 index d86a197d..00000000 --- a/riscv/riscv_sim.c +++ /dev/null @@ -1,680 +0,0 @@ -#include <getopt.h> -#include <stdio.h> -#include <stdlib.h> -#include <errno.h> -#include <unistd.h> -#include <sys/types.h> -#include <sys/stat.h> -#include <sys/mman.h> -#include <sys/socket.h> -#include <netinet/ip.h> -#include <fcntl.h> - -#include "elf.h" -#include "sail.h" -#include "rts.h" -#include "riscv_platform.h" -#include "riscv_platform_impl.h" -#include "riscv_sail.h" - -#ifdef ENABLE_SPIKE -#include "tv_spike_intf.h" -#else -struct tv_spike_t; -#endif - -/* Selected CSRs from riscv-isa-sim/riscv/encoding.h */ -#define CSR_STVEC 0x105 -#define CSR_SEPC 0x141 -#define CSR_SCAUSE 0x142 -#define CSR_STVAL 0x143 - -#define CSR_MSTATUS 0x300 -#define CSR_MISA 0x301 -#define CSR_MEDELEG 0x302 -#define CSR_MIDELEG 0x303 -#define CSR_MIE 0x304 -#define CSR_MTVEC 0x305 -#define CSR_MEPC 0x341 -#define CSR_MCAUSE 0x342 -#define CSR_MTVAL 0x343 -#define CSR_MIP 0x344 - -static bool do_dump_dts = false; -static bool disable_compressed = false; -struct tv_spike_t *s = NULL; -char *term_log = NULL; -char *dtb_file = NULL; -unsigned char *dtb = NULL; -size_t dtb_len = 0; -#ifdef RVFI_DII -static bool rvfi_dii = false; -static int rvfi_dii_port; -static int rvfi_dii_sock; -#endif - -unsigned char *spike_dtb = NULL; -size_t spike_dtb_len = 0; - -bool config_print_instr = true; -bool config_print_reg = true; -bool config_print_mem_access = true; -bool config_print_platform = true; - -static struct option options[] = { - {"enable-dirty", no_argument, 0, 'd'}, - {"enable-misaligned", no_argument, 0, 'm'}, - {"ram-size", required_argument, 0, 'z'}, - {"disable-compressed", no_argument, 0, 'C'}, - {"mtval-has-illegal-inst-bits", no_argument, 0, 'i'}, - {"dump-dts", no_argument, 0, 's'}, - {"device-tree-blob", required_argument, 0, 'b'}, - {"terminal-log", required_argument, 0, 't'}, -#ifdef RVFI_DII - {"rvfi-dii", required_argument, 0, 'r'}, -#endif - {"help", no_argument, 0, 'h'}, - {0, 0, 0, 0} -}; - -static void print_usage(const char *argv0, int ec) -{ -#ifdef RVFI_DII - fprintf(stdout, "Usage: %s [options] <elf_file>\n %s [options] -r <port>\n", argv0, argv0); -#else - fprintf(stdout, "Usage: %s [options] <elf_file>\n", argv0); -#endif - struct option *opt = options; - while (opt->name) { - fprintf(stdout, "\t -%c\t %s\n", (char)opt->val, opt->name); - opt++; - } - exit(ec); -} - -static void dump_dts(void) -{ -#ifdef ENABLE_SPIKE - size_t dts_len = 0; - struct tv_spike_t *s = tv_init("RV64IMAC", rv_ram_size, 0); - tv_get_dts(s, NULL, &dts_len); - if (dts_len > 0) { - unsigned char *dts = (unsigned char *)malloc(dts_len + 1); - dts[dts_len] = '\0'; - tv_get_dts(s, dts, &dts_len); - fprintf(stdout, "%s\n", dts); - } -#else - fprintf(stdout, "Spike linkage is currently needed to generate DTS.\n"); -#endif - exit(0); -} - -static void read_dtb(const char *path) -{ - int fd = open(path, O_RDONLY); - if (fd < 0) { - fprintf(stderr, "Unable to read DTB file %s: %s\n", path, strerror(errno)); - exit(1); - } - struct stat st; - if (fstat(fd, &st) < 0) { - fprintf(stderr, "Unable to stat DTB file %s: %s\n", path, strerror(errno)); - exit(1); - } - char *m = (char *)mmap(NULL, st.st_size, PROT_READ, MAP_PRIVATE, fd, 0); - if (m == MAP_FAILED) { - fprintf(stderr, "Unable to map DTB file %s: %s\n", path, strerror(errno)); - exit(1); - } - dtb = (unsigned char *)malloc(st.st_size); - if (dtb == NULL) { - fprintf(stderr, "Cannot allocate DTB from file %s!\n", path); - exit(1); - } - memcpy(dtb, m, st.st_size); - dtb_len = st.st_size; - munmap(m, st.st_size); - close(fd); - - fprintf(stdout, "Read %ld bytes of DTB from %s.\n", dtb_len, path); -} - -char *process_args(int argc, char **argv) -{ - int c, idx = 1; - uint64_t ram_size = 0; - while(true) { - c = getopt_long(argc, argv, "dmCsz:b:t:v:hr:", options, &idx); - if (c == -1) break; - switch (c) { - case 'd': - fprintf(stderr, "enabling dirty update.\n"); - rv_enable_dirty_update = true; - break; - case 'm': - fprintf(stderr, "enabling misaligned access.\n"); - rv_enable_misaligned = true; - break; - case 'C': - disable_compressed = true; - break; - case 'i': - rv_mtval_has_illegal_inst_bits = true; - case 's': - do_dump_dts = true; - break; - case 'z': - ram_size = atol(optarg); - if (ram_size) { - fprintf(stderr, "setting ram-size to %ld MB\n", ram_size); - rv_ram_size = ram_size << 20; - } - break; - case 'b': - dtb_file = strdup(optarg); - break; - case 't': - term_log = strdup(optarg); - break; - case 'h': - print_usage(argv[0], 0); - break; -#ifdef RVFI_DII - case 'r': - rvfi_dii = true; - rvfi_dii_port = atoi(optarg); - break; -#endif - default: - fprintf(stderr, "Unrecognized optchar %c\n", c); - print_usage(argv[0], 1); - } - } - if (do_dump_dts) dump_dts(); -#ifdef RVFI_DII - if (idx > argc || (idx == argc && !rvfi_dii)) print_usage(argv[0], 0); -#else - if (idx >= argc) print_usage(argv[0], 0); -#endif - if (term_log == NULL) term_log = strdup("term.log"); - if (dtb_file) read_dtb(dtb_file); - -#ifdef RVFI_DII - if (!rvfi_dii) -#endif - fprintf(stdout, "Running file %s.\n", argv[optind]); - return argv[optind]; -} - -uint64_t load_sail(char *f) -{ - bool is32bit; - uint64_t entry; - load_elf(f, &is32bit, &entry); - if (is32bit) { - fprintf(stderr, "32-bit RISC-V not yet supported.\n"); - exit(1); - } - fprintf(stdout, "ELF Entry @ %lx\n", entry); - /* locate htif ports */ - if (lookup_sym(f, "tohost", &rv_htif_tohost) < 0) { - fprintf(stderr, "Unable to locate htif tohost port.\n"); - exit(1); - } - fprintf(stderr, "tohost located at %0" PRIx64 "\n", rv_htif_tohost); - return entry; -} - -void init_spike(const char *f, uint64_t entry, uint64_t ram_size) -{ -#ifdef ENABLE_SPIKE - bool mismatch = false; - s = tv_init("RV64IMAC", ram_size, 1); - if (tv_is_dirty_enabled(s) != rv_enable_dirty_update) { - mismatch = true; - fprintf(stderr, "inconsistent enable-dirty-update setting: spike %s, sail %s\n", - tv_is_dirty_enabled(s) ? "on" : "off", - rv_enable_dirty_update ? "on" : "off"); - } - if (tv_is_misaligned_enabled(s) != rv_enable_misaligned) { - mismatch = true; - fprintf(stderr, "inconsistent enable-misaligned-access setting: spike %s, sail %s\n", - tv_is_misaligned_enabled(s) ? "on" : "off", - rv_enable_misaligned ? "on" : "off"); - } - if (tv_ram_size(s) != rv_ram_size) { - mismatch = true; - fprintf(stderr, "inconsistent ram-size setting: spike %lx, sail %lx\n", - tv_ram_size(s), rv_ram_size); - } - if (mismatch) exit(1); - - /* The initialization order below matters. */ - tv_set_verbose(s, 1); - tv_set_dtb_in_rom(s, 1); - tv_load_elf(s, f); - tv_reset(s); - - /* sync the insns per tick */ - rv_insns_per_tick = tv_get_insns_per_tick(s); - - /* get DTB from spike */ - tv_get_dtb(s, NULL, &spike_dtb_len); - if (spike_dtb_len > 0) { - spike_dtb = (unsigned char *)malloc(spike_dtb_len + 1); - spike_dtb[spike_dtb_len] = '\0'; - if (!tv_get_dtb(s, spike_dtb, &spike_dtb_len)) { - fprintf(stderr, "Got %ld bytes of dtb at %p\n", spike_dtb_len, spike_dtb); - } else { - fprintf(stderr, "Error getting DTB from Spike.\n"); - exit(1); - } - } else { - fprintf(stderr, "No DTB available from Spike.\n"); - } -#else - s = NULL; -#endif -} - -void tick_spike() -{ -#ifdef ENABLE_SPIKE - tv_tick_clock(s); - tv_step_io(s); -#endif -} - -void init_sail_reset_vector(uint64_t entry) -{ -#define RST_VEC_SIZE 8 - uint32_t reset_vec[RST_VEC_SIZE] = { - 0x297, // auipc t0,0x0 - 0x28593 + (RST_VEC_SIZE * 4 << 20), // addi a1, t0, &dtb - 0xf1402573, // csrr a0, mhartid - SAIL_XLEN == 32 ? - 0x0182a283u : // lw t0,24(t0) - 0x0182b283u, // ld t0,24(t0) - 0x28067, // jr t0 - 0, - (uint32_t) (entry & 0xffffffff), - (uint32_t) (entry >> 32) - }; - - rv_rom_base = DEFAULT_RSTVEC; - uint64_t addr = rv_rom_base; - for (int i = 0; i < sizeof(reset_vec); i++) - write_mem(addr++, (uint64_t)((char *)reset_vec)[i]); - - if (dtb && dtb_len) { - for (size_t i = 0; i < dtb_len; i++) - write_mem(addr++, dtb[i]); - } - -#ifdef ENABLE_SPIKE - if (dtb && dtb_len) { - // Ensure that Spike's DTB matches the one provided. - bool matched = dtb_len == spike_dtb_len; - if (matched) { - for (size_t i = 0; i < dtb_len; i++) - matched = matched && (dtb[i] == spike_dtb[i]); - } - if (!matched) { - fprintf(stderr, "Provided DTB does not match Spike's!\n"); - exit(1); - } - } else { - if (spike_dtb_len > 0) { - // Use the DTB from Spike. - for (size_t i = 0; i < spike_dtb_len; i++) - write_mem(addr++, spike_dtb[i]); - } else { - fprintf(stderr, "Running without rom device tree.\n"); - } - } -#endif - - /* zero-fill to page boundary */ - const int align = 0x1000; - uint64_t rom_end = (addr + align -1)/align * align; - for (int i = addr; i < rom_end; i++) - write_mem(addr++, 0); - - /* set rom size */ - rv_rom_size = rom_end - rv_rom_base; - /* boot at reset vector */ - zPC = rv_rom_base; -} - -void init_sail(uint64_t elf_entry) -{ - model_init(); - zinit_platform(UNIT); - zinit_sys(UNIT); -#ifdef RVFI_DII - if (rvfi_dii) { - rv_ram_base = UINT64_C(0x80000000); - rv_ram_size = UINT64_C(0x10000); - rv_rom_base = UINT64_C(0); - rv_rom_size = UINT64_C(0); - zPC = elf_entry; - } else -#endif - init_sail_reset_vector(elf_entry); - if (disable_compressed) - z_set_Misa_C(&zmisa, 0); -} - -int init_check(struct tv_spike_t *s) -{ - int passed = 1; -#ifdef ENABLE_SPIKE - passed &= tv_check_csr(s, CSR_MISA, zmisa.zMisa_chunk_0); -#endif - return passed; -} - -void finish(int ec) -{ - model_fini(); -#ifdef ENABLE_SPIKE - tv_free(s); -#endif - exit(ec); -} - -int compare_states(struct tv_spike_t *s) -{ - int passed = 1; - -#ifdef ENABLE_SPIKE -#define TV_CHECK(reg, spike_reg, sail_reg) \ - passed &= tv_check_ ## reg(s, spike_reg, sail_reg); - - // fix default C enum map for cur_privilege - uint8_t priv = (zcur_privilege == 2) ? 3 : zcur_privilege; - passed &= tv_check_priv(s, priv); - - passed &= tv_check_pc(s, zPC); - - TV_CHECK(gpr, 1, zx1); - TV_CHECK(gpr, 2, zx2); - TV_CHECK(gpr, 3, zx3); - TV_CHECK(gpr, 4, zx4); - TV_CHECK(gpr, 5, zx5); - TV_CHECK(gpr, 6, zx6); - TV_CHECK(gpr, 7, zx7); - TV_CHECK(gpr, 8, zx8); - TV_CHECK(gpr, 9, zx9); - TV_CHECK(gpr, 10, zx10); - TV_CHECK(gpr, 11, zx11); - TV_CHECK(gpr, 12, zx12); - TV_CHECK(gpr, 13, zx13); - TV_CHECK(gpr, 14, zx14); - TV_CHECK(gpr, 15, zx15); - TV_CHECK(gpr, 15, zx15); - TV_CHECK(gpr, 16, zx16); - TV_CHECK(gpr, 17, zx17); - TV_CHECK(gpr, 18, zx18); - TV_CHECK(gpr, 19, zx19); - TV_CHECK(gpr, 20, zx20); - TV_CHECK(gpr, 21, zx21); - TV_CHECK(gpr, 22, zx22); - TV_CHECK(gpr, 23, zx23); - TV_CHECK(gpr, 24, zx24); - TV_CHECK(gpr, 25, zx25); - TV_CHECK(gpr, 25, zx25); - TV_CHECK(gpr, 26, zx26); - TV_CHECK(gpr, 27, zx27); - TV_CHECK(gpr, 28, zx28); - TV_CHECK(gpr, 29, zx29); - TV_CHECK(gpr, 30, zx30); - TV_CHECK(gpr, 31, zx31); - - /* some selected CSRs for now */ - - TV_CHECK(csr, CSR_MCAUSE, zmcause.zMcause_chunk_0); - TV_CHECK(csr, CSR_MEPC, zmepc); - TV_CHECK(csr, CSR_MTVAL, zmtval); - TV_CHECK(csr, CSR_MSTATUS, zmstatus); - - TV_CHECK(csr, CSR_SCAUSE, zscause.zMcause_chunk_0); - TV_CHECK(csr, CSR_SEPC, zsepc); - TV_CHECK(csr, CSR_STVAL, zstval); - -#undef TV_CHECK -#endif - - return passed; -} - -void flush_logs(void) -{ - fprintf(stderr, "\n"); - fflush(stderr); - fprintf(stdout, "\n"); - fflush(stdout); -} - -#ifdef RVFI_DII -void rvfi_send_trace(void) { - sail_bits packet; - CREATE(lbits)(&packet); - zrvfi_get_exec_packet(&packet, UNIT); - if (packet.len % 8 != 0) { - fprintf(stderr, "RVFI-DII trace packet not byte aligned: %d\n", (int)packet.len); - exit(1); - } - unsigned char bytes[packet.len / 8]; - /* mpz_export might not write all of the null bytes */ - memset(bytes, 0, sizeof(bytes)); - mpz_export(bytes, NULL, -1, 1, 0, 0, *(packet.bits)); - if (write(rvfi_dii_sock, bytes, packet.len / 8) == -1) { - fprintf(stderr, "Writing RVFI DII trace failed: %s", strerror(errno)); - exit(1); - } -} -#endif - -void run_sail(void) -{ - bool spike_done; - bool stepped; - bool diverged = false; - - /* initialize the step number */ - mach_int step_no = 0; - int insn_cnt = 0; -#ifdef RVFI_DII - bool need_instr = true; -#endif - - while (!zhtif_done) { -#ifdef RVFI_DII - if (rvfi_dii) { - if (need_instr) { - mach_bits instr_bits; - if (read(rvfi_dii_sock, &instr_bits, sizeof(instr_bits)) == -1) { - fprintf(stderr, "Reading RVFI DII command failed: %s", strerror(errno)); - exit(1); - } - zrvfi_set_instr_packet(instr_bits); - zrvfi_zzero_exec_packet(UNIT); - mach_bits cmd = zrvfi_get_cmd(UNIT); - switch (cmd) { - case 0: /* EndOfTrace */ - zrvfi_halt_exec_packet(UNIT); - rvfi_send_trace(); - return; - case 1: /* Instruction */ - break; - default: - fprintf(stderr, "Unknown RVFI-DII command: %d\n", (int)cmd); - exit(1); - } - } - sail_int sail_step; - CREATE(sail_int)(&sail_step); - CONVERT_OF(sail_int, mach_int)(&sail_step, step_no); - stepped = zrvfi_step(sail_step); - if (have_exception) goto step_exception; - flush_logs(); - if (stepped) { - need_instr = true; - rvfi_send_trace(); - } else - need_instr = false; - } else -#endif - { /* run a Sail step */ - sail_int sail_step; - CREATE(sail_int)(&sail_step); - CONVERT_OF(sail_int, mach_int)(&sail_step, step_no); - stepped = zstep(sail_step); - if (have_exception) goto step_exception; - flush_logs(); - KILL(sail_int)(&sail_step); - } - if (stepped) { - step_no++; - insn_cnt++; - } - -#ifdef ENABLE_SPIKE - { /* run a Spike step */ - tv_step(s); - spike_done = tv_is_done(s); - flush_logs(); - } - - if (zhtif_done) { - if (!spike_done) { - fprintf(stdout, "Sail done (exit-code %ld), but not Spike!\n", zhtif_exit_code); - exit(1); - } - } else { - if (spike_done) { - fprintf(stdout, "Spike done, but not Sail!\n"); - exit(1); - } - } - if (!compare_states(s)) { - diverged = true; - break; - } -#endif - if (zhtif_done) { - /* check exit code */ - if (zhtif_exit_code == 0) - fprintf(stdout, "SUCCESS\n"); - else - fprintf(stdout, "FAILURE: %ld\n", zhtif_exit_code); - } - - if (insn_cnt == rv_insns_per_tick) { - insn_cnt = 0; - ztick_clock(UNIT); - ztick_platform(UNIT); - - tick_spike(); - } - } - - dump_state: - if (diverged) { - /* TODO */ - } - finish(diverged); - - step_exception: - fprintf(stderr, "Sail exception!"); - goto dump_state; -} - -void init_logs() -{ -#ifdef ENABLE_SPIKE - // The Spike interface uses stdout for terminal output, and stderr for logs. - // Do the same here. - if (dup2(1, 2) < 0) { - fprintf(stderr, "Unable to dup 1 -> 2: %s\n", strerror(errno)); - exit(1); - } -#endif - - if ((term_fd = open(term_log, O_WRONLY|O_CREAT|O_TRUNC, S_IRUSR|S_IRGRP|S_IROTH|S_IWUSR)) < 0) { - fprintf(stderr, "Cannot create terminal log '%s': %s\n", term_log, strerror(errno)); - exit(1); - } -} - -int main(int argc, char **argv) -{ - char *file = process_args(argc, argv); - init_logs(); - -#ifdef RVFI_DII - uint64_t entry; - if (rvfi_dii) { - entry = 0x80000000; - int listen_sock = socket(AF_INET, SOCK_STREAM, 0); - if (listen_sock == -1) { - fprintf(stderr, "Unable to create socket: %s", strerror(errno)); - return 1; - } - int opt = 1; - if (setsockopt(listen_sock, SOL_SOCKET, SO_REUSEADDR, &opt, sizeof(opt)) == -1) { - fprintf(stderr, "Unable to set reuseaddr on socket: %s", strerror(errno)); - return 1; - } - struct sockaddr_in addr = { - .sin_family = AF_INET, - .sin_addr.s_addr = INADDR_ANY, - .sin_port = htons(rvfi_dii_port) - }; - if (bind(listen_sock, (struct sockaddr *)&addr, sizeof(addr)) == -1) { - fprintf(stderr, "Unable to set bind socket: %s", strerror(errno)); - return 1; - } - if (listen(listen_sock, 1) == -1) { - fprintf(stderr, "Unable to listen on socket: %s", strerror(errno)); - return 1; - } - printf("Waiting for connection\n"); - rvfi_dii_sock = accept(listen_sock, NULL, NULL); - if (rvfi_dii_sock == -1) { - fprintf(stderr, "Unable to accept connection on socket: %s", strerror(errno)); - return 1; - } - close(listen_sock); - printf("Connected\n"); - } else - entry = load_sail(file); -#else - uint64_t entry = load_sail(file); -#endif - - /* initialize spike before sail so that we can access the device-tree blob, - * until we roll our own. - */ - init_spike(file, entry, rv_ram_size); - init_sail(entry); - - if (!init_check(s)) finish(1); - - do { - run_sail(); -#ifndef RVFI_DII - } while (0); -#else - if (rvfi_dii) { - /* Reset for next test; currently we only quit when the connection breaks - and we crash due to SIGPIPE. */ - model_fini(); - init_sail(entry); - } - } while (rvfi_dii); -#endif - flush_logs(); -} diff --git a/riscv/riscv_step.sail b/riscv/riscv_step.sail deleted file mode 100644 index 755420d9..00000000 --- a/riscv/riscv_step.sail +++ /dev/null @@ -1,125 +0,0 @@ -/* The emulator fetch-execute-interrupt dispatch loop. */ - -union FetchResult = { - F_Base : word, /* Base ISA */ - F_RVC : half, /* Compressed ISA */ - F_Error : (ExceptionType, xlenbits) /* exception and PC */ -} - -function isRVC(h : half) -> bool = - ~ (h[1 .. 0] == 0b11) - -val fetch : unit -> FetchResult effect {escape, rmem, rreg, wmv, wreg} -function fetch() -> FetchResult = - /* check for legal PC */ - if (PC[0] != 0b0 | (PC[1] != 0b0 & (~ (haveRVC())))) - then F_Error(E_Fetch_Addr_Align, PC) - else match translateAddr(PC, Execute, Instruction) { - TR_Failure(e) => F_Error(e, PC), - TR_Address(ppclo) => { - /* split instruction fetch into 16-bit granules to handle RVC, as - * well as to generate precise fault addresses in any fetch - * exceptions. - */ - match checked_mem_read(Instruction, ppclo, 2, false, false, false) { - MemException(e) => F_Error(E_Fetch_Access_Fault, PC), - MemValue(ilo) => { - if isRVC(ilo) then F_RVC(ilo) - else { - PChi : xlenbits = PC + 2; - match translateAddr(PChi, Execute, Instruction) { - TR_Failure(e) => F_Error(e, PChi), - TR_Address(ppchi) => { - match checked_mem_read(Instruction, ppchi, 2, false, false, false) { - MemException(e) => F_Error(E_Fetch_Access_Fault, PChi), - MemValue(ihi) => F_Base(append(ihi, ilo)) - } - } - } - } - } - } - } - } - -/* returns whether to increment the step count in the trace */ -val step : int -> bool effect {barr, eamem, escape, exmem, rmem, rreg, wmv, wreg} -function step(step_no) = { - minstret_written = false; /* see note for minstret */ - let (retired, stepped) : (bool, bool) = - match curInterrupt(cur_privilege, mip, mie, mideleg) { - Some(intr, priv) => { - print_bits("Handling interrupt: ", intr); - handle_interrupt(intr, priv); - (false, false) - }, - None() => { - match fetch() { - F_Error(e, addr) => { - handle_mem_exception(addr, e); - (false, false) - }, - F_RVC(h) => { - match decodeCompressed(h) { - None() => { - print_instr("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(h) ^ ") <no-decode>"); - instbits = EXTZ(h); - handle_illegal(); - (false, true) - }, - Some(ast) => { - print_instr("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(h) ^ ") " ^ ast); - nextPC = PC + 2; - (execute(ast), true) - } - } - }, - F_Base(w) => { - match decode(w) { - None() => { - print_instr("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(w) ^ ") <no-decode>"); - instbits = EXTZ(w); - handle_illegal(); - (false, true) - }, - Some(ast) => { - print_instr("[" ^ string_of_int(step_no) ^ "] [" ^ cur_privilege ^ "]: " ^ BitStr(PC) ^ " (" ^ BitStr(w) ^ ") " ^ ast); - nextPC = PC + 4; - (execute(ast), true) - } - } - } - } - } - }; - PC = nextPC; - if retired then retire_instruction(); - stepped -} - -val loop : unit -> unit effect {barr, eamem, escape, exmem, rmem, rreg, wmv, wreg} -function loop () = { - let insns_per_tick = plat_insns_per_tick(); - i : int = 0; - step_no : int = 0; - while (~ (htif_done)) do { - let stepped = step(step_no); - if stepped then step_no = step_no + 1; - - /* check htif exit */ - if htif_done then { - let exit_val = unsigned(htif_exit_code); - if exit_val == 0 then print("SUCCESS") - else print_int("FAILURE: ", exit_val); - } else { - /* update time */ - i = i + 1; - if i == insns_per_tick then { - tick_clock(); - /* for now, we drive the platform i/o at every clock tick. */ - tick_platform(); - i = 0; - } - } - } -} diff --git a/riscv/riscv_sys.sail b/riscv/riscv_sys.sail deleted file mode 100644 index 58609949..00000000 --- a/riscv/riscv_sys.sail +++ /dev/null @@ -1,1044 +0,0 @@ -/* Machine-mode and supervisor-mode state definitions and operations. */ - -/* privilege level */ - -register cur_privilege : Privilege - -/* current instruction bits, used for illegal instruction exceptions */ - -register cur_inst : xlenbits - -/* State projections - * - * Some machine state is processed via projections from machine-mode views to - * views from lower privilege levels. So, for e.g. when mstatus is read from - * lower privilege levels, we use 'lowering_' projections: - * - * mstatus -> sstatus -> ustatus - * - * Similarly, when machine state is written from lower privileges, that state is - * lifted into the appropriate value for the machine-mode state. - * - * ustatus -> sstatus -> mstatus - * - * In addition, several fields in machine state registers are WARL or WLRL, - * requiring that values written to the registers be legalized. For each such - * register, there will be an associated 'legalize_' function. These functions - * will need to be supplied externally, and will depend on the legal values - * supported by a platform/implementation (or misa). The legalize_ functions - * generate a legal value from the current value and the written value. In more - * complex cases, they will also implicitly read the current values of misa, - * mstatus, etc. - * - * Each register definition below is followed by custom projections - * and choice of legalizations if needed. For now, we typically - * implement the simplest legalize_ alternatives. - */ - - -/* M-mode registers */ - -bitfield Misa : bits(64) = { - MXL : 63 .. 62, - - Z : 25, - Y : 24, - X : 23, - W : 22, - V : 21, - U : 20, - T : 19, - S : 18, - R : 17, - Q : 16, - P : 15, - O : 14, - N : 13, - M : 12, - L : 11, - K : 10, - J : 9, - I : 8, - H : 7, - G : 6, - F : 5, - E : 4, - D : 3, - C : 2, - B : 1, - A : 0 -} -register misa : Misa - -function legalize_misa(m : Misa, v : xlenbits) -> Misa = { - /* Allow modifications to C. */ - let v = Mk_Misa(v); - // Suppress changing C if nextPC would become misaligned. - if v.C() == false & nextPC[1] == true - then m - else update_C(m, v.C()) -} - -bitfield Mstatus : bits(64) = { - SD : 63, - - SXL : 35 .. 34, - UXL : 33 .. 32, - - TSR : 22, - TW : 21, - TVM : 20, - MXR : 19, - SUM : 18, - MPRV : 17, - - XS : 16 .. 15, - FS : 14 .. 13, - - MPP : 12 .. 11, - SPP : 8, - - MPIE : 7, - SPIE : 5, - UPIE : 4, - - MIE : 3, - SIE : 1, - UIE : 0 -} -register mstatus : Mstatus - -function legalize_mstatus(o : Mstatus, v : xlenbits) -> Mstatus = { - let m : Mstatus = Mk_Mstatus(v); - - /* We don't have any extension context yet. */ - let m = update_XS(m, extStatus_to_bits(Off)); - let m = update_FS(m, extStatus_to_bits(Off)); - - let m = update_SD(m, extStatus_of_bits(m.FS()) == Dirty - | extStatus_of_bits(m.XS()) == Dirty); - - /* For now, we don't allow SXL and UXL to be changed, for Spike compatibility. */ - let m = update_SXL(m, o.SXL()); - let m = update_UXL(m, o.UXL()); - - /* Hardwired to zero in the absence of 'N'. */ - let m = update_UPIE(m, false); - let m = update_UIE(m, false); - m -} - -/* architecture and extension checks */ - -function cur_Architecture() -> Architecture = { - let a : arch_xlen = - match (cur_privilege) { - Machine => misa.MXL(), - Supervisor => mstatus.SXL(), - User => mstatus.UXL() - }; - match architecture(a) { - Some(a) => a, - None() => internal_error("Invalid current architecture") - } -} - -function in32BitMode() -> bool = { - cur_Architecture() == RV32 -} - -function haveAtomics() -> bool = { misa.A() == true } -function haveRVC() -> bool = { misa.C() == true } -function haveMulDiv() -> bool = { misa.M() == true } -function haveFP() -> bool = { misa.F() == true | misa.D() == true } - -/* interrupt processing state */ - -bitfield Minterrupts : bits(64) = { - MEI : 11, /* external interrupts */ - SEI : 9, - UEI : 8, - - MTI : 7, /* timers interrupts */ - STI : 5, - UTI : 4, - - MSI : 3, /* software interrupts */ - SSI : 1, - USI : 0, -} -register mip : Minterrupts /* Pending */ -register mie : Minterrupts /* Enabled */ -register mideleg : Minterrupts /* Delegation to S-mode */ - -function legalize_mip(o : Minterrupts, v : xlenbits) -> Minterrupts = { - /* The only writable bits are the S-mode bits, and with the 'N' - * extension, the U-mode bits. */ - let v = Mk_Minterrupts(v); - let m = update_SEI(o, v.SEI()); - let m = update_STI(m, v.STI()); - let m = update_SSI(m, v.SSI()); - m -} - -function legalize_mie(o : Minterrupts, v : xlenbits) -> Minterrupts = { - let v = Mk_Minterrupts(v); - let m = update_MEI(o, v.MEI()); - let m = update_MTI(m, v.MTI()); - let m = update_MSI(m, v.MSI()); - let m = update_SEI(m, v.SEI()); - let m = update_STI(m, v.STI()); - let m = update_SSI(m, v.SSI()); - /* The U-mode bits will be modified if we have the 'N' extension. */ - m -} - -function legalize_mideleg(o : Minterrupts, v : xlenbits) -> Minterrupts = { - /* M-mode interrupt delegation bits "should" be hardwired to 0. */ - /* FIXME: needs verification against eventual spec language. */ - let m = Mk_Minterrupts(v); - let m = update_MEI(m, false); - let m = update_MTI(m, false); - let m = update_MSI(m, false); - m -} - -/* exception processing state */ - -bitfield Medeleg : bits(64) = { - SAMO_Page_Fault : 15, - Load_Page_Fault : 13, - Fetch_Page_Fault : 12, - MEnvCall : 10, - SEnvCall : 9, - UEnvCall : 8, - SAMO_Access_Fault : 7, - SAMO_Addr_Align : 6, - Load_Access_Fault : 5, - Load_Addr_Align : 4, - Breakpoint : 3, - Illegal_Instr : 2, - Fetch_Access_Fault: 1, - Fetch_Addr_Align : 0 -} -register medeleg : Medeleg /* Delegation to S-mode */ - -function legalize_medeleg(o : Medeleg, v : xlenbits) -> Medeleg = { - let m = Mk_Medeleg(v); - /* M-EnvCalls delegation is not supported */ - let m = update_MEnvCall(m, false); - m -} - -/* registers for trap handling */ - -bitfield Mtvec : bits(64) = { - Base : 63 .. 2, - Mode : 1 .. 0 -} -register mtvec : Mtvec /* Trap Vector */ - -function legalize_tvec(o : Mtvec, v : xlenbits) -> Mtvec = { - let v = Mk_Mtvec(v); - match (trapVectorMode_of_bits(v.Mode())) { - TV_Direct => v, - TV_Vector => v, - _ => update_Mode(v, o.Mode()) - } -} - -bitfield Mcause : bits(64) = { - IsInterrupt : 63, - Cause : 62 .. 0 -} -register mcause : Mcause - -/* Interpreting the trap-vector address */ -function tvec_addr(m : Mtvec, c : Mcause) -> option(xlenbits) = { - let base : xlenbits = m.Base() @ 0b00; - match (trapVectorMode_of_bits(m.Mode())) { - TV_Direct => Some(base), - TV_Vector => if c.IsInterrupt() == true - then Some(base + (EXTZ(c.Cause()) << 0b10)) - else Some(base), - TV_Reserved => None() - } -} - -/* Exception PC */ - -register mepc : xlenbits - -// legalizing writes to xepc -function legalize_xepc(v : xlenbits) -> xlenbits = { - v & EXTS(if haveRVC() then 0b110 else 0b100) -} - -// masking for reads to xepc -function pc_alignment_mask() -> xlenbits = - ~(EXTZ(if misa.C() == true then 0b00 else 0b10)) - -/* auxiliary exception registers */ - -register mtval : xlenbits -register mscratch : xlenbits - -/* counters */ - -bitfield Counteren : bits(32) = { - HPM : 31 .. 3, - IR : 2, - TM : 1, - CY : 0 -} - -register mcounteren : Counteren -register scounteren : Counteren - -function legalize_mcounteren(c : Counteren, v : xlenbits) -> Counteren = { - /* no HPM counters yet */ - let c = update_IR(c, v[2]); - let c = update_TM(c, v[1]); - let c = update_CY(c, v[0]); - c -} - -function legalize_scounteren(c : Counteren, v : xlenbits) -> Counteren = { - /* no HPM counters yet */ - let c = update_IR(c, v[2]); - let c = update_TM(c, v[1]); - let c = update_CY(c, v[0]); - c -} - -register mcycle : xlenbits -register mtime : xlenbits - -/* minstret - * - * minstret is an architectural register, and can be written to. The - * spec says that minstret increments on instruction retires need to - * occur before any explicit writes to instret. However, in our - * simulation loop, we need to execute an instruction to find out - * whether it retired, and hence can only increment instret after - * execution. To avoid doing this in the case minstret was explicitly - * written to, we track writes to it in a separate model-internal - * register. - */ -register minstret : xlenbits -register minstret_written : bool - -function retire_instruction() -> unit = { - if minstret_written == true - then minstret_written = false - else minstret = minstret + 1 -} - -/* informational registers */ -register mvendorid : xlenbits -register mimpid : xlenbits -register marchid : xlenbits -/* TODO: this should be readonly, and always 0 for now */ -register mhartid : xlenbits - -/* physical memory protection configuration */ -register pmpaddr0 : xlenbits -register pmpcfg0 : xlenbits - - -/* S-mode registers */ - -/* sstatus reveals a subset of mstatus */ -bitfield Sstatus : bits(64) = { - SD : 63, - UXL : 33 .. 32, - MXR : 19, - SUM : 18, - XS : 16 .. 15, - FS : 14 .. 13, - SPP : 8, - SPIE : 5, - UPIE : 4, - SIE : 1, - UIE : 0 -} -/* This is a view, so there is no register defined. */ -function lower_mstatus(m : Mstatus) -> Sstatus = { - let s = Mk_Sstatus(EXTZ(0b0)); - let s = update_SD(s, m.SD()); - let s = update_UXL(s, m.UXL()); - let s = update_MXR(s, m.MXR()); - let s = update_SUM(s, m.SUM()); - let s = update_XS(s, m.XS()); - let s = update_FS(s, m.FS()); - let s = update_SPP(s, m.SPP()); - let s = update_SPIE(s, m.SPIE()); - let s = update_UPIE(s, m.UPIE()); - let s = update_SIE(s, m.SIE()); - let s = update_UIE(s, m.UIE()); - s -} - -function lift_sstatus(m : Mstatus, s : Sstatus) -> Mstatus = { - // FIXME: This should be parameterized by a platform setting. For now, match spike. - // let m = update_UXL(m, s.UXL()); - let m = update_MXR(m, s.MXR()); - let m = update_SUM(m, s.SUM()); - - // FIXME: Should XS and FS check whether X and F|D are supported in misa? - let m = update_XS(m, s.XS()); - let m = update_FS(m, s.FS()); - let m = update_SD(m, extStatus_of_bits(m.FS()) == Dirty - | extStatus_of_bits(m.XS()) == Dirty); - - let m = update_SPP(m, s.SPP()); - let m = update_SPIE(m, s.SPIE()); - let m = update_UPIE(m, s.UPIE()); - let m = update_SIE(m, s.SIE()); - let m = update_UIE(m, s.UIE()); - m -} - -function legalize_sstatus(m : Mstatus, v : xlenbits) -> Mstatus = { - lift_sstatus(m, Mk_Sstatus(v)) -} - -bitfield Sedeleg : bits(64) = { - UEnvCall : 8, - SAMO_Access_Fault : 7, - SAMO_Addr_Align : 6, - Load_Access_Fault : 5, - Load_Addr_Align : 4, - Breakpoint : 3, - Illegal_Instr : 2, - Fetch_Access_Fault: 1, - Fetch_Addr_Align : 0 -} -register sedeleg : Sedeleg - -function legalize_sedeleg(s : Sedeleg, v : xlenbits) -> Sedeleg = { - Mk_Sedeleg(EXTZ(v[8..0])) -} - -bitfield Sinterrupts : bits(64) = { - SEI : 9, /* external interrupts */ - UEI : 8, - - STI : 5, /* timers interrupts */ - UTI : 4, - - SSI : 1, /* software interrupts */ - USI : 0 -} - -/* Provides the sip read view of mip as delegated by mideleg. */ -function lower_mip(m : Minterrupts, d : Minterrupts) -> Sinterrupts = { - let s : Sinterrupts = Mk_Sinterrupts(EXTZ(0b0)); - let s = update_SEI(s, m.SEI() & d.SEI()); - let s = update_STI(s, m.STI() & d.STI()); - let s = update_SSI(s, m.SSI() & d.SSI()); - - let s = update_UEI(s, m.UEI() & d.UEI()); - let s = update_UTI(s, m.UTI() & d.UTI()); - let s = update_USI(s, m.USI() & d.USI()); - s -} -/* Provides the sie read view of mie as delegated by mideleg. */ -function lower_mie(m : Minterrupts, d : Minterrupts) -> Sinterrupts = { - let s : Sinterrupts = Mk_Sinterrupts(EXTZ(0b0)); - let s = update_SEI(s, m.SEI() & d.SEI()); - let s = update_STI(s, m.STI() & d.STI()); - let s = update_SSI(s, m.SSI() & d.SSI()); - let s = update_UEI(s, m.UEI() & d.UEI()); - let s = update_UTI(s, m.UTI() & d.UTI()); - let s = update_USI(s, m.USI() & d.USI()); - s -} -/* Provides the sip write view of mip as delegated by mideleg. */ -function lift_sip(o : Minterrupts, d : Minterrupts, s : Sinterrupts) -> Minterrupts = { - let m : Minterrupts = o; - let m = update_SSI(m, s.SSI() & d.SSI()); - let m = update_UEI(m, m.UEI() & d.UEI()); - let m = update_USI(m, m.USI() & d.USI()); - m -} -function legalize_sip(m : Minterrupts, d : Minterrupts, v : xlenbits) -> Minterrupts = { - lift_sip(m, d, Mk_Sinterrupts(v)) -} -/* Provides the sie write view of mie as delegated by mideleg. */ -function lift_sie(o : Minterrupts, d : Minterrupts, s : Sinterrupts) -> Minterrupts = { - let m : Minterrupts = o; - let m = if d.SEI() == true then update_SEI(m, s.SEI()) else m; - let m = if d.STI() == true then update_STI(m, s.STI()) else m; - let m = if d.SSI() == true then update_SSI(m, s.SSI()) else m; - let m = if d.UEI() == true then update_UEI(m, s.UEI()) else m; - let m = if d.UTI() == true then update_UTI(m, s.UTI()) else m; - let m = if d.USI() == true then update_USI(m, s.USI()) else m; - m -} -function legalize_sie(m : Minterrupts, d : Minterrupts, v : xlenbits) -> Minterrupts = { - lift_sie(m, d, Mk_Sinterrupts(v)) -} - -register sideleg : Sinterrupts - -/* s-mode address translation and protection (satp) */ -bitfield Satp64 : bits(64) = { - Mode : 63 .. 60, - Asid : 59 .. 44, - PPN : 43 .. 0 -} -register satp : xlenbits - -function legalize_satp(a : Architecture, o : xlenbits, v : xlenbits) -> xlenbits = { - let s = Mk_Satp64(v); - match satpMode_of_bits(a, s.Mode()) { - None() => o, - Some(Sv32) => o, /* Sv32 is unsupported for now */ - Some(_) => s.bits() - } -} - -/* other supervisor state */ -register stvec : Mtvec -register sscratch : xlenbits -register sepc : xlenbits -register scause : Mcause -register stval : xlenbits - -/* disabled trigger/debug module */ -register tselect : xlenbits - -/* CSR names */ - -val cast csr_name : csreg -> string -function csr_name(csr) = { - match (csr) { - /* user trap setup */ - 0x000 => "ustatus", - 0x004 => "uie", - 0x005 => "utvec", - /* user floating-point context */ - 0x001 => "fflags", - 0x002 => "frm", - 0x003 => "fcsr", - /* counter/timers */ - 0xC00 => "cycle", - 0xC01 => "time", - 0xC02 => "instret", - 0xC80 => "cycleh", - 0xC81 => "timeh", - 0xC82 => "instreth", - /* TODO: other hpm counters */ - /* supervisor trap setup */ - 0x100 => "sstatus", - 0x102 => "sedeleg", - 0x103 => "sideleg", - 0x104 => "sie", - 0x105 => "stvec", - 0x106 => "scounteren", - /* supervisor trap handling */ - 0x140 => "sscratch", - 0x141 => "sepc", - 0x142 => "scause", - 0x143 => "stval", - 0x144 => "sip", - /* supervisor protection and translation */ - 0x180 => "satp", - /* machine information registers */ - 0xF11 => "mvendorid", - 0xF12 => "marchid", - 0xF13 => "mimpid", - 0xF14 => "mhartid", - /* machine trap setup */ - 0x300 => "mstatus", - 0x301 => "misa", - 0x302 => "medeleg", - 0x303 => "mideleg", - 0x304 => "mie", - 0x305 => "mtvec", - 0x306 => "mcounteren", - /* machine trap handling */ - 0x340 => "mscratch", - 0x341 => "mepc", - 0x342 => "mcause", - 0x343 => "mtval", - 0x344 => "mip", - - 0x3A0 => "pmpcfg0", - 0x3B0 => "pmpaddr0", - /* TODO: machine protection and translation */ - /* machine counters/timers */ - 0xB00 => "mcycle", - 0xB02 => "minstret", - 0xB80 => "mcycleh", - 0xB82 => "minstreth", - /* TODO: other hpm counters and events */ - /* trigger/debug */ - 0x7a0 => "tselect", - _ => "UNKNOWN" - } -} - -mapping csr_name_map : csreg <-> string = { - /* user trap setup */ - 0x000 <-> "ustatus", - 0x004 <-> "uie", - 0x005 <-> "utvec", - /* user trap handling */ - 0x040 <-> "uscratch", - 0x041 <-> "uepc", - 0x042 <-> "ucause", - 0x043 <-> "utval", - 0x044 <-> "uip", - /* user floating-point context */ - 0x001 <-> "fflags", - 0x002 <-> "frm", - 0x003 <-> "fcsr", - /* counter/timers */ - 0xC00 <-> "cycle", - 0xC01 <-> "time", - 0xC02 <-> "instret", - 0xC80 <-> "cycleh", - 0xC81 <-> "timeh", - 0xC82 <-> "instreth", - /* TODO: other hpm counters */ - /* supervisor trap setup */ - 0x100 <-> "sstatus", - 0x102 <-> "sedeleg", - 0x103 <-> "sideleg", - 0x104 <-> "sie", - 0x105 <-> "stvec", - 0x106 <-> "scounteren", - /* supervisor trap handling */ - 0x140 <-> "sscratch", - 0x141 <-> "sepc", - 0x142 <-> "scause", - 0x143 <-> "stval", - 0x144 <-> "sip", - /* supervisor protection and translation */ - 0x180 <-> "satp", - /* machine information registers */ - 0xF11 <-> "mvendorid", - 0xF12 <-> "marchid", - 0xF13 <-> "mimpid", - 0xF14 <-> "mhartid", - /* machine trap setup */ - 0x300 <-> "mstatus", - 0x301 <-> "misa", - 0x302 <-> "medeleg", - 0x303 <-> "mideleg", - 0x304 <-> "mie", - 0x305 <-> "mtvec", - 0x306 <-> "mcounteren", - /* machine trap handling */ - 0x340 <-> "mscratch", - 0x341 <-> "mepc", - 0x342 <-> "mcause", - 0x343 <-> "mtval", - 0x344 <-> "mip", - /* machine protection and translation */ - 0x3A0 <-> "pmpcfg0", - 0x3A1 <-> "pmpcfg1", - 0x3A2 <-> "pmpcfg2", - 0x3A3 <-> "pmpcfg3", - 0x3B0 <-> "pmpaddr0", - 0x3B1 <-> "pmpaddr1", - 0x3B2 <-> "pmpaddr2", - 0x3B3 <-> "pmpaddr3", - 0x3B4 <-> "pmpaddr4", - 0x3B5 <-> "pmpaddr5", - 0x3B6 <-> "pmpaddr6", - 0x3B7 <-> "pmpaddr7", - 0x3B8 <-> "pmpaddr8", - 0x3B9 <-> "pmpaddr9", - 0x3BA <-> "pmpaddr10", - 0x3BB <-> "pmpaddr11", - 0x3BC <-> "pmpaddr12", - 0x3BD <-> "pmpaddr13", - 0x3BE <-> "pmpaddr14", - 0x3BF <-> "pmpaddr15", - /* machine counters/timers */ - 0xB00 <-> "mcycle", - 0xB02 <-> "minstret", - 0xB80 <-> "mcycleh", - 0xB82 <-> "minstreth", - /* TODO: other hpm counters and events */ - /* trigger/debug */ - 0x7a0 <-> "tselect", - 0x7a1 <-> "tdata1", - 0x7a2 <-> "tdata2", - 0x7a3 <-> "tdata3" - - /* numeric fallback */ - /* reg <-> hex_bits_12(reg) */ - } - - -/* CSR access control */ - -function csrAccess(csr : csreg) -> csrRW = csr[11..10] -function csrPriv(csr : csreg) -> priv_level = csr[9..8] - -function is_CSR_defined (csr : bits(12), p : Privilege) -> bool = - match (csr) { - /* machine mode: informational */ - 0xf11 => p == Machine, // mvendorid - 0xf12 => p == Machine, // marchdid - 0xf13 => p == Machine, // mimpid - 0xf14 => p == Machine, // mhartid - /* machine mode: trap setup */ - 0x300 => p == Machine, // mstatus - 0x301 => p == Machine, // misa - 0x302 => p == Machine, // medeleg - 0x303 => p == Machine, // mideleg - 0x304 => p == Machine, // mie - 0x305 => p == Machine, // mtvec - 0x306 => p == Machine, // mcounteren - /* machine mode: trap handling */ - 0x340 => p == Machine, // mscratch - 0x341 => p == Machine, // mepc - 0x342 => p == Machine, // mcause - 0x343 => p == Machine, // mtval - 0x344 => p == Machine, // mip - - 0x3A0 => p == Machine, // pmpcfg0 - 0x3B0 => false, // (Disabled for Spike compatibility) -// 0x3B0 => p == Machine, // pmpaddr0 - - /* supervisor mode: trap setup */ - 0x100 => p == Machine | p == Supervisor, // sstatus - 0x102 => p == Machine | p == Supervisor, // sedeleg - 0x103 => p == Machine | p == Supervisor, // sideleg - 0x104 => p == Machine | p == Supervisor, // sie - 0x105 => p == Machine | p == Supervisor, // stvec - 0x106 => p == Machine | p == Supervisor, // scounteren - - /* supervisor mode: trap handling */ - 0x140 => p == Machine | p == Supervisor, // sscratch - 0x141 => p == Machine | p == Supervisor, // sepc - 0x142 => p == Machine | p == Supervisor, // scause - 0x143 => p == Machine | p == Supervisor, // stval - 0x144 => p == Machine | p == Supervisor, // sip - - /* supervisor mode: address translation */ - 0x180 => p == Machine | p == Supervisor, // satp - - /* disabled trigger/debug module */ - 0x7a0 => p == Machine, - - _ => false - } - -val check_CSR_access : (csrRW, priv_level, Privilege, bool) -> bool -function check_CSR_access(csrrw, csrpr, p, isWrite) = - (~ (isWrite == true & csrrw == 0b11)) /* read/write */ - & (privLevel_to_bits(p) >=_u csrpr) /* privilege */ - -function check_TVM_SATP(csr : csreg, p : Privilege) -> bool = - ~ (csr == 0x180 & p == Supervisor & mstatus.TVM() == true) - -function check_Counteren(csr : csreg, p : Privilege) -> bool = - match(csr, p) { - (0xC00, Supervisor) => mcounteren.CY() == true, - (0xC01, Supervisor) => mcounteren.TM() == true, - (0xC02, Supervisor) => mcounteren.IR() == true, - - (0xC00, User) => scounteren.CY() == true, - (0xC01, User) => scounteren.TM() == true, - (0xC02, User) => scounteren.IR() == true, - - (_, _) => /* no HPM counters for now */ - if 0xC03 <=_u csr & csr <=_u 0xC1F - then false - else true - } - -function check_CSR(csr : csreg, p : Privilege, isWrite : bool) -> bool = - is_CSR_defined(csr, p) - & check_CSR_access(csrAccess(csr), csrPriv(csr), p, isWrite) - & check_TVM_SATP(csr, p) - & check_Counteren(csr, p) - -/* Reservation handling for LR/SC. - * - * The reservation state is maintained external to the model since the - * reservation behavior is platform-specific anyway and maintaining - * this state outside the model simplifies the concurrency analysis. - * - * These are externs are defined here in the system module since - * we currently perform reservation cancellation on privilege level - * transition. Ideally, the platform should get more visibility into - * where cancellation can be performed. - */ - -val load_reservation = {ocaml: "Platform.load_reservation", c: "load_reservation", lem: "load_reservation"} : xlenbits -> unit - -val match_reservation = {ocaml: "Platform.match_reservation", lem: "speculate_conditional_success", c: "match_reservation"} : xlenbits -> bool effect {exmem} - -val cancel_reservation = {ocaml: "Platform.cancel_reservation", c: "cancel_reservation", lem: "cancel_reservation"} : unit -> unit - -/* Exception delegation: given an exception and the privilege at which - * it occured, returns the privilege at which it should be handled. - */ -function exception_delegatee(e : ExceptionType, p : Privilege) -> Privilege = { - let idx = num_of_ExceptionType(e); - let super = medeleg.bits()[idx]; - let user = sedeleg.bits()[idx]; - let deleg = /* if misa.N() == true & user then User - else */ - if misa.S() == true & super then Supervisor - else Machine; - /* Ensure there is no transition to a less-privileged mode. */ - if privLevel_to_bits(deleg) <_u privLevel_to_bits(p) - then p else deleg -} - -/* Interrupts are prioritized in privilege order, and for each - * privilege, in the order: external, software, timers. - */ -function findPendingInterrupt(ip : xlenbits) -> option(InterruptType) = { - let ip = Mk_Minterrupts(ip); - if ip.MEI() == true then Some(I_M_External) - else if ip.MSI() == true then Some(I_M_Software) - else if ip.MTI() == true then Some(I_M_Timer) - else if ip.SEI() == true then Some(I_S_External) - else if ip.SSI() == true then Some(I_S_Software) - else if ip.STI() == true then Some(I_S_Timer) - else if ip.UEI() == true then Some(I_U_External) - else if ip.USI() == true then Some(I_U_Software) - else if ip.UTI() == true then Some(I_U_Timer) - else None() -} - -/* Examines current M-mode interrupt state and returns an interrupt to be - * handled, and the privilege it should be handled at. Interrupts are - * dispatched in order of decreasing privilege, while ensuring that the - * resulting privilege level is not reduced; i.e. delegated interrupts to - * lower privileges are effectively masked until control returns to them. - * - * For now, it assumes 'S' and no 'N' extension, which is the common case. - */ -function curInterrupt(priv : Privilege, pend : Minterrupts, enbl : Minterrupts, delg : Minterrupts) - -> option((InterruptType, Privilege)) = { - let en_mip : xlenbits = pend.bits() & enbl.bits(); - if en_mip == EXTZ(0b0) then None() /* fast path */ - else { - /* check implicit enabling when in lower privileges */ - let eff_mie = priv != Machine | (priv == Machine & mstatus.MIE() == true); - let eff_sie = priv == User | (priv == Supervisor & mstatus.SIE() == true); - /* handle delegation */ - let eff_mip = en_mip & (~ (delg.bits())); /* retained at M-mode */ - let eff_sip = en_mip & delg.bits(); /* delegated to S-mode */ - - if eff_mie & eff_mip != EXTZ(0b0) - then match findPendingInterrupt(eff_mip) { - Some(i) => let r = (i, Machine) in Some(r), - None() => { internal_error("non-zero eff_mip=" ^ BitStr(eff_mip) ^ ", but nothing pending") } - } - else if eff_sie & eff_sip != EXTZ(0b0) - then match findPendingInterrupt(eff_sip) { - Some(i) => let r = (i, Supervisor) in Some(r), - None() => { internal_error("non-zero eff_sip=" ^ BitStr(eff_sip) ^ ", but nothing pending") } - } - else { - let p = if pend.MTI() == true then "1" else "0"; - let e = if enbl.MTI() == true then "1" else "0"; - let d = if delg.MTI() == true then "1" else "0"; - print_platform(" MTI: pend=" ^ p ^ " enbl=" ^ e ^ " delg=" ^ d); - let eff_mip = en_mip & (~ (delg.bits())); /* retained at M-mode */ - let eff_sip = en_mip & delg.bits(); /* delegated to S-mode */ - print_platform("mstatus=" ^ BitStr(mstatus.bits()) - ^ " mie,sie=" ^ BitStr(mstatus.MIE()) ^ "," ^ BitStr(mstatus.SIE()) - ^ " en_mip=" ^ BitStr(en_mip) - ^ " eff_mip=" ^ BitStr(eff_mip) - ^ " eff_sip=" ^ BitStr(eff_sip)); - None() - } - } -} - -/* privilege transitions due to exceptions and interrupts */ - -struct sync_exception = { - trap : ExceptionType, - excinfo : option(xlenbits) -} - -function tval(excinfo : option(xlenbits)) -> xlenbits = { - match (excinfo) { - Some(e) => e, - None() => EXTZ(0b0) - } -} - -union ctl_result = { - CTL_TRAP : sync_exception, - CTL_SRET : unit, - CTL_MRET : unit -/* TODO: CTL_URET */ -} - -$ifdef RVFI_DII -val rvfi_trap : unit -> unit effect {wreg} -function rvfi_trap () = - rvfi_exec->rvfi_trap() = 0x01 -$else -val rvfi_trap : unit -> unit -function rvfi_trap () = () -$endif - -/* handle exceptional ctl flow by updating nextPC and operating privilege */ - -function handle_trap(del_priv : Privilege, intr : bool, c : exc_code, pc : xlenbits, info : option(xlenbits)) - -> xlenbits = { - rvfi_trap(); - print_platform("handling " ^ (if intr then "int#" else "exc#") ^ BitStr(c) ^ " at priv " ^ del_priv ^ " with tval " ^ BitStr(tval(info))); - - match (del_priv) { - Machine => { - mcause->IsInterrupt() = intr; - mcause->Cause() = EXTZ(c); - - mstatus->MPIE() = mstatus.MIE(); - mstatus->MIE() = false; - mstatus->MPP() = privLevel_to_bits(cur_privilege); - mtval = tval(info); - mepc = pc; - - cur_privilege = del_priv; - - print_reg("CSR mstatus <- " ^ BitStr(mstatus.bits()) ^ " (input: " ^ BitStr(mstatus.bits()) ^ ")"); // Spike compatible log - - cancel_reservation(); - - match tvec_addr(mtvec, mcause) { - Some(epc) => epc, - None() => internal_error("Invalid mtvec mode") - } - }, - Supervisor => { - scause->IsInterrupt() = intr; - scause->Cause() = EXTZ(c); - - mstatus->SPIE() = mstatus.SIE(); - mstatus->SIE() = false; - mstatus->SPP() = match (cur_privilege) { - User => false, - Supervisor => true, - Machine => internal_error("invalid privilege for s-mode trap") - }; - stval = tval(info); - sepc = pc; - - cur_privilege = del_priv; - - print_reg("CSR mstatus <- " ^ BitStr(mstatus.bits()) ^ " (input: " ^ BitStr(mstatus.bits()) ^ ")"); // Spike compatible log - - cancel_reservation(); - - match tvec_addr(stvec, scause) { - Some(epc) => epc, - None() => internal_error("Invalid stvec mode") - } - - }, - User => internal_error("the N extension is currently unsupported") - }; -} - -function handle_exception(cur_priv : Privilege, ctl : ctl_result, - pc: xlenbits) -> xlenbits = { - match (cur_priv, ctl) { - (_, CTL_TRAP(e)) => { - let del_priv = exception_delegatee(e.trap, cur_priv); - print_platform("trapping from " ^ cur_priv ^ " to " ^ del_priv - ^ " to handle " ^ e.trap); - handle_trap(del_priv, false, e.trap, pc, e.excinfo) - }, - (_, CTL_MRET()) => { - let prev_priv = cur_privilege; - mstatus->MIE() = mstatus.MPIE(); - mstatus->MPIE() = true; - cur_privilege = privLevel_of_bits(mstatus.MPP()); - mstatus->MPP() = privLevel_to_bits(User); - - print_reg("CSR mstatus <- " ^ BitStr(mstatus.bits()) ^ " (input: " ^ BitStr(mstatus.bits()) ^ ")"); // Spike compatible log - print_platform("ret-ing from " ^ prev_priv ^ " to " ^ cur_privilege); - - cancel_reservation(); - mepc & pc_alignment_mask() - }, - (_, CTL_SRET()) => { - let prev_priv = cur_privilege; - mstatus->SIE() = mstatus.SPIE(); - mstatus->SPIE() = true; - cur_privilege = if mstatus.SPP() == true then Supervisor else User; - mstatus->SPP() = false; - - print_reg("CSR mstatus <- " ^ BitStr(mstatus.bits()) ^ " (input: " ^ BitStr(mstatus.bits()) ^ ")"); // Spike compatible log - print_platform("ret-ing from " ^ prev_priv ^ " to " ^ cur_privilege); - - cancel_reservation(); - sepc & pc_alignment_mask() - } - } -} - -function handle_mem_exception(addr : xlenbits, e : ExceptionType) -> unit = { - let t : sync_exception = struct { trap = e, - excinfo = Some(addr) } in - nextPC = handle_exception(cur_privilege, CTL_TRAP(t), PC) -} - -function handle_interrupt(i : InterruptType, del_priv : Privilege) -> unit = - nextPC = handle_trap(del_priv, true, i, PC, None()) - -/* state state initialization */ - -function init_sys() -> unit = { - cur_privilege = Machine; - - mhartid = EXTZ(0b0); - - misa->MXL() = arch_to_bits(RV64); - misa->A() = true; /* atomics */ - misa->C() = true; /* RVC */ - misa->I() = true; /* base integer ISA */ - misa->M() = true; /* integer multiply/divide */ - misa->U() = true; /* user-mode */ - misa->S() = true; /* supervisor-mode */ - - /* 64-bit only mode with no extensions */ - mstatus->SXL() = misa.MXL(); - mstatus->UXL() = misa.MXL(); - mstatus->SD() = false; - - mip->bits() = EXTZ(0b0); - mie->bits() = EXTZ(0b0); - mideleg->bits() = EXTZ(0b0); - medeleg->bits() = EXTZ(0b0); - mtvec->bits() = EXTZ(0b0); - mcause->bits() = EXTZ(0b0); - mepc = EXTZ(0b0); - mtval = EXTZ(0b0); - mscratch = EXTZ(0b0); - - mcycle = EXTZ(0b0); - mtime = EXTZ(0b0); - - mcounteren->bits() = EXTZ(0b0); - - minstret = EXTZ(0b0); - minstret_written = false; - - // log compatibility with spike - print_reg("CSR mstatus <- " ^ BitStr(mstatus.bits()) ^ " (input: " ^ BitStr(EXTZ(0b0) : xlenbits) ^ ")") -} - -/* memory access exceptions, defined here for use by the platform model. */ - -union MemoryOpResult ('a : Type) = { - MemValue : 'a, - MemException : ExceptionType -} diff --git a/riscv/riscv_types.sail b/riscv/riscv_types.sail deleted file mode 100644 index 4d012e0c..00000000 --- a/riscv/riscv_types.sail +++ /dev/null @@ -1,550 +0,0 @@ -/* Basic type and function definitions used pervasively in the model. */ - -let xlen = 64 -type xlenbits = bits(64) - -let xlen_max_unsigned = 2 ^ xlen - 1 -let xlen_max_signed = 2 ^ (xlen - 1) - 1 -let xlen_min_signed = 0 - 2 ^ (xlen - 1) - -type half = bits(16) -type word = bits(32) - -/* register identifiers */ - -type regbits = bits(5) -type cregbits = bits(3) /* identifiers in RVC instructions */ -type csreg = bits(12) /* CSR addressing */ - -/* register file indexing */ - -type regno ('n : Int), 0 <= 'n < 32 = atom('n) - -val cast regbits_to_regno : bits(5) -> {'n, 0 <= 'n < 32. regno('n)} -function regbits_to_regno b = let 'r = unsigned(b) in r - -/* mapping RVC register indices into normal indices */ -val creg2reg_bits : cregbits -> regbits -function creg2reg_bits(creg) = 0b01 @ creg - -/* some architecture and ABI relevant register identifiers */ -let zreg : regbits = 0b00000 /* x0, zero register */ -let ra : regbits = 0b00001 /* x1, return address */ -let sp : regbits = 0b00010 /* x2, stack pointer */ - -/* program counter */ - -register PC : xlenbits -register nextPC : xlenbits - -/* internal state to hold instruction bits for faulting instructions */ -register instbits : xlenbits - -/* register file and accessors */ - -register Xs : vector(32, dec, xlenbits) - -register x1 : xlenbits -register x2 : xlenbits -register x3 : xlenbits -register x4 : xlenbits -register x5 : xlenbits -register x6 : xlenbits -register x7 : xlenbits -register x8 : xlenbits -register x9 : xlenbits -register x10 : xlenbits -register x11 : xlenbits -register x12 : xlenbits -register x13 : xlenbits -register x14 : xlenbits -register x15 : xlenbits -register x16 : xlenbits -register x17 : xlenbits -register x18 : xlenbits -register x19 : xlenbits -register x20 : xlenbits -register x21 : xlenbits -register x22 : xlenbits -register x23 : xlenbits -register x24 : xlenbits -register x25 : xlenbits -register x26 : xlenbits -register x27 : xlenbits -register x28 : xlenbits -register x29 : xlenbits -register x30 : xlenbits -register x31 : xlenbits - -val rX : forall 'n, 0 <= 'n < 32. regno('n) -> xlenbits effect {rreg} -/*function rX 0 = 0x0000000000000000 -and rX (r if r > 0) = Xs[r]*/ -function rX r = match r { - 0 => 0x0000000000000000, - 1 => x1, - 2 => x2, - 3 => x3, - 4 => x4, - 5 => x5, - 6 => x6, - 7 => x7, - 8 => x8, - 9 => x9, - 10 => x10, - 11 => x11, - 12 => x12, - 13 => x13, - 14 => x14, - 15 => x15, - 16 => x16, - 17 => x17, - 18 => x18, - 19 => x19, - 20 => x20, - 21 => x21, - 22 => x22, - 23 => x23, - 24 => x24, - 25 => x25, - 26 => x26, - 27 => x27, - 28 => x28, - 29 => x29, - 30 => x30, - 31 => x31 -} - -$ifdef RVFI_DII -val rvfi_wX : forall 'n, 0 <= 'n < 32. (regno('n), xlenbits) -> unit effect {wreg} -function rvfi_wX (r,v) = { - rvfi_exec->rvfi_rd_wdata() = v; - rvfi_exec->rvfi_rd_addr() = to_bits(8,r); -} -$else -val rvfi_wX : forall 'n, 0 <= 'n < 32. (regno('n), xlenbits) -> unit -function rvfi_wX (r,v) = () -$endif - -val wX : forall 'n, 0 <= 'n < 32. (regno('n), xlenbits) -> unit effect {wreg} -function wX (r, v) = { - match r { - 0 => (), - 1 => x1 = v, - 2 => x2 = v, - 3 => x3 = v, - 4 => x4 = v, - 5 => x5 = v, - 6 => x6 = v, - 7 => x7 = v, - 8 => x8 = v, - 9 => x9 = v, - 10 => x10 = v, - 11 => x11 = v, - 12 => x12 = v, - 13 => x13 = v, - 14 => x14 = v, - 15 => x15 = v, - 16 => x16 = v, - 17 => x17 = v, - 18 => x18 = v, - 19 => x19 = v, - 20 => x20 = v, - 21 => x21 = v, - 22 => x22 = v, - 23 => x23 = v, - 24 => x24 = v, - 25 => x25 = v, - 26 => x26 = v, - 27 => x27 = v, - 28 => x28 = v, - 29 => x29 = v, - 30 => x30 = v, - 31 => x31 = v - }; - if (r != 0) then { - rvfi_wX(r,v); - // Xs[r] = v; - print_reg("x" ^ string_of_int(r) ^ " <- " ^ BitStr(v)); - } -} - -overload X = {rX, wX} - -/* register names */ - -val cast reg_name_abi : regbits -> string - -function reg_name_abi(r) = { - match (r) { - 0b00000 => "zero", - 0b00001 => "ra", - 0b00010 => "sp", - 0b00011 => "gp", - 0b00100 => "tp", - 0b00101 => "t0", - 0b00110 => "t1", - 0b00111 => "t2", - 0b01000 => "fp", - 0b01001 => "s1", - 0b01010 => "a0", - 0b01011 => "a1", - 0b01100 => "a2", - 0b01101 => "a3", - 0b01110 => "a4", - 0b01111 => "a5", - 0b10000 => "a6", - 0b10001 => "a7", - 0b10010 => "s2", - 0b10011 => "s3", - 0b10100 => "s4", - 0b10101 => "s5", - 0b10110 => "s6", - 0b10111 => "s7", - 0b11000 => "s8", - 0b11001 => "s9", - 0b11010 => "s10", - 0b11011 => "s11", - 0b11100 => "t3", - 0b11101 => "t4", - 0b11110 => "t5", - 0b11111 => "t6" - } -} - -/* instruction fields */ - -type opcode = bits(7) -type imm12 = bits(12) -type imm20 = bits(20) -type amo = bits(1) /* amo opcode flags */ - -/* base architecture definitions */ - -enum Architecture = {RV32, RV64, RV128} -type arch_xlen = bits(2) -function architecture(a : arch_xlen) -> option(Architecture) = - match (a) { - 0b01 => Some(RV32), - 0b10 => Some(RV64), - 0b11 => Some(RV128), - _ => None() - } - -function arch_to_bits(a : Architecture) -> arch_xlen = - match (a) { - RV32 => 0b01, - RV64 => 0b10, - RV128 => 0b11 - } - -/* privilege levels */ - -type priv_level = bits(2) -enum Privilege = {User, Supervisor, Machine} - -val cast privLevel_to_bits : Privilege -> priv_level -function privLevel_to_bits (p) = - match (p) { - User => 0b00, - Supervisor => 0b01, - Machine => 0b11 - } - -val cast privLevel_of_bits : priv_level -> Privilege -function privLevel_of_bits (p) = - match (p) { - 0b00 => User, - 0b01 => Supervisor, - 0b11 => Machine - } - -val cast privLevel_to_str : Privilege -> string -function privLevel_to_str (p) = - match (p) { - User => "U", - Supervisor => "S", - Machine => "M" - } - -/* memory access types */ - -enum AccessType = {Read, Write, ReadWrite, Execute} - -val cast accessType_to_str : AccessType -> string -function accessType_to_str (a) = - match (a) { - Read => "R", - Write => "W", - ReadWrite => "RW", - Execute => "X" - } - -enum ReadType = {Instruction, Data} - -val cast readType_to_str : ReadType -> string -function readType_to_str (r) = - match (r) { - Instruction => "I", - Data => "D" - } - -enum word_width = {BYTE, HALF, WORD, DOUBLE} - -/* architectural interrupt definitions */ - -type exc_code = bits(4) - -enum InterruptType = { - I_U_Software, - I_S_Software, - I_M_Software, - I_U_Timer, - I_S_Timer, - I_M_Timer, - I_U_External, - I_S_External, - I_M_External -} - -val cast interruptType_to_bits : InterruptType -> exc_code -function interruptType_to_bits (i) = - match (i) { - I_U_Software => 0x0, - I_S_Software => 0x1, - I_M_Software => 0x3, - I_U_Timer => 0x4, - I_S_Timer => 0x5, - I_M_Timer => 0x7, - I_U_External => 0x8, - I_S_External => 0x9, - I_M_External => 0xb - } - -/* architectural exception definitions */ - -enum ExceptionType = { - E_Fetch_Addr_Align, - E_Fetch_Access_Fault, - E_Illegal_Instr, - E_Breakpoint, - E_Load_Addr_Align, - E_Load_Access_Fault, - E_SAMO_Addr_Align, - E_SAMO_Access_Fault, - E_U_EnvCall, - E_S_EnvCall, - E_Reserved_10, - E_M_EnvCall, - E_Fetch_Page_Fault, - E_Load_Page_Fault, - E_Reserved_14, - E_SAMO_Page_Fault -} - -val cast exceptionType_to_bits : ExceptionType -> exc_code -function exceptionType_to_bits(e) = - match (e) { - E_Fetch_Addr_Align => 0x0, - E_Fetch_Access_Fault => 0x1, - E_Illegal_Instr => 0x2, - E_Breakpoint => 0x3, - E_Load_Addr_Align => 0x4, - E_Load_Access_Fault => 0x5, - E_SAMO_Addr_Align => 0x6, - E_SAMO_Access_Fault => 0x7, - E_U_EnvCall => 0x8, - E_S_EnvCall => 0x9, - E_Reserved_10 => 0xa, - E_M_EnvCall => 0xb, - E_Fetch_Page_Fault => 0xc, - E_Load_Page_Fault => 0xd, - E_Reserved_14 => 0xe, - E_SAMO_Page_Fault => 0xf - } - -val cast exceptionType_to_str : ExceptionType -> string -function exceptionType_to_str(e) = - match (e) { - E_Fetch_Addr_Align => "misaligned-fetch", - E_Fetch_Access_Fault => "fetch-access-fault", - E_Illegal_Instr => "illegal-instruction", - E_Breakpoint => "breakpoint", - E_Load_Addr_Align => "misaligned-load", - E_Load_Access_Fault => "load-access-fault", - E_SAMO_Addr_Align => "misaliged-store/amo", - E_SAMO_Access_Fault => "store/amo-access-fault", - E_U_EnvCall => "u-call", - E_S_EnvCall => "s-call", - E_Reserved_10 => "reserved-0", - E_M_EnvCall => "m-call", - E_Fetch_Page_Fault => "fetch-page-fault", - E_Load_Page_Fault => "load-page-fault", - E_Reserved_14 => "reserved-1", - E_SAMO_Page_Fault => "store/amo-page-fault" - } - -/* model-internal exceptions */ - -union exception = { - Error_not_implemented : string, - Error_internal_error : unit -} - -val not_implemented : forall ('a : Type). string -> 'a effect {escape} -function not_implemented message = throw(Error_not_implemented(message)) - -val internal_error : forall ('a : Type). string -> 'a effect {escape} -function internal_error(s) = { - assert (false, s); - throw Error_internal_error() -} - -/* trap modes */ - -type tv_mode = bits(2) -enum TrapVectorMode = {TV_Direct, TV_Vector, TV_Reserved} - -val cast trapVectorMode_of_bits : tv_mode -> TrapVectorMode -function trapVectorMode_of_bits (m) = - match (m) { - 0b00 => TV_Direct, - 0b01 => TV_Vector, - _ => TV_Reserved - } - -/* extension context status */ - -type ext_status = bits(2) -enum ExtStatus = {Off, Initial, Clean, Dirty} - -val cast extStatus_to_bits : ExtStatus -> ext_status -function extStatus_to_bits(e) = - match (e) { - Off => 0b00, - Initial => 0b01, - Clean => 0b10, - Dirty => 0b11 - } - -val cast extStatus_of_bits : ext_status -> ExtStatus -function extStatus_of_bits(e) = - match (e) { - 0b00 => Off, - 0b01 => Initial, - 0b10 => Clean, - 0b11 => Dirty - } - -/* supervisor-level address translation modes */ - -type satp_mode = bits(4) -enum SATPMode = {Sbare, Sv32, Sv39} - -function satpMode_of_bits(a : Architecture, m : satp_mode) -> option(SATPMode) = - match (a, m) { - (_, 0x0) => Some(Sbare), - (RV32, 0x1) => Some(Sv32), - (RV64, 0x8) => Some(Sv39), - (_, _) => None() - } - -/* CSR access control bits (from CSR addresses) */ - -type csrRW = bits(2) /* read/write */ - -/* instruction opcode grouping */ -enum uop = {RISCV_LUI, RISCV_AUIPC} /* upper immediate ops */ -enum bop = {RISCV_BEQ, RISCV_BNE, RISCV_BLT, - RISCV_BGE, RISCV_BLTU, RISCV_BGEU} /* branch ops */ -enum iop = {RISCV_ADDI, RISCV_SLTI, RISCV_SLTIU, - RISCV_XORI, RISCV_ORI, RISCV_ANDI} /* immediate ops */ -enum sop = {RISCV_SLLI, RISCV_SRLI, RISCV_SRAI} /* shift ops */ -enum rop = {RISCV_ADD, RISCV_SUB, RISCV_SLL, RISCV_SLT, - RISCV_SLTU, RISCV_XOR, RISCV_SRL, RISCV_SRA, - RISCV_OR, RISCV_AND} /* reg-reg ops */ - -enum ropw = {RISCV_ADDW, RISCV_SUBW, RISCV_SLLW, - RISCV_SRLW, RISCV_SRAW} /* reg-reg 32-bit ops */ -enum sopw = {RISCV_SLLIW, RISCV_SRLIW, - RISCV_SRAIW} /* RV64-only shift ops */ -enum amoop = {AMOSWAP, AMOADD, AMOXOR, AMOAND, AMOOR, - AMOMIN, AMOMAX, AMOMINU, AMOMAXU} /* AMO ops */ -enum csrop = {CSRRW, CSRRS, CSRRC} /* CSR ops */ - -/* mappings for assembly */ - -val reg_name : bits(5) <-> string -mapping reg_name = { - 0b00000 <-> "zero", - 0b00001 <-> "ra", - 0b00010 <-> "sp", - 0b00011 <-> "gp", - 0b00100 <-> "tp", - 0b00101 <-> "t0", - 0b00110 <-> "t1", - 0b00111 <-> "t2", - 0b01000 <-> "fp", - 0b01001 <-> "s1", - 0b01010 <-> "a0", - 0b01011 <-> "a1", - 0b01100 <-> "a2", - 0b01101 <-> "a3", - 0b01110 <-> "a4", - 0b01111 <-> "a5", - 0b10000 <-> "a6", - 0b10001 <-> "a7", - 0b10010 <-> "s2", - 0b10011 <-> "s3", - 0b10100 <-> "s4", - 0b10101 <-> "s5", - 0b10110 <-> "s6", - 0b10111 <-> "s7", - 0b11000 <-> "s8", - 0b11001 <-> "s9", - 0b11010 <-> "s10", - 0b11011 <-> "s11", - 0b11100 <-> "t3", - 0b11101 <-> "t4", - 0b11110 <-> "t5", - 0b11111 <-> "t6" -} - -mapping creg_name : bits(3) <-> string = { - 0b000 <-> "s0", - 0b001 <-> "s1", - 0b010 <-> "a0", - 0b011 <-> "a1", - 0b100 <-> "a2", - 0b101 <-> "a3", - 0b110 <-> "a4", - 0b111 <-> "a5" -} - -val sep : unit <-> string -mapping sep : unit <-> string = { - () <-> opt_spc() ^ "," ^ def_spc() -} - -mapping bool_bits : bool <-> bits(1) = { - true <-> 0b1, - false <-> 0b0 -} - -mapping bool_not_bits : bool <-> bits(1) = { - true <-> 0b0, - false <-> 0b1 -} - -mapping size_bits : word_width <-> bits(2) = { - BYTE <-> 0b00, - HALF <-> 0b01, - WORD <-> 0b10, - DOUBLE <-> 0b11 -} - -mapping size_mnemonic : word_width <-> string = { - BYTE <-> "b", - HALF <-> "h", - WORD <-> "w", - DOUBLE <-> "d" -} diff --git a/riscv/riscv_vmem.sail b/riscv/riscv_vmem.sail deleted file mode 100644 index b617d297..00000000 --- a/riscv/riscv_vmem.sail +++ /dev/null @@ -1,406 +0,0 @@ -/* Supervisor-mode address translation and page-table walks. */ - -/* PageSize */ - -let PAGESIZE_BITS = 12 - -/* PTE attributes, permission checks and updates */ - -type pteAttribs = bits(8) - -bitfield PTE_Bits : pteAttribs = { - D : 7, - A : 6, - G : 5, - U : 4, - X : 3, - W : 2, - R : 1, - V : 0 -} - -function isPTEPtr(p : pteAttribs) -> bool = { - let a = Mk_PTE_Bits(p); - a.R() == false & a.W() == false & a.X() == false -} - -function isInvalidPTE(p : pteAttribs) -> bool = { - let a = Mk_PTE_Bits(p); - a.V() == false | (a.W() == true & a.R() == false) -} - -function checkPTEPermission(ac : AccessType, priv : Privilege, mxr : bool, do_sum : bool, p : PTE_Bits) -> bool = { - match (ac, priv) { - (Read, User) => p.U() == true & (p.R() == true | (p.X() == true & mxr)), - (Write, User) => p.U() == true & p.W() == true, - (ReadWrite, User) => p.U() == true & p.W() == true & (p.R() == true | (p.X() == true & mxr)), - (Execute, User) => p.U() == true & p.X() == true, - - (Read, Supervisor) => (p.U() == false | do_sum) & (p.R() == true | (p.X() == true & mxr)), - (Write, Supervisor) => (p.U() == false | do_sum) & p.W() == true, - (ReadWrite, Supervisor) => (p.U() == false | do_sum) & p.W() == true & (p.R() == true | (p.X() == true & mxr)), - (Execute, Supervisor) => p.U() == false & p.X() == true, - - (_, Machine) => internal_error("m-mode mem perm check") - } -} - -function update_PTE_Bits(p : PTE_Bits, a : AccessType) -> option(PTE_Bits) = { - let update_d = (a == Write | a == ReadWrite) & p.D() == false; // dirty-bit - let update_a = p.A() == false; // accessed-bit - if update_d | update_a then { - let np = update_A(p, true); - let np = if update_d then update_D(np, true) else np; - Some(np) - } else None() -} - -/* failure modes for address-translation/page-table-walks */ -enum PTW_Error = { - PTW_Access, /* physical memory access error for a PTE */ - PTW_Invalid_PTE, - PTW_No_Permission, - PTW_Misaligned, /* misaligned superpage */ - PTW_PTE_Update /* PTE update needed but not enabled */ -} -val cast ptw_error_to_str : PTW_Error -> string -function ptw_error_to_str(e) = - match (e) { - PTW_Access => "mem-access-error", - PTW_Invalid_PTE => "invalid-pte", - PTW_No_Permission => "no-permission", - PTW_Misaligned => "misaligned-superpage", - PTW_PTE_Update => "pte-update-needed" - } - -/* conversion of these translation/PTW failures into architectural exceptions */ -function translationException(a : AccessType, f : PTW_Error) -> ExceptionType = { - let e : ExceptionType = - match (a, f) { - (ReadWrite, PTW_Access) => E_SAMO_Access_Fault, - (ReadWrite, _) => E_SAMO_Page_Fault, - (Read, PTW_Access) => E_Load_Access_Fault, - (Read, _) => E_Load_Page_Fault, - (Write, PTW_Access) => E_SAMO_Access_Fault, - (Write, _) => E_SAMO_Page_Fault, - (Fetch, PTW_Access) => E_Fetch_Access_Fault, - (Fetch, _) => E_Fetch_Page_Fault - } in { -/* print("translationException(" ^ a ^ ", " ^ f ^ ") -> " ^ e); */ - e - } -} -/* address translation: Sv39 */ - -let SV39_LEVEL_BITS = 9 -let SV39_LEVELS = 3 -let PTE39_LOG_SIZE = 3 -let PTE39_SIZE = 8 - -type vaddr39 = bits(39) -type paddr39 = bits(56) -type pte39 = xlenbits - -bitfield SV39_Vaddr : vaddr39 = { - VPNi : 38 .. 12, - PgOfs : 11 .. 0 -} - -bitfield SV39_Paddr : paddr39 = { - PPNi : 55 .. 12, - PgOfs : 11 .. 0 -} - -bitfield SV39_PTE : pte39 = { - PPNi : 53 .. 10, - RSW : 9 .. 8, - BITS : 7 .. 0 -} - -/* ASID */ - -type asid64 = bits(16) - -function curAsid64() -> asid64 = { - let satp64 = Mk_Satp64(satp); - satp64.Asid() -} - -/* Current page table base from satp */ -function curPTB39() -> paddr39 = { - let satp64 = Mk_Satp64(satp); - EXTZ(shiftl(satp64.PPN(), PAGESIZE_BITS)) -} - -/* Page-table walk. */ - -union PTW_Result = { - PTW_Success: (paddr39, SV39_PTE, paddr39, nat, bool), - PTW_Failure: PTW_Error -} - -val walk39 : (vaddr39, AccessType, Privilege, bool, bool, paddr39, nat, bool) -> PTW_Result effect {rmem, escape} -function walk39(vaddr, ac, priv, mxr, do_sum, ptb, level, global) -> PTW_Result = { - let va = Mk_SV39_Vaddr(vaddr); - let pt_ofs : paddr39 = shiftl(EXTZ(shiftr(va.VPNi(), (level * SV39_LEVEL_BITS))[(SV39_LEVEL_BITS - 1) .. 0]), - PTE39_LOG_SIZE); - let pte_addr = ptb + pt_ofs; - /* FIXME: we assume here that walks only access physical-memory-backed addresses, and not MMIO regions. */ - match (phys_mem_read(Data, EXTZ(pte_addr), 8, false, false, false)) { - MemException(_) => { -/* print("walk39(vaddr=" ^ BitStr(vaddr) ^ " level=" ^ string_of_int(level) - ^ " pt_base=" ^ BitStr(ptb) - ^ " pt_ofs=" ^ BitStr(pt_ofs) - ^ " pte_addr=" ^ BitStr(pte_addr) - ^ ": invalid pte address"); */ - PTW_Failure(PTW_Access) - }, - MemValue(v) => { - let pte = Mk_SV39_PTE(v); - let pbits = pte.BITS(); - let pattr = Mk_PTE_Bits(pbits); - let is_global = global | (pattr.G() == true); -/* print("walk39(vaddr=" ^ BitStr(vaddr) ^ " level=" ^ string_of_int(level) - ^ " pt_base=" ^ BitStr(ptb) - ^ " pt_ofs=" ^ BitStr(pt_ofs) - ^ " pte_addr=" ^ BitStr(pte_addr) - ^ " pte=" ^ BitStr(v)); */ - if isInvalidPTE(pbits) then { -/* print("walk39: invalid pte"); */ - PTW_Failure(PTW_Invalid_PTE) - } else { - if isPTEPtr(pbits) then { - if level == 0 then { - /* last-level PTE contains a pointer instead of a leaf */ -/* print("walk39: last-level pte contains a ptr"); */ - PTW_Failure(PTW_Invalid_PTE) - } else { - /* walk down the pointer to the next level */ - walk39(vaddr, ac, priv, mxr, do_sum, EXTZ(shiftl(pte.PPNi(), PAGESIZE_BITS)), level - 1, is_global) - } - } else { /* leaf PTE */ - if ~ (checkPTEPermission(ac, priv, mxr, do_sum, pattr)) then { -/* print("walk39: pte permission check failure"); */ - PTW_Failure(PTW_No_Permission) - } else { - if level > 0 then { /* superpage */ - /* fixme hack: to get a mask of appropriate size */ - let mask = shiftl(pte.PPNi() ^ pte.PPNi() ^ EXTZ(0b1), level * SV39_LEVEL_BITS) - 1; - if (pte.PPNi() & mask) != EXTZ(0b0) then { - /* misaligned superpage mapping */ -/* print("walk39: misaligned superpage mapping"); */ - PTW_Failure(PTW_Misaligned) - } else { - /* add the appropriate bits of the VPN to the superpage PPN */ - let ppn = pte.PPNi() | (EXTZ(va.VPNi()) & mask); -/* let res = append(ppn, va.PgOfs()); - print("walk39: using superpage: pte.ppn=" ^ BitStr(pte.PPNi()) - ^ " ppn=" ^ BitStr(ppn) ^ " res=" ^ BitStr(res)); */ - PTW_Success(append(ppn, va.PgOfs()), pte, pte_addr, level, is_global) - } - } else { - /* normal leaf PTE */ -/* let res = append(pte.PPNi(), va.PgOfs()); - print("walk39: pte.ppn=" ^ BitStr(pte.PPNi()) ^ " ppn=" ^ BitStr(pte.PPNi()) ^ " res=" ^ BitStr(res)); */ - PTW_Success(append(pte.PPNi(), va.PgOfs()), pte, pte_addr, level, is_global) - } - } - } - } - } - } -} - -/* idealized TLB to model fence.vm and also speed up simulation. */ - -struct TLB39_Entry = { - asid : asid64, - global : bool, - vAddr : vaddr39, /* VPN */ - pAddr : paddr39, /* PPN */ - vMatchMask : vaddr39, /* matching mask for superpages */ - vAddrMask : vaddr39, /* selection mask for superpages */ - pte : SV39_PTE, /* permissions */ - pteAddr : paddr39, /* for dirty writeback */ - age : xlenbits -} - -/* the rreg effect is an artifact of using the cycle counter to provide the age */ -val make_TLB39_Entry : (asid64, bool, vaddr39, paddr39, SV39_PTE, nat, paddr39) -> TLB39_Entry effect {rreg} - -function make_TLB39_Entry(asid, global, vAddr, pAddr, pte, level, pteAddr) = { - let shift : nat = PAGESIZE_BITS + (level * SV39_LEVEL_BITS); - /* fixme hack: use a better idiom for masks */ - let vAddrMask : vaddr39 = shiftl(vAddr ^ vAddr ^ EXTZ(0b1), shift) - 1; - let vMatchMask : vaddr39 = ~ (vAddrMask); - struct { - asid = asid, - global = global, - pte = pte, - pteAddr = pteAddr, - vAddrMask = vAddrMask, - vMatchMask = vMatchMask, - vAddr = vAddr & vMatchMask, - pAddr = shiftl(shiftr(pAddr, shift), shift), - age = mcycle - } -} - -/* TODO: make this a vector or array of entries */ -register tlb39 : option(TLB39_Entry) - -val lookupTLB39 : (asid64, vaddr39) -> option((int, TLB39_Entry)) effect {rreg} -function lookupTLB39(asid, vaddr) = { - match tlb39 { - None() => None(), - Some(e) => if (e.global | (e.asid == asid)) - & (e.vAddr == (e.vMatchMask & vaddr)) - then Some((0, e)) - else None() - } -} - -val addToTLB39 : (asid64, vaddr39, paddr39, SV39_PTE, paddr39, nat, bool) -> unit effect {wreg, rreg} -function addToTLB39(asid, vAddr, pAddr, pte, pteAddr, level, global) = { - let ent = make_TLB39_Entry(asid, global, vAddr, pAddr, pte, level, pteAddr); - tlb39 = Some(ent) -} - -function writeTLB39(idx : int, ent : TLB39_Entry) -> unit = - tlb39 = Some(ent) - -val flushTLB : (option(asid64), option(vaddr39)) -> unit effect {rreg, wreg} -function flushTLB(asid, addr) = { - let ent : option(TLB39_Entry) = - match (tlb39, asid, addr) { - (None(), _, _) => None(), - (Some(e), None(), None()) => None(), - (Some(e), None(), Some(a)) => if e.vAddr == (e.vMatchMask & a) - then None() else Some(e), - (Some(e), Some(i), None()) => if (e.asid == i) & (~ (e.global)) - then None() else Some(e), - (Some(e), Some(i), Some(a)) => if (e.asid == i) & (e.vAddr == (a & e.vMatchMask)) - & (~ (e.global)) - then None() else Some(e) - }; - tlb39 = ent -} - -union TR39_Result = { - TR39_Address : paddr39, - TR39_Failure : PTW_Error -} - -val translate39 : (vaddr39, AccessType, Privilege, bool, bool, nat) -> TR39_Result effect {rreg, wreg, wmv, escape, rmem} -function translate39(vAddr, ac, priv, mxr, do_sum, level) = { - let asid = curAsid64(); - match lookupTLB39(asid, vAddr) { - Some(idx, ent) => { - let pteBits = Mk_PTE_Bits(ent.pte.BITS()); - if ~ (checkPTEPermission(ac, priv, mxr, do_sum, pteBits)) - then TR39_Failure(PTW_No_Permission) - else { - match update_PTE_Bits(pteBits, ac) { - None() => TR39_Address(ent.pAddr | EXTZ(vAddr & ent.vAddrMask)), - Some(pbits) => { - if ~ (plat_enable_dirty_update ()) - then { - /* pte needs dirty/accessed update but that is not enabled */ - TR39_Failure(PTW_PTE_Update) - } else { - /* update PTE entry and TLB */ - n_ent : TLB39_Entry = ent; - n_ent.pte = update_BITS(ent.pte, pbits.bits()); - writeTLB39(idx, n_ent); - /* update page table */ - match checked_mem_write(EXTZ(ent.pteAddr), 8, ent.pte.bits()) { - MemValue(_) => (), - MemException(e) => internal_error("invalid physical address in TLB") - }; - TR39_Address(ent.pAddr | EXTZ(vAddr & ent.vAddrMask)) - } - } - } - } - }, - None() => { - match walk39(vAddr, ac, priv, mxr, do_sum, curPTB39(), level, false) { - PTW_Failure(f) => TR39_Failure(f), - PTW_Success(pAddr, pte, pteAddr, level, global) => { - match update_PTE_Bits(Mk_PTE_Bits(pte.BITS()), ac) { - None() => { - addToTLB39(asid, vAddr, pAddr, pte, pteAddr, level, global); - TR39_Address(pAddr) - }, - Some(pbits) => - if ~ (plat_enable_dirty_update ()) - then { - /* pte needs dirty/accessed update but that is not enabled */ - TR39_Failure(PTW_PTE_Update) - } else { - w_pte : SV39_PTE = update_BITS(pte, pbits.bits()); - match checked_mem_write(EXTZ(pteAddr), 8, w_pte.bits()) { - MemValue(_) => { - addToTLB39(asid, vAddr, pAddr, w_pte, pteAddr, level, global); - TR39_Address(pAddr) - }, - MemException(e) => { - /* pte is not in valid memory */ - TR39_Failure(PTW_Access) - } - } - } - } - } - } - } - } -} - -/* Address translation mode */ - -val translationMode : (Privilege) -> SATPMode effect {rreg, escape} -function translationMode(priv) = { - if priv == Machine then Sbare - else { - let arch = architecture(mstatus.SXL()); - match arch { - Some(RV64) => { - let mbits : satp_mode = Mk_Satp64(satp).Mode(); - match satpMode_of_bits(RV64, mbits) { - Some(m) => m, - None() => internal_error("invalid RV64 translation mode in satp") - } - }, - _ => internal_error("unsupported address translation arch") - } - } -} - -union TR_Result = { - TR_Address : xlenbits, - TR_Failure : ExceptionType -} - -/* Top-level address translation dispatcher */ - -val translateAddr : (xlenbits, AccessType, ReadType) -> TR_Result effect {escape, rmem, rreg, wmv, wreg} -function translateAddr(vAddr, ac, rt) = { - let effPriv : Privilege = match rt { - Instruction => cur_privilege, - Data => if mstatus.MPRV() == true - then privLevel_of_bits(mstatus.MPP()) - else cur_privilege - }; - let mxr : bool = mstatus.MXR() == true; - let do_sum : bool = mstatus.SUM() == true; - let mode : SATPMode = translationMode(effPriv); - match mode { - Sbare => TR_Address(vAddr), - SV39 => match translate39(vAddr[38 .. 0], ac, effPriv, mxr, do_sum, SV39_LEVELS - 1) { - TR39_Address(pa) => TR_Address(EXTZ(pa)), - TR39_Failure(f) => TR_Failure(translationException(ac, f)) - }, - _ => internal_error("unsupported address translation scheme") - } -} diff --git a/riscv/rvfi_dii.sail b/riscv/rvfi_dii.sail deleted file mode 100644 index 9680ab49..00000000 --- a/riscv/rvfi_dii.sail +++ /dev/null @@ -1,98 +0,0 @@ -// "RISC-V Formal Interface - Direct Instruction Injection" support -// For use with https://github.com/CTSRD-CHERI/TestRIG - -$define RVFI_DII - -bitfield RVFI_DII_Instruction_Packet : bits(64) = { - padding : 63 .. 56, // [7] - rvfi_cmd : 55 .. 48, // [6] This token is a trace command. For example, reset device under test. - rvfi_time : 47 .. 32, // [5 - 4] Time to inject token. The difference between this and the previous - // instruction time gives a delay before injecting this instruction. - // This can be ignored for models but gives repeatability for implementations - // while shortening counterexamples. - rvfi_insn : 31 .. 0, // [0 - 3] Instruction word: 32-bit instruction or command. The lower 16-bits - // may decode to a 16-bit compressed instruction. -} - -register rvfi_instruction : RVFI_DII_Instruction_Packet - -val rvfi_set_instr_packet : bits(64) -> unit effect {wreg} - -function rvfi_set_instr_packet(p) = - rvfi_instruction = Mk_RVFI_DII_Instruction_Packet(p) - -val rvfi_get_cmd : unit -> bits(8) effect {rreg} - -function rvfi_get_cmd () = rvfi_instruction.rvfi_cmd() - -val print_instr_packet : bits(64) -> unit - -function print_instr_packet(bs) = { - let p = Mk_RVFI_DII_Instruction_Packet(bs); - print_bits("command", p.rvfi_cmd()); - print_bits("instruction", p.rvfi_insn()) -} - -bitfield RVFI_DII_Execution_Packet : bits(704) = { - rvfi_intr : 703 .. 696, // [87] Trap handler: Set for first instruction in trap handler. - rvfi_halt : 695 .. 688, // [86] Halt indicator: Marks the last instruction retired - // before halting execution. - rvfi_trap : 687 .. 680, // [85] Trap indicator: Invalid decode, misaligned access or - // jump command to misaligned address. - rvfi_rd_addr : 679 .. 672, // [84] Write register address: MUST be 0 if not used. - rvfi_rs2_addr : 671 .. 664, // [83] otherwise set as decoded. - rvfi_rs1_addr : 663 .. 656, // [82] Read register addresses: Can be arbitrary when not used, - rvfi_mem_wmask : 655 .. 648, // [81] Write mask: Indicates valid bytes written. 0 if unused. - rvfi_mem_rmask : 647 .. 640, // [80] Read mask: Indicates valid bytes read. 0 if unused. - rvfi_mem_wdata : 639 .. 576, // [72 - 79] Write data: Data written to memory by this command. - rvfi_mem_rdata : 575 .. 512, // [64 - 71] Read data: Data read from mem_addr (i.e. before write) - rvfi_mem_addr : 511 .. 448, // [56 - 63] Memory access addr: Points to byte address (aligned if define - // is set). *Should* be straightforward. - // 0 if unused. - rvfi_rd_wdata : 447 .. 384, // [48 - 55] Write register value: MUST be 0 if rd_ is 0. - rvfi_rs2_data : 383 .. 320, // [40 - 47] above. Must be 0 if register ID is 0. - rvfi_rs1_data : 319 .. 256, // [32 - 39] Read register values: Values as read from registers named - rvfi_insn : 255 .. 192, // [24 - 31] Instruction word: 32-bit command value. - rvfi_pc_wdata : 191 .. 128, // [16 - 23] PC after instr: Following PC - either PC + 4 or jump/trap target. - rvfi_pc_rdata : 127 .. 64, // [08 - 15] PC before instr: PC for current instruction - rvfi_order : 63 .. 0, // [00 - 07] Instruction number: INSTRET value after completion. -} - -register rvfi_exec : RVFI_DII_Execution_Packet - -val rvfi_zero_exec_packet : unit -> unit effect {wreg} - -function rvfi_zero_exec_packet () = - rvfi_exec = Mk_RVFI_DII_Execution_Packet(zero_extend(0b0,704)) - -val rvfi_halt_exec_packet : unit -> unit effect {wreg} - -function rvfi_halt_exec_packet () = - rvfi_exec->rvfi_halt() = 0x01 - -val rvfi_get_exec_packet : unit -> bits(704) effect {rreg} - -function rvfi_get_exec_packet() = rvfi_exec.bits() - -val print_rvfi_exec : unit -> unit effect {rreg} - -function print_rvfi_exec () = { - print_bits("rvfi_intr : ", rvfi_exec.rvfi_intr()); - print_bits("rvfi_halt : ", rvfi_exec.rvfi_halt()); - print_bits("rvfi_trap : ", rvfi_exec.rvfi_trap()); - print_bits("rvfi_rd_addr : ", rvfi_exec.rvfi_rd_addr()); - print_bits("rvfi_rs2_addr : ", rvfi_exec.rvfi_rs2_addr()); - print_bits("rvfi_rs1_addr : ", rvfi_exec.rvfi_rs1_addr()); - print_bits("rvfi_mem_wmask: ", rvfi_exec.rvfi_mem_wmask()); - print_bits("rvfi_mem_rmask: ", rvfi_exec.rvfi_mem_rmask()); - print_bits("rvfi_mem_wdata: ", rvfi_exec.rvfi_mem_wdata()); - print_bits("rvfi_mem_rdata: ", rvfi_exec.rvfi_mem_rdata()); - print_bits("rvfi_mem_addr : ", rvfi_exec.rvfi_mem_addr()); - print_bits("rvfi_rd_wdata : ", rvfi_exec.rvfi_rd_wdata()); - print_bits("rvfi_rs2_data : ", rvfi_exec.rvfi_rs2_data()); - print_bits("rvfi_rs1_data : ", rvfi_exec.rvfi_rs1_data()); - print_bits("rvfi_insn : ", rvfi_exec.rvfi_insn()); - print_bits("rvfi_pc_wdata : ", rvfi_exec.rvfi_pc_wdata()); - print_bits("rvfi_pc_rdata : ", rvfi_exec.rvfi_pc_rdata()); - print_bits("rvfi_order : ", rvfi_exec.rvfi_order()); -} diff --git a/riscv/tracecmp.ml b/riscv/tracecmp.ml deleted file mode 100644 index 64a918d5..00000000 --- a/riscv/tracecmp.ml +++ /dev/null @@ -1,300 +0,0 @@ -(* Simple trace comparison checker *) - -type csr_read = { - csrr : string; - rdval : int64 -} - -type csr_write = { - csrw : string; - wrval : int64; - inval : int64 -} - -type reg_write = { - reg : int; - rval : int64 -} - -type inst = { - count : int; - priv : char; - pc : int64; - inst: int32 -} - -type tick = { - time : int64 -} - -type htif = { - tohost : int64 -} - -type ld_res = - | Res_make of int64 - | Res_match of int64 * int64 - | Res_cancel - -type line = - | L_none - | L_inst of inst - | L_reg_write of reg_write - | L_csr_read of csr_read - | L_csr_write of csr_write - | L_tick of tick - | L_htif of htif - | L_ld_res of ld_res - -let inst_count = ref 0 - -(* csr reads - CSR mscratch -> 0x0000000000000000 - *) - -let parse_csr_read l = - try Scanf.sscanf l " CSR %s -> 0x%Lx" (fun csrr rdval -> L_csr_read { csrr; rdval }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_csr_read r = - Printf.sprintf "CSR %s -> 0x%Lx" r.csrr r.rdval - -(* csr writes - CSR mstatus <- 0x0000000a00020800 (input: 0x0000000a00020800) - *) - -let parse_csr_write l = - try Scanf.sscanf l " CSR %s <- 0x%Lx (input: 0x%Lx)" - (fun csrw wrval inval -> L_csr_write { csrw; wrval; inval }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_csr_write r = - Printf.sprintf "CSR %s <- 0x%Lx (input: 0x%Lx)" r.csrw r.wrval r.inval - -(* reg writes - x16 <- 0x0000000000000000 - *) - -let parse_reg_write l = - try Scanf.sscanf l " x%u <- 0x%Lx" - (fun reg rval -> L_reg_write { reg; rval }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_reg_write r = - Printf.sprintf "x%u <- 0x%Lx" r.reg r.rval - -(* instructions *) - -let sprint_inst r = - Printf.sprintf "[%u] [%c]: 0x%Lx (0x%lx)" r.count r.priv r.pc r.inst - -(* sail instruction line: - [13000] [M]: 0x0000000080000E4A (0x0107971B) slli a4, a5, 0b10000 - *) - -let parse_sail_inst l = - try Scanf.sscanf l " [%u] [%c]: 0x%Lx (0x%lx) %s" - (fun count priv pc inst _ -> - inst_count := count; - L_inst { count; priv; pc; inst }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -(* spike instruction line: - [2] core 0 [M]: 0x0000000000001008 (0xf1402573) csrr a0, mhartid - *) - -let parse_spike_inst l = - try Scanf.sscanf l " [%u] core 0 [%c]: 0x%Lx (0x%lx) %s" - (fun count priv pc inst _ -> - inst_count := count; - L_inst { count; priv; pc; inst }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -(* clock tick - clint::tick mtime <- 0x1 - *) - -let parse_tick l = - try Scanf.sscanf l " clint::tick mtime <- 0x%Lx" - (fun time -> L_tick { time }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_tick t = - Printf.sprintf "clint::tick mtime <- 0x%Lx" t.time - -(* htif tick - htif::tick 0x1 - *) - -let parse_htif l = - try Scanf.sscanf l " htif::tick 0x%Lx" - (fun tohost -> L_htif { tohost }) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_htif t = - Printf.sprintf "htif::tick 0x%Lx" t.tohost - -(* Load reservations: - make: reservation <- 0x80002008 - match: reservation: 0xffffffffffffffff, key=0x80002008 - cancel: reservation <- none - - *) -let parse_ldres_match l = - try Scanf.sscanf - l " reservation: 0x%Lx, key=0x%Lx" - (fun res key -> L_ld_res (Res_match (res, key))) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let parse_ldres_match_sail l = - try Scanf.sscanf - l " reservation: none, key=0x%Lx" - (fun key -> L_ld_res (Res_match (Int64.minus_one, key))) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let parse_ldres_change l = - try if l = "reservation <- none" - then L_ld_res Res_cancel - else Scanf.sscanf - l " reservation <- 0x%Lx" - (fun res -> L_ld_res (Res_make res)) - with - | Scanf.Scan_failure _ -> L_none - | End_of_file -> L_none - -let sprint_ldres = function - | Res_make res -> Printf.sprintf "reservation <- 0x%Lx" res - | Res_match (res, key) -> Printf.sprintf "reservation: 0x%Lx, key=0x%Lx" res key - | Res_cancel -> Printf.sprintf "reservation <- none" - -(* scanners *) - -let popt p l = function - | L_none -> p l - | res -> res - -let parse_line l = - parse_csr_read l |> popt parse_csr_write l - |> popt parse_reg_write l |> popt parse_tick l |> popt parse_htif l - |> popt parse_ldres_change l |> popt parse_ldres_match l - -let parse_sail_line l = - parse_line l |> popt parse_sail_inst l |> popt parse_ldres_match_sail l - -let parse_spike_line l = - parse_line l |> popt parse_spike_inst l - -(* printer *) -let sprint_line = function - | L_none -> "<not-parsed>" - | L_inst i -> sprint_inst i - | L_reg_write r -> Printf.sprintf "<%d> %s" !inst_count (sprint_reg_write r) - | L_csr_read r -> Printf.sprintf "<%d> %s" !inst_count (sprint_csr_read r) - | L_csr_write r -> Printf.sprintf "<%d> %s" !inst_count (sprint_csr_write r) - | L_tick t -> Printf.sprintf "<%d> %s" !inst_count (sprint_tick t) - | L_htif t -> Printf.sprintf "<%d> %s" !inst_count (sprint_htif t) - | L_ld_res r -> Printf.sprintf "<%d> %s" !inst_count (sprint_ldres r) - -(* file processing *) - -let rec get_line ch parse = - let line = try Some (input_line ch) - with End_of_file -> None in - match line with - | Some l -> (match parse l with - | L_none -> get_line ch parse - | r -> r - ) - | None -> L_none - -let rec print_lines ch parse = - match (get_line ch parse) with - | L_none -> () - | l -> (print_endline (sprint_line l); - print_lines ch parse) - - -let lines_matched k l = - match k, l with - (* Special case for CSR writes to sie/sip/sstatus, since spike - * does a recursive call which messes the trace log. For these - * registers, we just match the final written value, and need to - * unfortunately ignore the input value. - *) - | L_csr_write kw, L_csr_write lw -> - if ( (kw.csrw = "mie" && lw.csrw = "sie") - || (kw.csrw = "mip" && lw.csrw = "sip") - || (kw.csrw = "mstatus" && lw.csrw = "sstatus")) - then kw.wrval = lw.wrval - else kw = lw - | _, _ -> k = l - -let rec compare_traces k l cnt = - let kro = get_line k parse_spike_line in - let lro = get_line l parse_sail_line in - match kro, lro with - | L_none, L_none -> - print_endline (Printf.sprintf "Matched %d instructions" cnt) - | L_none, lr -> - print_endline "Spike: not reached"; - print_endline ("Sail: " ^ sprint_line lr); - exit 1 - | kr, L_none -> - print_endline ("Spike: " ^ sprint_line kr); - print_endline "Sail: not reached"; - exit 1 - | kr, lr -> - if lines_matched kr lr - then compare_traces k l (cnt + 1) - else (print_endline ("Spike: " ^ sprint_line kr); - print_endline ("Sail: " ^ sprint_line lr); - exit 1) - -let spike_log = ref (None : string option) -let sail_log = ref (None : string option) -let uncompress = ref false - -let in_file f = - if !uncompress - then Unix.open_process_in ("gunzip -c " ^ f) - else open_in f - -let options = - Arg.align ([( "-z", - Arg.Set uncompress, - " uncompress trace files"); - ( "-k", - Arg.String (fun f -> spike_log := Some f), - " spike trace log"); - ( "-l", - Arg.String (fun f -> sail_log := Some f), - " sail trace log")]) -let usage = "usage: tracecmp [options]\n" - -let _ = - Arg.parse options (fun s -> print_endline usage; exit 0) - usage; - match !spike_log, !sail_log with - | None, None -> (print_endline usage; exit 0) - | Some l, None -> print_lines (in_file l) parse_spike_line - | None, Some l -> print_lines (in_file l) parse_sail_line - | Some k, Some l -> compare_traces (in_file k) (in_file l) 0 - |