From 71f4339b60addfa55ce2de1ccceb40aabe63cc31 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Wed, 16 Aug 2017 14:31:25 +0100 Subject: riscv: fix warnings because of unneeded catch-all cases in types.hgen. --- risc-v/hgen/types.hgen | 2 -- 1 file changed, 2 deletions(-) diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 87fc9b95..3c4ae55a 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -107,14 +107,12 @@ let pp_riscv_load_op (unsigned, width) = match (unsigned, width) with | (false, RISCVWORD) -> "lw" | (true, RISCVWORD) -> "lwu" | (_, RISCVDOUBLE) -> "ld" - | _ -> failwith "unexpected load op" let pp_riscv_store_op width = match width with | RISCVBYTE -> "sb" | RISCVHALF -> "sh" | RISCVWORD -> "sw" | RISCVDOUBLE -> "sd" -| _ -> failwith "unexpected store op" let pp_riscv_fence_option = function | 0b0011 -> "rw" -- cgit v1.2.3 From cc46b5a2366cd73d34117590448f6779fac4d312 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 17 Aug 2017 13:41:21 +0100 Subject: added RISC-V load-acquire --- etc/regfp.sail | 8 ++++- risc-v/hgen/ast.hgen | 2 +- risc-v/hgen/fold.hgen | 2 +- risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 5 +-- risc-v/hgen/lexer.hgen | 22 ++++++++----- risc-v/hgen/map.hgen | 2 +- risc-v/hgen/parser.hgen | 2 +- risc-v/hgen/pretty.hgen | 3 +- risc-v/hgen/sail_trans_out.hgen | 3 +- risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 3 +- risc-v/hgen/token_types.hgen | 2 +- risc-v/hgen/trans_sail.hgen | 3 +- risc-v/hgen/types.hgen | 7 +++-- risc-v/riscv.sail | 45 +++++++++++++++++---------- risc-v/riscv_extras.lem | 6 ++-- risc-v/riscv_extras_embed.lem | 13 +++++--- risc-v/riscv_extras_embed_sequential.lem | 14 ++++++--- risc-v/riscv_regfp.sail | 12 +++++-- src/lem_interp/sail_impl_base.lem | 2 ++ 19 files changed, 104 insertions(+), 52 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index fb15310a..c98e3fa4 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -37,7 +37,10 @@ typedef read_kind = enumerate { Read_acquire; Read_exclusive; Read_exclusive_acquire; - Read_stream + Read_stream; + Read_RISCV_acquire; + Read_RISCV_reserved; + Read_RISCV_reserved_acquire; } typedef write_kind = enumerate { @@ -62,6 +65,9 @@ typedef barrier_kind = enumerate { Barrier_DSB_LD; Barrier_ISB; Barrier_MIPS_SYNC; + Barrier_RISCV_rw_rw; + Barrier_RISCV_r_rw; + Barrier_RISCV_rw_w; } typedef trans_kind = enumerate { diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index 8983b5ae..6e323e85 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -5,7 +5,7 @@ | `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 +| `RISCVLoad of bit12 * reg * reg * bool * wordWidth * bool | `RISCVStore of bit12 * reg * reg * wordWidth | `RISCVADDIW of bit12 * reg * reg | `RISCVSHIFTW of bit5 * reg * reg * riscvSop diff --git a/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen index 03318805..be91659b 100644 --- a/risc-v/hgen/fold.hgen +++ b/risc-v/hgen/fold.hgen @@ -6,7 +6,7 @@ | `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)) +| `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)) diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index 50026612..0e8bfdc2 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -30,12 +30,13 @@ translate_reg "rs1" rs1, translate_reg "rd" rd, translate_rop op) -| `RISCVLoad(imm, rs, rd, unsigned, width) -> LOAD( +| `RISCVLoad(imm, rs, rd, unsigned, width, aq) -> LOAD( translate_imm12 "imm" imm, translate_reg "rs" rs, translate_reg "rd" rd, translate_bool "unsigned" unsigned, - translate_wordWidth width) + translate_wordWidth width, + translate_bool "aq" aq) | `RISCVStore(imm, rs, rd, width) -> STORE ( translate_imm12 "imm" imm, translate_reg "rs" rs, diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index 5f2c8326..c4408139 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -33,13 +33,21 @@ "or", RTYPE{op=RISCVOR}; "and", RTYPE{op=RISCVAND}; -"lb", LOAD{unsigned=false; width=RISCVBYTE}; -"lbu", LOAD{unsigned=true; width=RISCVBYTE}; -"lh", LOAD{unsigned=false; width=RISCVHALF}; -"lhu", LOAD{unsigned=true; width=RISCVHALF}; -"lw", LOAD{unsigned=false; width=RISCVWORD}; -"lwu", LOAD{unsigned=true; width=RISCVWORD}; -"ld", LOAD{unsigned=false; width=RISCVDOUBLE}; +"lb", LOAD{unsigned=false; width=RISCVBYTE; aq=false}; +"lbu", LOAD{unsigned=true; width=RISCVBYTE; aq=false}; +"lh", LOAD{unsigned=false; width=RISCVHALF; aq=false}; +"lhu", LOAD{unsigned=true; width=RISCVHALF; aq=false}; +"lw", LOAD{unsigned=false; width=RISCVWORD; aq=false}; +"lwu", LOAD{unsigned=true; width=RISCVWORD; aq=false}; +"ld", LOAD{unsigned=false; width=RISCVDOUBLE; aq=false}; + +"lb.aq", LOAD{unsigned=false; width=RISCVBYTE; aq=true}; +"lbu.aq", LOAD{unsigned=true; width=RISCVBYTE; aq=true}; +"lh.aq", LOAD{unsigned=false; width=RISCVHALF; aq=true}; +"lhu.aq", LOAD{unsigned=true; width=RISCVHALF; aq=true}; +"lw.aq", LOAD{unsigned=false; width=RISCVWORD; aq=true}; +"lwu.aq", LOAD{unsigned=true; width=RISCVWORD; aq=true}; +"ld.aq", LOAD{unsigned=false; width=RISCVDOUBLE; aq=true}; "sb", STORE{width=RISCVBYTE}; "sh", STORE{width=RISCVHALF}; diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen index ff14c428..1deacc06 100644 --- a/risc-v/hgen/map.hgen +++ b/risc-v/hgen/map.hgen @@ -5,7 +5,7 @@ | `RISCVIType (x, r0, r1, y) -> `RISCVIType (x, map_reg r0, map_reg r1, y) | `RISCVShiftIop (x, r0, r1, y) -> `RISCVShiftIop (x, map_reg r0, map_reg r1, y) | `RISCVRType (r0, r1, r2, y) -> `RISCVRType (r0, map_reg r1, map_reg r2, y) -| `RISCVLoad (x, r0, r1, y, z) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z) +| `RISCVLoad (x, r0, r1, y, z, a) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z, a) | `RISCVStore (x, r0, r1, y) -> `RISCVStore (x, map_reg r0, map_reg r1, y) | `RISCVADDIW (x, r0, r1) -> `RISCVADDIW (x, map_reg r0, map_reg r1) | `RISCVSHIFTW (x, r0, r1, y) -> `RISCVSHIFTW (x, map_reg r0, map_reg r1, y) diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index 37fd8d8d..10257ecd 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -13,7 +13,7 @@ | RTYPE reg COMMA reg COMMA reg { `RISCVRType ($6, $4, $2, $1.op) } | LOAD reg COMMA NUM LPAR reg RPAR - { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width) } + { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width, $1.aq) } | STORE reg COMMA NUM LPAR reg RPAR { `RISCVStore($4, $2, $6, $1.width) } | ADDIW reg COMMA reg COMMA NUM diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index 1da3ef11..6c4f3e53 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -7,7 +7,8 @@ | `RISCVIType(imm, rs2, rs1, op) -> sprintf "%s %s, %s, %d" (pp_riscv_iop op) (pp_reg rs1) (pp_reg rs2) imm | `RISCVShiftIop(imm, rs, rd, op) -> sprintf "%s %s, %s, %d" (pp_riscv_sop op) (pp_reg rd) (pp_reg rs) imm | `RISCVRType (rs2, rs1, rd, op) -> sprintf "%s %s, %s, %s" (pp_riscv_rop op) (pp_reg rd) (pp_reg rs1) (pp_reg rs2) -| `RISCVLoad(imm, rs, rd, unsigned, width) -> sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width)) (pp_reg rd) imm (pp_reg rs) +| `RISCVLoad(imm, rs, rd, unsigned, width, aq) + -> sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width, aq)) (pp_reg rd) imm (pp_reg rs) | `RISCVStore(imm, rs2, rs1, width) -> sprintf "%s %s, %d(%s)" (pp_riscv_store_op width) (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 diff --git a/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index dca5bea1..2a161bda 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -6,7 +6,8 @@ | ("ITYPE", [imm; rs1; rd; op]) -> `RISCVIType(translate_out_simm12 imm, translate_out_ireg rs1, translate_out_ireg rd, translate_out_iop op) | ("SHIFTIOP", [imm; rs; rd; op]) -> `RISCVShiftIop(translate_out_imm6 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op) | ("RTYPE", [rs2; rs1; rd; op]) -> `RISCVRType (translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_rop op) -| ("LOAD", [imm; rs; rd; unsigned; width]) -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width) +| ("LOAD", [imm; rs; rd; unsigned; width; aq]) + -> `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) | ("STORE", [imm; rs; rd; width]) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width) | ("ADDIW", [imm; rs; rd]) -> `RISCVADDIW(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd) | ("SHIFTW", [imm; rs; rd; op]) -> `RISCVSHIFTW(translate_out_imm5 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index 6158ebd7..c24ecd8f 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -6,7 +6,8 @@ | ITYPE( imm, rs1, rd, op) -> `RISCVIType(translate_out_simm12 imm, translate_out_ireg rs1, translate_out_ireg rd, translate_out_iop op) | SHIFTIOP( imm, rs, rd, op) -> `RISCVShiftIop(translate_out_imm6 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op) | RTYPE( rs2, rs1, rd, op) -> `RISCVRType (translate_out_ireg rs2, translate_out_ireg rs1, translate_out_ireg rd, translate_out_rop op) -| LOAD( imm, rs, rd, unsigned, width) -> `RISCVLoad(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_bool unsigned, translate_out_wordWidth width) +| LOAD( imm, rs, rd, unsigned, width, aq) + -> `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) | STORE( imm, rs, rd, width) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width) | ADDIW( imm, rs, rd) -> `RISCVADDIW(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd) | SHIFTW( imm, rs, rd, op) -> `RISCVSHIFTW(translate_out_imm5 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_sop op) diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index 2980b985..ca19c6eb 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -5,7 +5,7 @@ type token_BType = {op : riscvBop } type token_IType = {op : riscvIop } type token_ShiftIop = {op : riscvSop } type token_RTYPE = {op : riscvRop } -type token_Load = {unsigned: bool; width : wordWidth } +type token_Load = {unsigned: bool; width : wordWidth; aq: bool } type token_Store = {width : wordWidth } type token_ADDIW = unit type token_SHIFTW = {op : riscvSop } diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index df22d9dc..7fdfd516 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -58,7 +58,7 @@ translate_rop "op" op; ], []) -| `RISCVLoad(imm, rs, rd, unsigned, width) -> +| `RISCVLoad(imm, rs, rd, unsigned, width, aq) -> ("LOAD", [ translate_imm12 "imm" imm; @@ -66,6 +66,7 @@ translate_reg "rd" rd; translate_bool "unsigned" unsigned; translate_width "width" width; + translate_bool "aq" aq; ], []) | `RISCVStore(imm, rs2, rs1, width) -> diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 87fc9b95..bb6d164c 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -99,7 +99,8 @@ type wordWidth = | RISCVWORD | RISCVDOUBLE -let pp_riscv_load_op (unsigned, width) = match (unsigned, width) with +let pp_riscv_load_op (unsigned, width, aq) = + begin match (unsigned, width) with | (false, RISCVBYTE) -> "lb" | (true, RISCVBYTE) -> "lbu" | (false, RISCVHALF) -> "lh" @@ -107,7 +108,9 @@ let pp_riscv_load_op (unsigned, width) = match (unsigned, width) with | (false, RISCVWORD) -> "lw" | (true, RISCVWORD) -> "lwu" | (_, RISCVDOUBLE) -> "ld" - | _ -> failwith "unexpected load op" + | _ -> failwith "unexpected load op" + end + ^ (if aq then ".aq" else "") let pp_riscv_store_op width = match width with | RISCVBYTE -> "sb" diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 4a80adb0..c9ba5256 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -58,6 +58,17 @@ function forall 'a. 'a effect { escape } not_implemented((string) message) = } val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_acquire +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_acquire +function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) res) = + switch (aq, res) { + case (false, false) -> MEMr(addr, width) + case (true, false) -> MEMr_acquire(addr, width) + case (false, true) -> MEMr_reserved(addr, width) + case (true, true) -> MEMr_reserved_acquire(addr, width) + } + val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval val extern unit -> unit effect { barr } MEM_fence_rw_rw @@ -202,29 +213,29 @@ function clause execute (RTYPE(rs2, rs1, rd, op)) = } in wGPR(rd, result) -union ast member ((bit[12]), regno, regno, bool, word_width) LOAD -function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, DOUBLE)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD)) -function clause execute(LOAD(imm, rs1, rd, unsigned, width)) = +union ast member ((bit[12]), regno, regno, bool, word_width, bool) LOAD +function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, DOUBLE, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD, false)) +function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in let (bit[64]) result = if unsigned then switch (width) { - case BYTE -> EXTZ(MEMr(addr, 1)) - case HALF -> EXTZ(MEMr(addr, 2)) - case WORD -> EXTZ(MEMr(addr, 4)) - case DOUBLE -> MEMr(addr, 8) + case BYTE -> EXTZ(mem_read(addr, 1, aq, false)) + case HALF -> EXTZ(mem_read(addr, 2, aq, false)) + case WORD -> EXTZ(mem_read(addr, 4, aq, false)) + case DOUBLE -> mem_read(addr, 8, aq, false) } else switch (width) { - case BYTE -> EXTS(MEMr(addr, 1)) - case HALF -> EXTS(MEMr(addr, 2)) - case WORD -> EXTS(MEMr(addr, 4)) - case DOUBLE -> MEMr(addr, 8) + case BYTE -> EXTS(mem_read(addr, 1, aq, false)) + case HALF -> EXTS(mem_read(addr, 2, aq, false)) + case WORD -> EXTS(mem_read(addr, 4, aq, false)) + case DOUBLE -> mem_read(addr, 8, aq, false) } in wGPR(rd, result) diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index aa5d8fb8..80f8bcc9 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -32,8 +32,10 @@ let memory_parameter_transformer_option_address _mode v = let read_memory_functions : memory_reads = - [ ("MEMr", (MR Read_plain memory_parameter_transformer)); - ("MEMr_reserve", (MR Read_reserve memory_parameter_transformer)); + [ ("MEMr", (MR Read_plain memory_parameter_transformer)); + ("MEMr_acquire", (MR Read_RISCV_acquire memory_parameter_transformer)); + ("MEMr_reserved", (MR Read_RISCV_reserved memory_parameter_transformer)); + ("MEMr_reserved_acquire", (MR Read_RISCV_reserved_acquire memory_parameter_transformer)); ] let memory_writes : memory_writes = diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index 1146d1cd..440ad378 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -4,11 +4,16 @@ open import Sail_impl_base open import Sail_values open import Prompt -val MEMr : (vector bitU * integer) -> M (vector bitU) -val MEMr_reserve : (vector bitU * integer) -> M (vector bitU) +val MEMr : (vector bitU * integer) -> M (vector bitU) +val MEMr_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved_acquire : (vector bitU * integer) -> M (vector bitU) + +let MEMr (addr,size) = read_mem false Read_plain addr size +let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr size +let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size +let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size -let MEMr (addr,size) = read_mem false Read_plain addr size -let MEMr_reserve (addr,size) = read_mem false Read_reserve addr size val MEMea : (vector bitU * integer) -> M unit val MEMea_conditional : (vector bitU * integer) -> M unit diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index f6709ff7..518a5a15 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -4,11 +4,15 @@ open import Sail_impl_base open import Sail_values open import State -val MEMr : (vector bitU * integer) -> M (vector bitU) -val MEMr_reserve : (vector bitU * integer) -> M (vector bitU) - -let MEMr (addr,size) = read_mem false Read_plain addr size -let MEMr_reserve (addr,size) = read_mem false Read_reserve addr size +val MEMr : (vector bitU * integer) -> M (vector bitU) +val MEMr_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved_acquire : (vector bitU * integer) -> M (vector bitU) + +let MEMr (addr,size) = read_mem false Read_plain addr size +let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr size +let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size +let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size val MEMea : (vector bitU * integer) -> M unit val MEMea_conditional : (vector bitU * integer) -> M unit diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index 0c7a67d8..fe0efa43 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -51,11 +51,11 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; } - case (LOAD ( imm, rs, rd, unsign, width)) -> { (* XXX "unsigned" causes name conflict in lem shallow embedding... *) + case (LOAD ( imm, rs, rd, unsign, width, aq)) -> { (* XXX "unsigned" causes name conflict in lem shallow embedding... *) if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; aR := iR; - ik := IK_mem_read (Read_plain); + ik := if aq then IK_mem_read (Read_RISCV_acquire) else IK_mem_read (Read_plain); } case (STORE( imm, rs2, rs1, width)) -> { if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; @@ -77,7 +77,13 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; } case (FENCE(pred, succ)) -> { - ik := IK_barrier (Barrier_MIPS_SYNC); + ik := + switch(pred, succ) { + case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) + case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) + case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) + case _ -> exit "unsupported fence" + }; } }; (iR,oR,aR,Nias,Dia,ik) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index cda6702c..1642bc81 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -426,6 +426,8 @@ type read_kind = | Read_reserve (* AArch64 reads *) | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream + (* RISC-V reads *) + | Read_RISCV_acquire | Read_RISCV_reserved | Read_RISCV_reserved_acquire instance (Show read_kind) let show = function -- cgit v1.2.3 From 9a26a0440f4d3c63ea19976c44cd39edb8149b2a Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Sat, 19 Aug 2017 10:34:04 +0100 Subject: RISC-V store-release --- etc/regfp.sail | 3 ++ risc-v/hgen/ast.hgen | 2 +- risc-v/hgen/fold.hgen | 2 +- risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 5 ++- risc-v/hgen/lexer.hgen | 13 ++++-- risc-v/hgen/map.hgen | 2 +- risc-v/hgen/parser.hgen | 2 +- risc-v/hgen/pretty.hgen | 3 +- risc-v/hgen/sail_trans_out.hgen | 3 +- risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 3 +- risc-v/hgen/token_types.hgen | 2 +- risc-v/hgen/trans_sail.hgen | 3 +- risc-v/hgen/types.hgen | 13 +++--- risc-v/riscv.sail | 58 ++++++++++++++++++++------- risc-v/riscv_extras.lem | 22 +++++++--- risc-v/riscv_extras_embed.lem | 31 ++++++++------ risc-v/riscv_extras_embed_sequential.lem | 31 ++++++++------ risc-v/riscv_regfp.sail | 4 +- src/lem_interp/sail_impl_base.lem | 11 +++++ 19 files changed, 147 insertions(+), 66 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index c98e3fa4..71f53547 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -50,6 +50,9 @@ typedef write_kind = enumerate { Write_release; Write_exclusive; Write_exclusive_release; + Write_RISCV_release; + Write_RISCV_conditional; + Write_RISCV_conditional_release; } typedef barrier_kind = enumerate { diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index 6e323e85..d5e4b45b 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -6,7 +6,7 @@ | `RISCVShiftIop of bit6 * reg * reg * riscvSop | `RISCVRType of reg * reg * reg * riscvRop | `RISCVLoad of bit12 * reg * reg * bool * wordWidth * bool -| `RISCVStore of bit12 * reg * reg * wordWidth +| `RISCVStore of bit12 * reg * reg * wordWidth * bool | `RISCVADDIW of bit12 * reg * reg | `RISCVSHIFTW of bit5 * reg * reg * riscvSop | `RISCVRTYPEW of reg * reg * reg * riscvRopw diff --git a/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen index be91659b..376ab19f 100644 --- a/risc-v/hgen/fold.hgen +++ b/risc-v/hgen/fold.hgen @@ -7,7 +7,7 @@ | `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)) +| `RISCVStore (_, r0, r1, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) | `RISCVADDIW (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) | `RISCVSHIFTW (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) | `RISCVRTYPEW (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg))) diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index 0e8bfdc2..d756d3d0 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -37,11 +37,12 @@ translate_bool "unsigned" unsigned, translate_wordWidth width, translate_bool "aq" aq) -| `RISCVStore(imm, rs, rd, width) -> STORE ( +| `RISCVStore(imm, rs, rd, width, rl) -> STORE ( translate_imm12 "imm" imm, translate_reg "rs" rs, translate_reg "rd" rd, - translate_wordWidth width) + translate_wordWidth width, + translate_bool "rl" rl) | `RISCVADDIW(imm, rs, rd) -> ADDIW( translate_imm12 "imm" imm, translate_reg "rs" rs, diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index c4408139..40481f75 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -49,10 +49,15 @@ "lwu.aq", LOAD{unsigned=true; width=RISCVWORD; aq=true}; "ld.aq", LOAD{unsigned=false; width=RISCVDOUBLE; aq=true}; -"sb", STORE{width=RISCVBYTE}; -"sh", STORE{width=RISCVHALF}; -"sw", STORE{width=RISCVWORD}; -"sd", STORE{width=RISCVDOUBLE}; +"sb", STORE{width=RISCVBYTE; rl=false}; +"sh", STORE{width=RISCVHALF; rl=false}; +"sw", STORE{width=RISCVWORD; rl=false}; +"sd", STORE{width=RISCVDOUBLE; rl=false}; + +"sb.rl", STORE{width=RISCVBYTE; rl=true}; +"sh.rl", STORE{width=RISCVHALF; rl=true}; +"sw.rl", STORE{width=RISCVWORD; rl=true}; +"sd.rl", STORE{width=RISCVDOUBLE; rl=true}; "addiw", ADDIW (); diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen index 1deacc06..edd376b4 100644 --- a/risc-v/hgen/map.hgen +++ b/risc-v/hgen/map.hgen @@ -6,7 +6,7 @@ | `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) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z, a) -| `RISCVStore (x, r0, r1, y) -> `RISCVStore (x, map_reg r0, map_reg r1, y) +| `RISCVStore (x, r0, r1, y, z) -> `RISCVStore (x, map_reg r0, map_reg r1, y, z) | `RISCVADDIW (x, r0, r1) -> `RISCVADDIW (x, map_reg r0, map_reg r1) | `RISCVSHIFTW (x, r0, r1, y) -> `RISCVSHIFTW (x, map_reg r0, map_reg r1, y) | `RISCVRTYPEW (r0, r1, r2, x) -> `RISCVRTYPEW (r0, map_reg r1, map_reg r2, x) diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index 10257ecd..cb31f5a9 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -15,7 +15,7 @@ | LOAD reg COMMA NUM LPAR reg RPAR { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width, $1.aq) } | STORE reg COMMA NUM LPAR reg RPAR - { `RISCVStore($4, $2, $6, $1.width) } + { `RISCVStore($4, $2, $6, $1.width, $1.rl) } | ADDIW reg COMMA reg COMMA NUM { `RISCVADDIW ($6, $4, $2) } | SHIFTW reg COMMA reg COMMA NUM diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index 6c4f3e53..cce77641 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -9,7 +9,8 @@ | `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) -> sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width, aq)) (pp_reg rd) imm (pp_reg rs) -| `RISCVStore(imm, rs2, rs1, width) -> sprintf "%s %s, %d(%s)" (pp_riscv_store_op width) (pp_reg rs2) imm (pp_reg rs1) +| `RISCVStore(imm, rs2, rs1, width, rl) + -> sprintf "%s %s, %d(%s)" (pp_riscv_store_op (width, 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) diff --git a/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index 2a161bda..45445a25 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -8,7 +8,8 @@ | ("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]) -> `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) -| ("STORE", [imm; rs; rd; width]) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width) +| ("STORE", [imm; rs; rd; width; rl]) + -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, 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) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index c24ecd8f..abfc0412 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -8,7 +8,8 @@ | 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) -> `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) -| STORE( imm, rs, rd, width) -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width) +| STORE( imm, rs, rd, width, rl) + -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, 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) diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index ca19c6eb..03dde52b 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -6,7 +6,7 @@ type token_IType = {op : riscvIop } type token_ShiftIop = {op : riscvSop } type token_RTYPE = {op : riscvRop } type token_Load = {unsigned: bool; width : wordWidth; aq: bool } -type token_Store = {width : wordWidth } +type token_Store = {width : wordWidth; rl: bool } type token_ADDIW = unit type token_SHIFTW = {op : riscvSop } type token_RTYPEW = {op : riscvRopw } diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index 7fdfd516..9fb3b546 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -69,13 +69,14 @@ translate_bool "aq" aq; ], []) -| `RISCVStore(imm, rs2, rs1, width) -> +| `RISCVStore(imm, rs2, rs1, width, rl) -> ("STORE", [ translate_imm12 "imm" imm; translate_reg "rs2" rs2; translate_reg "rs1" rs1; translate_width "width" width; + translate_bool "rl" rl; ], []) | `RISCVADDIW(imm, rs, rd) -> diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 11d0921e..180e0b37 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -111,11 +111,14 @@ let pp_riscv_load_op (unsigned, width, aq) = end ^ (if aq then ".aq" else "") -let pp_riscv_store_op width = match width with -| RISCVBYTE -> "sb" -| RISCVHALF -> "sh" -| RISCVWORD -> "sw" -| RISCVDOUBLE -> "sd" +let pp_riscv_store_op (width, rl) = + begin match width with + | RISCVBYTE -> "sb" + | RISCVHALF -> "sh" + | RISCVWORD -> "sw" + | RISCVDOUBLE -> "sd" + end + ^ (if rl then ".rl" else "") let pp_riscv_fence_option = function | 0b0011 -> "rw" diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index c9ba5256..3b42b94c 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -70,7 +70,37 @@ function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, } val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release +function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl) = + switch rl { + case false -> MEMea(addr, width) + case true -> MEMea_release(addr, width) + } + val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release +function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl) = + switch rl { + case false -> MEMval(addr, width, value) + case true -> MEMval_release(addr, width, value) + } + +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release +function forall Nat 'n. unit effect { eamem } mem_write_conditional_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl) = + switch rl { + case false -> MEMea_conditional(addr, width) + case true -> MEMea_conditional_release(addr, width) + } + +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> bool effect { wmv } MEMval_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> bool effect { wmv } MEMval_conditional_release +function forall Nat 'n. bool effect { wmv } mem_write_conditional_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl) = + switch rl { + case false -> MEMval_conditional(addr, width, value) + case true -> MEMval_conditional_release(addr, width, value) + } + val extern unit -> unit effect { barr } MEM_fence_rw_rw val extern unit -> unit effect { barr } MEM_fence_r_rw val extern unit -> unit effect { barr } MEM_fence_rw_w @@ -239,25 +269,25 @@ function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq)) = } in wGPR(rd, result) -union ast member ((bit[12]), regno, regno, word_width) STORE -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE)) -function clause execute (STORE(imm, rs2, rs1, width)) = +union ast member ((bit[12]), regno, regno, word_width, bool) STORE +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE, false)) +function clause execute (STORE(imm, rs2, rs1, width, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in { switch (width) { - case BYTE -> MEMea(addr, 1) - case HALF -> MEMea(addr, 2) - case WORD -> MEMea(addr, 4) - case DOUBLE -> MEMea(addr, 8) + case BYTE -> mem_write_ea(addr, 1, rl) + case HALF -> mem_write_ea(addr, 2, rl) + case WORD -> mem_write_ea(addr, 4, rl) + case DOUBLE -> mem_write_ea(addr, 8, rl) }; let rs2_val = rGPR(rs2) in switch (width) { - case BYTE -> MEMval(addr, 1, rs2_val[7..0]) - case HALF -> MEMval(addr, 2, rs2_val[15..0]) - case WORD -> MEMval(addr, 4, rs2_val[31..0]) - case DOUBLE -> MEMval(addr, 8, rs2_val) + case BYTE -> mem_write_value(addr, 1, rs2_val[7..0], rl) + case HALF -> mem_write_value(addr, 2, rs2_val[15..0], rl) + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl) } } diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index 80f8bcc9..3803839d 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -42,15 +42,25 @@ let memory_writes : memory_writes = [] let memory_eas : memory_write_eas = - [ ("MEMea", (MEA Write_plain memory_parameter_transformer)); - ("MEMea_conditional", (MEA Write_conditional memory_parameter_transformer)); + [ ("MEMea", (MEA Write_plain memory_parameter_transformer)); + ("MEMea_release", (MEA Write_RISCV_release memory_parameter_transformer)); + ("MEMea_conditional", (MEA Write_RISCV_conditional memory_parameter_transformer)); + ("MEMea_conditional_release", (MEA Write_RISCV_conditional_release memory_parameter_transformer)); ] let memory_vals : memory_write_vals = - [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing)); - ("MEMval_conditional", (MV memory_parameter_transformer_option_address - (Just - (fun (IState interp context) b -> + [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_release", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_conditional", + (MV memory_parameter_transformer_option_address + (Just + (fun (IState interp context) b -> + let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in + (IState (Interp.add_answer_to_stack interp bit) context))))); + ("MEMval_conditional_release", + (MV memory_parameter_transformer_option_address + (Just + (fun (IState interp context) b -> let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in (IState (Interp.add_answer_to_stack interp bit) context))))); ] diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index 440ad378..35d217ff 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -14,18 +14,25 @@ let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr s let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size - -val MEMea : (vector bitU * integer) -> M unit -val MEMea_conditional : (vector bitU * integer) -> M unit - -let MEMea (addr,size) = write_mem_ea Write_plain addr size -let MEMea_conditional (addr,size) = write_mem_ea Write_conditional addr size - -val MEMval : (vector bitU * integer * vector bitU) -> M unit -val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU - -let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +val MEMea : (vector bitU * integer) -> M unit +val MEMea_release : (vector bitU * integer) -> M unit +val MEMea_conditional : (vector bitU * integer) -> M unit +val MEMea_conditional_release : (vector bitU * integer) -> M unit + +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_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 + +val MEMval : (vector bitU * integer * vector bitU) -> M unit +val MEMval_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU +val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M bitU + +let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index 518a5a15..93b5dfec 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -14,18 +14,25 @@ let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr s let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size -val MEMea : (vector bitU * integer) -> M unit -val MEMea_conditional : (vector bitU * integer) -> M unit - -let MEMea (addr,size) = write_mem_ea Write_plain addr size -let MEMea_conditional (addr,size) = write_mem_ea Write_conditional addr size - - -val MEMval : (vector bitU * integer * vector bitU) -> M unit -val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU - -let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +val MEMea : (vector bitU * integer) -> M unit +val MEMea_release : (vector bitU * integer) -> M unit +val MEMea_conditional : (vector bitU * integer) -> M unit +val MEMea_conditional_release : (vector bitU * integer) -> M unit + +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_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 + +val MEMval : (vector bitU * integer * vector bitU) -> M unit +val MEMval_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU +val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M bitU + +let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index fe0efa43..2c94012e 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -57,11 +57,11 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := iR; ik := if aq then IK_mem_read (Read_RISCV_acquire) else IK_mem_read (Read_plain); } - case (STORE( imm, rs2, rs1, width)) -> { + case (STORE( imm, rs2, rs1, width, 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 := IK_mem_write (Write_plain); + ik := if rl then IK_mem_write (Write_RISCV_release) else IK_mem_write (Write_plain); } case (ADDIW ( imm, rs, rd)) -> { if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 1642bc81..caec3838 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -437,6 +437,9 @@ instance (Show read_kind) | Read_exclusive -> "Read_exclusive" | Read_exclusive_acquire -> "Read_exclusive_acquire" | Read_stream -> "Read_stream" + | Read_RISCV_acquire -> "Read_RISCV_acquire" + | Read_RISCV_reserved -> "Read_RISCV_reserved" + | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire" end end @@ -447,6 +450,8 @@ type write_kind = | Write_conditional (* AArch64 writes *) | Write_release | Write_exclusive | Write_exclusive_release + (* RISC-V *) + | Write_RISCV_release | Write_RISCV_conditional | Write_RISCV_conditional_release instance (Show write_kind) let show = function @@ -455,6 +460,9 @@ instance (Show write_kind) | Write_release -> "Write_release" | Write_exclusive -> "Write_exclusive" | Write_exclusive_release -> "Write_exclusive_release" + | Write_RISCV_release -> "Write_RISCV_release" + | Write_RISCV_conditional -> "Write_RISCV_conditional" + | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release" end end @@ -488,6 +496,9 @@ instance (Show barrier_kind) | Barrier_ISB -> "Barrier_ISB" | Barrier_TM_COMMIT -> "Barrier_TM_COMMIT" | Barrier_MIPS_SYNC -> "Barrier_MIPS_SYNC" + | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw" + | Barrier_RISCV_r_rw -> "Barrier_RISCV_r_rw" + | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" end end -- cgit v1.2.3 From 56b661f4d0d4ef4aa5107f73efbee7d7e8df8fea Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Mon, 21 Aug 2017 14:44:12 +0100 Subject: RISC-V load-reserved and store-conditional --- risc-v/hgen/ast.hgen | 2 ++ risc-v/hgen/fold.hgen | 2 ++ risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 17 +++++++++++-- risc-v/hgen/lexer.hgen | 10 ++++++++ risc-v/hgen/map.hgen | 2 ++ risc-v/hgen/parser.hgen | 4 +++ risc-v/hgen/pretty.hgen | 15 ++++++++++++ risc-v/hgen/sail_trans_out.hgen | 4 +++ risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 4 +++ risc-v/hgen/token_types.hgen | 2 ++ risc-v/hgen/tokens.hgen | 2 ++ risc-v/hgen/trans_sail.hgen | 21 ++++++++++++++++ risc-v/hgen/types.hgen | 20 +++++++++++++++ risc-v/riscv.sail | 35 +++++++++++++++++++++++++++ risc-v/riscv_regfp.sail | 22 ++++++++++++++++- 15 files changed, 159 insertions(+), 3 deletions(-) diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index d5e4b45b..a0a59e4a 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -11,3 +11,5 @@ | `RISCVSHIFTW of bit5 * reg * reg * riscvSop | `RISCVRTYPEW of reg * reg * reg * riscvRopw | `RISCVFENCE of bit4 * bit4 +| `RISCVLoadRes of bool * bool * reg * wordWidth * reg +| `RISCVStoreCon of bool * bool * reg * reg * wordWidth * reg diff --git a/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen index 376ab19f..4cbaf779 100644 --- a/risc-v/hgen/fold.hgen +++ b/risc-v/hgen/fold.hgen @@ -11,3 +11,5 @@ | `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))) +| `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))) diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index d756d3d0..ffea1575 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -58,5 +58,18 @@ translate_reg "rd" rd, translate_ropw op) | `RISCVFENCE(pred, succ) -> FENCE( - translate_imm4 "pred" pred, - translate_imm4 "succ" succ) + translate_imm4 "pred" pred, + translate_imm4 "succ" succ) +| `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) diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index 40481f75..abc0ff82 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -75,3 +75,13 @@ "r", FENCEOPTION Fence_R; "w", FENCEOPTION Fence_W; "rw", FENCEOPTION Fence_RW; + +"lr.w", LOADRES {width=RISCVWORD; aq=false; rl=false}; +"lr.w.aq", LOADRES {width=RISCVWORD; aq=true; rl=false}; +"lr.d", LOADRES {width=RISCVDOUBLE; aq=false; rl=false}; +"lr.d.aq", LOADRES {width=RISCVDOUBLE; aq=true; rl=false}; + +"sc.w", STORECON {width=RISCVWORD; aq=false; rl=false}; +"sc.w.rl", STORECON {width=RISCVWORD; aq=false; rl=true}; +"sc.d", STORECON {width=RISCVDOUBLE; aq=false; rl=false}; +"sc.d.rl", STORECON {width=RISCVDOUBLE; aq=false; rl=true}; diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen index edd376b4..639a68bd 100644 --- a/risc-v/hgen/map.hgen +++ b/risc-v/hgen/map.hgen @@ -10,3 +10,5 @@ | `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) +| `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) diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index cb31f5a9..d077c2df 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -34,3 +34,7 @@ | (Fence_W, Fence_R) -> failwith "'fence w,r' is not supported" | (Fence_W, Fence_W) -> failwith "'fence w,w' is not supported" } +| LOADRES reg COMMA LPAR reg RPAR + { `RISCVLoadRes($1.aq, $1.rl, $5, $1.width, $2) } +| STORECON reg COMMA reg COMMA LPAR reg RPAR + { `RISCVStoreCon($1.aq, $1.rl, $4, $7, $1.width, $2) } diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index cce77641..b4516b16 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -15,3 +15,18 @@ | `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(pred, succ) -> sprintf "fence %s, %s" (pp_riscv_fence_option pred) (pp_riscv_fence_option succ) +| `RISCVLoadRes(aq, rl, rs1, width, rd) + -> + assert (rl = false); + 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) + -> + assert (aq = false); + sprintf "%s %s, %s, (%s)" + (pp_riscv_store_conditional_op (aq, rl, width)) + (pp_reg rd) + (pp_reg rs2) + (pp_reg rs1) diff --git a/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index 45445a25..f216180a 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -14,3 +14,7 @@ | ("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(translate_out_imm4 pred, translate_out_imm4 succ) +| ("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) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index abfc0412..01d8dded 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -14,3 +14,7 @@ | 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(translate_out_imm4 pred, translate_out_imm4 succ) +| 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) diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index 03dde52b..c0ef8445 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -11,5 +11,7 @@ type token_ADDIW = unit type token_SHIFTW = {op : riscvSop } type token_RTYPEW = {op : riscvRopw } type token_FENCE = unit +type token_LoadRes = {width : wordWidth; aq: bool; rl: bool } +type token_StoreCon = {width : wordWidth; aq: bool; rl: bool } type token_FENCEOPTION = Fence_R | Fence_W | Fence_RW diff --git a/risc-v/hgen/tokens.hgen b/risc-v/hgen/tokens.hgen index f952cf77..1276fd68 100644 --- a/risc-v/hgen/tokens.hgen +++ b/risc-v/hgen/tokens.hgen @@ -12,3 +12,5 @@ %token RTYPEW %token FENCE %token FENCEOPTION +%token LOADRES +%token STORECON diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index 9fb3b546..4d568fe8 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -112,3 +112,24 @@ translate_imm4 "succ" succ; ], []) +| `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; + ], + []) diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 180e0b37..1471812c 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -120,6 +120,26 @@ let pp_riscv_store_op (width, rl) = end ^ (if rl then ".rl" else "") +let pp_riscv_load_reserved_op (aq, rl, width) = + "lr" ^ + begin match width with + | RISCVWORD -> ".w" + | RISCVDOUBLE -> ".d" + | _ -> assert false + end ^ + (if aq then ".aq" else "") ^ + (if rl then ".rl" else "") + +let pp_riscv_store_conditional_op (aq, rl, width) = + "sc" ^ + 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" diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 3b42b94c..b5a25578 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -353,6 +353,41 @@ union ast member unit EBREAK function clause decode (0b000000000001 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(EBREAK ()) function clause execute EBREAK = { exit () } +union ast member (bool, bool, regno, word_width, regno) LOADRES +function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, WORD, rd)) +function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, DOUBLE, rd)) +function clause execute(LOADRES(aq, rl, rs1, width, rd)) = + if rl then not_implemented("load-reserved-release is not implemented") + else { + let (bit[64]) addr = rGPR(rs1) in + let (bit[64]) result = + switch width { + case WORD -> EXTS(mem_read(addr, 4, aq, true)) + case DOUBLE -> mem_read(addr, 8, aq, true) + } in + wGPR(rd, result) + } + +union ast member (bool, bool, regno, regno, word_width, regno) STORECON +function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, DOUBLE, rd)) +function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { + if aq then not_implemented("store-conditional-acquire is not implemented"); + (bit[64]) addr := rGPR(rs1); + switch width { + case WORD -> mem_write_conditional_ea(addr, 4, rl) + case DOUBLE -> mem_write_conditional_ea(addr, 8, rl) + }; + rs2_val := rGPR(rs2); + (bool) success := + switch width { + case WORD -> mem_write_conditional_value(addr, 4, rs2_val[31..0], rl) + case DOUBLE -> mem_write_conditional_value(addr, 8, rs2_val, rl) + }; + if success then wGPR(rd, 0) + else wGPR(rd, 1); +} + function clause decode _ = None diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index 2c94012e..1cfc68d7 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -82,7 +82,27 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) - case _ -> exit "unsupported fence" + case _ -> exit "not implemented" + }; + } + case (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 := switch (aq, rl) { + case (false, false) -> IK_mem_read (Read_RISCV_reserved) + case (true, false) -> IK_mem_read (Read_RISCV_reserved_acquire) + case (_, true) -> exit "not implemented" + }; + } + case (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; + ik := switch (aq, rl) { + case (false, false) -> IK_mem_write (Write_RISCV_conditional) + case (false, true) -> IK_mem_write (Write_RISCV_conditional_release) + case (true, _) -> exit "not implemented" }; } }; -- cgit v1.2.3 From faf546790ae218522dc0a465059ee4abee3e4135 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 21 Aug 2017 17:40:57 +0100 Subject: port x86 model to old type checker. --- x86/Makefile | 3 + x86/x64.sail | 1333 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1336 insertions(+) create mode 100644 x86/Makefile create mode 100644 x86/x64.sail diff --git a/x86/Makefile b/x86/Makefile new file mode 100644 index 00000000..2bc4c1a4 --- /dev/null +++ b/x86/Makefile @@ -0,0 +1,3 @@ +all: + ../src/sail.native -o x86 -lem -lem_lib X86_extras_embed ../etc/regfp.sail x64.sail + ../src/sail.native -o x86 -lem_ast ../etc/regfp.sail x64.sail diff --git a/x86/x64.sail b/x86/x64.sail new file mode 100644 index 00000000..16c71d12 --- /dev/null +++ b/x86/x64.sail @@ -0,0 +1,1333 @@ +(*========================================================================*) +(* *) +(* 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. *) +(*========================================================================*) + +default Order dec + +val extern forall Type 'a. ('a, list<'a>) -> bool effect pure ismember +val extern forall Type 'a. list<'a> -> nat effect pure listlength + +function (bit[8 ]) ASR8 ((bit[8 ]) v, ([|8 |]) shift) = let v2 = ((bit[16 ]) (EXTS(v))) in (bit[8 ]) (mask(v2 >> shift)) +function (bit[16]) ASR16 ((bit[16]) v, ([|16|]) shift) = let v2 = ((bit[32 ]) (EXTS(v))) in (bit[16]) (mask(v2 >> shift)) +function (bit[32]) ASR32 ((bit[32]) v, ([|32|]) shift) = let v2 = ((bit[64 ]) (EXTS(v))) in (bit[32]) (mask(v2 >> shift)) +function (bit[64]) ASR64 ((bit[64]) v, ([|64|]) shift) = let v2 = ((bit[128]) (EXTS(v))) in (bit[64]) (mask(v2 >> shift)) + +function (bit[8 ]) ROR8 ((bit[8 ]) v, ([|8 |]) shift) = let v2 = ((bit[16 ]) (v:v)) in (bit[8 ]) (mask(v2 >> shift)) +function (bit[16]) ROR16 ((bit[16]) v, ([|16|]) shift) = let v2 = ((bit[32 ]) (v:v)) in (bit[16]) (mask(v2 >> shift)) +function (bit[32]) ROR32 ((bit[32]) v, ([|32|]) shift) = let v2 = ((bit[64 ]) (v:v)) in (bit[32]) (mask(v2 >> shift)) +function (bit[64]) ROR64 ((bit[64]) v, ([|64|]) shift) = let v2 = ((bit[128]) (v:v)) in (bit[64]) (mask(v2 >> shift)) + +function (bit[8 ]) ROL8 ((bit[8 ]) v, ([|8 |]) shift) = let v2 = ((bit[16 ]) (v:v)) in (bit[8 ]) (mask(v2 << shift)) +function (bit[16]) ROL16 ((bit[16]) v, ([|16|]) shift) = let v2 = ((bit[32 ]) (v:v)) in (bit[16]) (mask(v2 << shift)) +function (bit[32]) ROL32 ((bit[32]) v, ([|32|]) shift) = let v2 = ((bit[64 ]) (v:v)) in (bit[32]) (mask(v2 << shift)) +function (bit[64]) ROL64 ((bit[64]) v, ([|64|]) shift) = let v2 = ((bit[128]) (v:v)) in (bit[64]) (mask(v2 << shift)) + +(*val cast bool -> bit effect pure cast_bool_bit +val cast bit -> int effect pure cast_bit_int *) +function forall Nat 'n, Nat 'm, Nat 'o, 'n <= 0, 'm <= 'o. ([|0:'o|]) negative_to_zero (([|'n:'m|]) x) = + if x < 0 then 0 else x + +typedef byte = bit[8] +typedef qword = bit[64] +typedef regn = [|15|] +typedef byte_stream = list +typedef ostream = option + +(* -------------------------------------------------------------------------- + Registers + -------------------------------------------------------------------------- *) + +(* Program Counter *) + +register qword RIP + +(* General purpose registers *) + +register qword RAX (* 0 *) +register qword RCX (* 1 *) +register qword RDX (* 2 *) +register qword RBX (* 3 *) +register qword RSP (* 4 *) +register qword RBP (* 5 *) +register qword RSI (* 6 *) +register qword RDI (* 7 *) +register qword R8 +register qword R9 +register qword R10 +register qword R11 +register qword R12 +register qword R13 +register qword R14 +register qword R15 + +let (vector<0,16,inc,(register)>) REG = + [RAX,RCX,RDX,RBX,RSP,RBP,RSI,RDI,R8,R9,R10,R11,R12,R13,R14,R15] + +(* Flags *) + +register bit[1] CF +register bit[1] PF +register bit[1] AF +register bit[1] ZF +register bit[1] SF +register bit[1] OF + +(* -------------------------------------------------------------------------- + Memory + -------------------------------------------------------------------------- *) + +val extern forall Nat 'n. (qword, [|'n|]) -> (bit[8 * 'n]) effect { rmem } rMEM + + + +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval + +function forall Nat 'n. unit effect {eamem, wmv} wMEM ((qword) addr, ([|'n|]) len, (bit[8 * 'n]) data) = { + MEMea(addr, len); + MEMval(addr, len, data); +} + +(* -------------------------------------------------------------------------- + Helper functions + -------------------------------------------------------------------------- *) + +(* Instruction addressing modes *) + +typedef size = const union { + bool Sz8; + unit Sz16; + unit Sz32; + unit Sz64; +} + +typedef base = const union { + unit NoBase; + unit RipBase; + regn RegBase; +} + +typedef scale_index = (bit[2],regn) + +typedef rm = const union { + regn Reg; + (option,base,qword) Mem; +} + +typedef dest_src = const union { + (rm,qword) Rm_i; + (rm,regn) Rm_r; + (regn,rm) R_rm; +} + +typedef imm_rm = const union { + rm Rm; + qword Imm; +} + +typedef monop_name = enumerate { Dec; Inc; Not; Neg } + +typedef binop_name = enumerate { + Add; Or; Adc; Sbb; And; Sub; Xor; Cmp; Rol; Ror; Rcl; Rcr; Shl; Shr; Test; Sar +} + +function binop_name opc_to_binop_name ((bit[4]) opc) = + switch opc + { + case 0x0 -> Add + case 0x1 -> Or + case 0x2 -> Adc + case 0x3 -> Sbb + case 0x4 -> And + case 0x5 -> Sub + case 0x6 -> Xor + case 0x7 -> Cmp + case 0x8 -> Rol + case 0x9 -> Ror + case 0xa -> Rcl + case 0xb -> Rcr + case 0xc -> Shl + case 0xd -> Shr + case 0xe -> Test + case 0xf -> Sar + } + +typedef cond = enumerate { + O; NO; B; NB; E; NE; NA; A; S; NS; P; NP; L; NL; NG; G; ALWAYS +} + +function cond bv_to_cond ((bit[4]) v) = + switch v + { + case 0x0 -> O + case 0x1 -> NO + case 0x2 -> B + case 0x3 -> NB + case 0x4 -> E + case 0x5 -> NE + case 0x6 -> NA + case 0x7 -> A + case 0x8 -> S + case 0x9 -> NS + case 0xa -> P + case 0xb -> NP + case 0xc -> L + case 0xd -> NL + case 0xe -> NG + case 0xf -> G + } + +(* Effective addresses *) + +typedef ea = const union { + (size,qword) Ea_i; + (size,regn) Ea_r; + (size,qword) Ea_m; +} + +function qword ea_index ((option) index) = + switch (index) { + case None -> 0x0000000000000000 + case (Some(scale, idx)) -> + let x = (qword) (0x0000000000000001 << scale) in + let y = (qword) (REG[idx]) in + let z = (bit[128]) (x * y) in + z[63 .. 0] + } + +function qword ea_base ((base) b) = + switch b { + case NoBase -> 0x0000000000000000 + case RipBase -> RIP + case (RegBase(b)) -> REG[b] + } + +function ea ea_rm ((size) sz, (rm) r) = + switch r { + case (Reg(n)) -> Ea_r (sz, n) + case (Mem(idx, b, d)) -> Ea_m (sz, ea_index(idx) + (qword) (ea_base(b) + d)) + } + +function ea ea_dest ((size) sz, (dest_src) ds) = + switch ds { + case (Rm_i (v, _)) -> ea_rm (sz, v) + case (Rm_r (v, _)) -> ea_rm (sz, v) + case (R_rm (v, _)) -> Ea_r (sz, v) + } + +function ea ea_src ((size) sz, (dest_src) ds) = + switch ds { + case (Rm_i (_, v)) -> Ea_i (sz, v) + case (Rm_r (_, v)) -> Ea_r (sz, v) + case (R_rm (_, v)) -> ea_rm (sz, v) + } + +function ea ea_imm_rm ((imm_rm) i_rm) = + switch i_rm { + case (Rm (v)) -> ea_rm (Sz64, v) + case (Imm (v)) -> Ea_i (Sz64, v) + } + +function qword restrict_size ((size) sz, (qword) imm) = + switch sz { + case (Sz8(_)) -> imm & 0x00000000000000FF + case Sz16 -> imm & 0x000000000000FFFF + case Sz32 -> imm & 0x00000000FFFFFFFF + case Sz64 -> imm + } + +function regn sub4 ((regn) r) = negative_to_zero (r - 4) + +function qword effect { rreg, rmem } EA ((ea) e) = + switch e { + case (Ea_i(sz,i)) -> restrict_size(sz,i) + case (Ea_r((Sz8(have_rex)),r)) -> + if have_rex | r < 4 (* RSP *) | r > 7 (* RDI *) then + REG[r] + else + (REG[sub4 (r)] >> 8) & 0x00000000000000FF + case (Ea_r(sz,r)) -> restrict_size(sz, REG[r]) + case (Ea_m((Sz8(_)),a)) -> EXTZ (rMEM(a, 1)) + case (Ea_m(Sz16,a)) -> EXTZ (rMEM(a, 2)) + case (Ea_m(Sz32,a)) -> EXTZ (rMEM(a, 4)) + case (Ea_m(Sz64,a)) -> rMEM(a, 8) + } + +function unit effect { wmem, wreg, escape } wEA ((ea) e, (qword) w) = + switch e { + case (Ea_i(_,_)) -> exit () + case (Ea_r((Sz8(have_rex)),r)) -> + if have_rex | r < 4 (* RSP *) | r > 7 (* RDI *) then + { + (qword) regr := REG[r]; + regr[7 .. 0] := w[7 .. 0]; + REG[r] := regr + } + else + { + (qword) regr := REG[sub4(r)]; + regr[15 .. 8] := (vector<15,8,dec,bit>) (w[7 .. 0]); + REG[sub4(r)] := regr + } + case (Ea_r(Sz16,r)) -> + { + (qword) regr := REG[r]; + regr[15 .. 8] := w[15 .. 8]; + REG[r] := regr + } + case (Ea_r(Sz32,r)) -> REG[r] := (qword) (EXTZ (w[31 .. 0])) + case (Ea_r(Sz64,r)) -> REG[r] := w + case (Ea_m((Sz8(_)),a)) -> wMEM(a, 1, w[7 .. 0]) + case (Ea_m(Sz16,a)) -> wMEM(a, 2, w[15 .. 0]) + case (Ea_m(Sz32,a)) -> wMEM(a, 4, w[31 .. 0]) + case (Ea_m(Sz64,a)) -> wMEM(a, 8, w) + } + +function (ea, qword, qword) read_dest_src_ea ((size) sz, (dest_src) ds) = + let e = ea_dest (sz, ds) in + (e, EA(e), EA(ea_src(sz, ds))) + +function qword call_dest_from_ea ((ea) e) = + switch e { + case (Ea_i(_, i)) -> RIP + i + case (Ea_r(_, r)) -> REG[r] + case (Ea_m(_, a)) -> rMEM(a, 8) + } + +function qword get_ea_address ((ea) e) = + switch e { + case (Ea_i(_, i)) -> 0x0000000000000000 + case (Ea_r(_, r)) -> 0x0000000000000000 + case (Ea_m(_, a)) -> 0x0000000000000000 + } + +function unit jump_to_ea ((ea) e) = RIP := call_dest_from_ea(e) + +(* EFLAG updates *) + +function bit byte_parity ((byte) b) = +{ + (int) acc := 0; + foreach (i from 0 to 7) acc := acc + (int) (b[i]); + (bit) (acc mod 2 == 0) +} + +function [|64|] size_width ((size) sz) = + switch sz { + case (Sz8(_)) -> 8 + case Sz16 -> 16 + case Sz32 -> 32 + case Sz64 -> 64 + } + +function [|63|] size_width_sub1 ((size) sz) = + switch sz { + case (Sz8(_)) -> 7 + case Sz16 -> 15 + case Sz32 -> 31 + case Sz64 -> 63 + } + +(* XXXXX +function bit word_size_msb ((size) sz, (qword) w) = w[size_width(sz) - 1] +*) + +function bit word_size_msb ((size) sz, (qword) w) = w[size_width_sub1(sz)] + +function unit write_PF ((qword) w) = PF := byte_parity (w[7 .. 0]) + +function unit write_SF ((size) sz, (qword) w) = SF := word_size_msb (sz, w) + +function unit write_ZF ((size) sz, (qword) w) = + ZF := (bit) + (switch sz { + case (Sz8(_)) -> w[7 .. 0] == 0x00 + case Sz16 -> w[15 .. 0] == 0x0000 + case Sz32 -> w[31 .. 0] == 0x00000000 + case Sz64 -> w == 0x0000000000000000 + }) + +function unit write_arith_eflags_except_CF_OF ((size) sz, (qword) w) = +{ + AF := undefined; + write_PF(w); + write_SF(sz, w); + write_ZF(sz, w); +} + +function unit write_arith_eflags ((size) sz, (qword) w, (bit) c, (bit) x) = +{ + CF := c; + OF := x; + write_arith_eflags_except_CF_OF (sz, w) +} + +function unit write_logical_eflags ((size) sz, (qword) w) = + write_arith_eflags (sz, w, bitzero, bitzero) + +function unit erase_eflags () = +{ + AF := undefined; + CF := undefined; + OF := undefined; + PF := undefined; + SF := undefined; + ZF := undefined; +} + +(* XXXXX *) +function nat power ((nat) x, ([|64|]) y) = undefined + +function nat value_width ((size) sz) = power (2, size_width(sz)) + +function bit word_signed_overflow_add ((size) sz, (qword) a, (qword) b) = + (bit) (word_size_msb (sz, a) == word_size_msb (sz, b) & + word_size_msb (sz, a + b) != word_size_msb (sz, a)) + +function bit word_signed_overflow_sub ((size) sz, (qword) a, (qword) b) = + (bit) (word_size_msb (sz, a) != word_size_msb (sz, b) & + word_size_msb (sz, a - b) != word_size_msb (sz, a)) + +function (qword, bit, bit) add_with_carry_out ((size) sz, (qword) a, (qword) b) = + (a + b, (bit) ((int) (value_width (sz)) <= unsigned(a) + unsigned(b)), + word_signed_overflow_add (sz, a, b)) + +function (qword, bit, bit) sub_with_borrow ((size) sz, (qword) a, (qword) b) = + (a - b, (bit) (a < b), word_signed_overflow_sub (sz, a, b)) + +function unit write_arith_result ((size) sz, (qword) w, (bit) c, (bit) x, (ea) e) = +{ + write_arith_eflags (sz, w, c, x); + wEA (e) := w; +} + +function unit write_arith_result_no_CF_OF ((size) sz, (qword) w, (ea) e) = +{ + write_arith_eflags_except_CF_OF (sz, w); + wEA (e) := w; +} + +function unit write_logical_result ((size) sz, (qword) w, (ea) e) = +{ + write_arith_eflags_except_CF_OF (sz, w); + wEA (e) := w; +} + +function unit write_result_erase_eflags ((qword) w, (ea) e) = +{ + erase_eflags (); + wEA (e) := w; +} + +function qword effect { escape } sign_extension ((qword) w, (size) size1, (size) size2) = +{ + (qword) x := w; + switch (size1, size2) { + case ((Sz8(_)), Sz16) -> x[15 .. 0] := (bit[16]) (EXTS (w[7 .. 0])) + case ((Sz8(_)), Sz32) -> x[31 .. 0] := (bit[32]) (EXTS (w[7 .. 0])) + case ((Sz8(_)), Sz64) -> x := (qword) (EXTS (w[7 .. 0])) + case (Sz16, Sz32) -> x[31 .. 0] := (bit[32]) (EXTS (w[15 .. 0])) + case (Sz16, Sz64) -> x := (qword) (EXTS (w[15 .. 0])) + case (Sz32, Sz64) -> x := (qword) (EXTS (w[31 .. 0])) + case _ -> undefined + }; + x; +} + +function [|64|] mask_shift ((size) sz, (qword) w) = + if sz == Sz64 then w[5 .. 0] else w[4 .. 0] + +function qword rol ((size) sz, (qword) a, (qword) b) = + switch sz { + case (Sz8(_)) -> EXTZ (ROL8 (a[7 .. 0], b[2 .. 0])) + case Sz16 -> EXTZ (ROL16 (a[15 .. 0], b[3 .. 0])) + case Sz32 -> EXTZ (ROL32 (a[31 .. 0], b[4 .. 0])) + case Sz64 -> ROL64 (a, b[5 .. 0]) + } + +function qword ror ((size) sz, (qword) a, (qword) b) = + switch sz { + case (Sz8(_)) -> EXTZ (ROR8 (a[7 .. 0], b[2 .. 0])) + case Sz16 -> EXTZ (ROR16 (a[15 .. 0], b[3 .. 0])) + case Sz32 -> EXTZ (ROR32 (a[31 .. 0], b[4 .. 0])) + case Sz64 -> ROR64 (a, b[5 .. 0]) + } + +function qword sar ((size) sz, (qword) a, (qword) b) = + switch sz { + case (Sz8(_)) -> EXTZ (ASR8 (a[7 .. 0], b[2 .. 0])) + case Sz16 -> EXTZ (ASR16 (a[15 .. 0], b[3 .. 0])) + case Sz32 -> EXTZ (ASR32 (a[31 .. 0], b[4 .. 0])) + case Sz64 -> ASR64 (a, b[5 .. 0]) + } + +function unit write_binop ((size) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = + switch bop { + case Add -> let (w,c,x) = add_with_carry_out (sz, a, b) in + write_arith_result (sz, w, c, x, e) + case Sub -> let (w,c,x) = sub_with_borrow (sz, a, b) in + write_arith_result (sz, w, c, x, e) + case Cmp -> let (w,c,x) = sub_with_borrow (sz, a, b) in + write_arith_eflags (sz, w, c, x) + case Test -> write_logical_eflags (sz, a & b) + case And -> write_logical_result (sz, a & b, e) + case Xor -> write_logical_result (sz, a ^ b, e) + case Or -> write_logical_result (sz, a | b, e) + case Rol -> write_result_erase_eflags (rol (sz, a, b), e) + case Ror -> write_result_erase_eflags (ror (sz, a, b), e) + case Sar -> write_result_erase_eflags (sar (sz, a, b), e) + case Shl -> write_result_erase_eflags (a << mask_shift (sz, b), e) + case Shr -> write_result_erase_eflags (a >> mask_shift (sz, b), e) + case Adc -> + { + let carry = (bit) CF in + let (qword) result = a + (qword) (b + carry) in + { + CF := (bit) ((int) (value_width (sz)) <= unsigned(a) + unsigned(b)); + OF := undefined; + write_arith_result_no_CF_OF (sz, result, e); + } + } + case Sbb -> + { + let carry = (bit) CF in + let (qword) result = a - (qword) (b + carry) in + { + CF := (bit) (unsigned(a) < unsigned(b) + (int) carry); + OF := undefined; + write_arith_result_no_CF_OF (sz, result, e); + } + } + case _ -> exit () + } + +function unit write_monop ((size) sz, (monop_name) mop, (qword) a, (ea) e) = + switch mop { + case Not -> wEA(e) := ~(a) + case Dec -> write_arith_result_no_CF_OF (sz, a - 1, e) + case Inc -> write_arith_result_no_CF_OF (sz, a + 1, e) + case Neg -> { write_arith_result_no_CF_OF (sz, 0 - a, e); + CF := undefined; + } + } + +function bool read_cond ((cond) c) = + switch c { + case A -> ~(CF) & ~(ZF) + case NB -> ~(CF) + case B -> CF + case NA -> CF | (bit) ZF + case E -> ZF + case G -> ~(ZF) & (SF == OF) + case NL -> SF == OF + case L -> SF != OF + case NG -> ZF | SF != OF + case NE -> ~(ZF) + case NO -> ~(OF) + case NP -> ~(PF) + case NS -> ~(SF) + case O -> OF + case P -> PF + case S -> SF + case ALWAYS -> true + } + +function qword pop_aux () = + let top = rMEM(RSP, 8) in + { + RSP := RSP + 8; + top; + } + +function unit push_aux ((qword) w) = +{ + RSP := RSP - 8; + wMEM(RSP, 8) := w; +} + +function unit pop ((rm) r) = wEA (ea_rm (Sz64,r)) := pop_aux() +function unit pop_rip () = RIP := pop_aux() +function unit push ((imm_rm) i) = push_aux (EA (ea_imm_rm (i))) +function unit push_rip () = push_aux (RIP) + +function unit drop ((qword) i) = if i[7 ..0] != 0 then () else RSP := RSP + i + +(* -------------------------------------------------------------------------- + Instructions + -------------------------------------------------------------------------- *) + +scattered function unit execute +scattered typedef ast = const union + +val ast -> unit effect {escape, rmem, rreg, undef, eamem, wmv, wreg} execute + +(* ========================================================================== + Binop + ========================================================================== *) + +union ast member (binop_name,size,dest_src) Binop + +function clause execute (Binop (bop,sz,ds)) = + let (e, val_dst, val_src) = read_dest_src_ea (sz, ds) in + write_binop (sz, bop, val_dst, val_src, e) + +(* ========================================================================== + CALL + ========================================================================== *) + +union ast member imm_rm CALL + +function clause execute (CALL (i)) = +{ + push_rip(); + jump_to_ea (ea_imm_rm (i)) +} + +(* ========================================================================== + CLC + ========================================================================== *) + +union ast member unit CLC + +function clause execute CLC = CF := false + +(* ========================================================================== + CMC + ========================================================================== *) + +union ast member unit CMC + +function clause execute CMC = CF := ~(CF) + +(* ========================================================================== + CMPXCHG + ========================================================================== *) + +union ast member (size,rm,regn) CMPXCHG + +function clause execute (CMPXCHG (sz,r,n)) = + let src = Ea_r(sz, n) in + let acc = Ea_r(sz, 0) in (* RAX *) + let dst = ea_rm(sz, r) in + let val_dst = EA(dst) in + let val_acc = EA(src) in + { + write_binop (sz, Cmp, val_acc, val_dst, src); + if val_acc == val_dst then + wEA(dst) := EA (src) + else + wEA(acc) := val_dst; + } + +(* ========================================================================== + DIV + ========================================================================== *) + +union ast member (size,rm) DIV + +function clause execute (DIV (sz,r)) = + let w = (int) (value_width(sz)) in + let eax = Ea_r(sz, 0) in (* RAX *) + let edx = Ea_r(sz, 2) in (* RDX *) + let n = unsigned(EA(edx)) * w + unsigned(EA(eax)) in + let d = unsigned(EA(ea_rm(sz, r))) in + let q = n quot d in + let m = n mod d in + if d == 0 | w < q then exit () + else + { + wEA(eax) := (qword) q; + wEA(edx) := (qword) m; + erase_eflags(); + } + +(* ========================================================================== + Jcc + ========================================================================== *) + +union ast member (cond,qword) Jcc + +function clause execute (Jcc (c,i)) = + if read_cond (c) then RIP := RIP + i else () + +(* ========================================================================== + JMP + ========================================================================== *) + +union ast member rm JMP + +function clause execute (JMP (r)) = RIP := EA (ea_rm (Sz64, r)) + +(* ========================================================================== + LEA + ========================================================================== *) + +union ast member (size,dest_src) LEA + +function clause execute (LEA (sz,ds)) = + let src = ea_src (sz, ds) in + let dst = ea_dest (sz, ds) in + wEA(dst) := get_ea_address (src) + +(* ========================================================================== + LEAVE + ========================================================================== *) + +union ast member unit LEAVE + +function clause execute LEAVE = +{ + RSP := RBP; + pop (Reg (5)); (* RBP *) +} + +(* ========================================================================== + LOOP + ========================================================================== *) + +union ast member (cond,qword) LOOP + +function clause execute (LOOP (c,i)) = +{ + RCX := RCX - 1; + if RCX != 0 & read_cond (c) then RIP := RIP + i else (); +} + +(* ========================================================================== + Monop + ========================================================================== *) + +union ast member (monop_name,size,rm) Monop + +function clause execute (Monop (mop,sz,r)) = + let e = ea_rm (sz, r) in write_monop (sz, mop, EA(e), e) + +(* ========================================================================== + MOV + ========================================================================== *) + +union ast member (cond,size,dest_src) MOV + +function clause execute (MOV (c,sz,ds)) = + if read_cond (c) then + let src = ea_src (sz, ds) in + let dst = ea_dest (sz, ds) in + wEA(dst) := EA(src) + else () + +(* ========================================================================== + MOVSX + ========================================================================== *) + +union ast member (size,dest_src,size) MOVSX + +function clause execute (MOVSX (sz1,ds,sz2)) = + let src = ea_src (sz1, ds) in + let dst = ea_dest (sz2, ds) in + wEA(dst) := sign_extension (EA(src), sz1, sz2) + +(* ========================================================================== + MOVZX + ========================================================================== *) + +union ast member (size,dest_src,size) MOVZX + +function clause execute (MOVZX (sz1,ds,sz2)) = + let src = ea_src (sz1, ds) in + let dst = ea_dest (sz2, ds) in + wEA(dst) := EA(src) + +(* ========================================================================== + MUL + ========================================================================== *) + +union ast member (size,rm) MUL + +function clause execute (MUL (sz,r)) = + let eax = Ea_r (sz, 0) in (* RAX *) + let val_eax = EA(eax) in + let val_src = EA(ea_rm (sz, r)) in + switch sz { + case (Sz8(_)) -> wEA(Ea_r(Sz16,0)) := (val_eax * val_src)[63 .. 0] + case _ -> + let m = val_eax * val_src in + let edx = Ea_r (sz, 2) in (* RDX *) + { + wEA(eax) := m[63 .. 0]; + wEA(edx) := (m >> size_width(sz))[63 .. 0] + } + } + +(* ========================================================================== + NOP + ========================================================================== *) + +union ast member nat NOP + +function clause execute (NOP (_)) = () + +(* ========================================================================== + POP + ========================================================================== *) + +union ast member rm POP + +function clause execute (POP (r)) = pop(r) + +(* ========================================================================== + PUSH + ========================================================================== *) + +union ast member imm_rm PUSH + +function clause execute (PUSH (i)) = push(i) + +(* ========================================================================== + RET + ========================================================================== *) + +union ast member qword RET + +function clause execute (RET (i)) = +{ + pop_rip(); + drop(i); +} + +(* ========================================================================== + SET + ========================================================================== *) + +union ast member (cond,bool,rm) SET + +function clause execute (SET (c,b,r)) = + wEA(ea_rm(Sz8(b),r)) := if read_cond (c) then 1 else 0 + +(* ========================================================================== + STC + ========================================================================== *) + +union ast member unit STC + +function clause execute STC = CF := true + +(* ========================================================================== + XADD + ========================================================================== *) + +union ast member (size,rm,regn) XADD + +function clause execute (XADD (sz,r,n)) = + let src = Ea_r (sz, n) in + let dst = ea_rm (sz, r) in + let val_src = EA(src) in + let val_dst = EA(dst) in + { + wEA(src) := val_dst; + write_binop (sz, Add, val_src, val_dst, dst); + } + +(* ========================================================================== + XCHG + ========================================================================== *) + +union ast member (size,rm,regn) XCHG + +function clause execute (XCHG (sz,r,n)) = + let src = Ea_r (sz, n) in + let dst = ea_rm (sz, r) in + let val_src = EA(src) in + let val_dst = EA(dst) in + { + wEA(src) := val_dst; + wEA(dst) := val_src; + } + +end ast +end execute + +(* -------------------------------------------------------------------------- + Decoding + -------------------------------------------------------------------------- *) +(* +function (qword,ostream) oimmediate8 ((ostream) strm) = + switch strm { + case (Some (b :: t)) -> ((qword) (EXTS(b)), Some (t)) + case _ -> ((qword) undefined, (ostream) None) + } + +function (qword,ostream) immediate8 ((byte_stream) strm) = + oimmediate8 (Some (strm)) + +function (qword,ostream) immediate16 ((byte_stream) strm) = + switch strm { + case b1 :: b2 :: t -> ((qword) (EXTS(b2 : b1)), Some (t)) + case _ -> ((qword) undefined, (ostream) None) + } + +function (qword,ostream) immediate32 ((byte_stream) strm) = + switch strm { + case b1 :: b2 :: b3 :: b4 :: t -> + ((qword) (EXTS(b4 : b3 : b2 : b1)), Some (t)) + case _ -> ((qword) undefined, (ostream) None) + } + +function (qword,ostream) immediate64 ((byte_stream) strm) = + switch strm { + case b1 :: b2 :: b3 :: b4 :: b5 :: b6 :: b7 :: b8 :: t -> + ((qword) (EXTS(b8 : b7 : b6 : b5 : b4 : b3 : b2 : b1)), Some (t)) + case _ -> ((qword) undefined, (ostream) None) + } + +function (qword, ostream) immediate ((size) sz, (byte_stream) strm) = + switch sz { + case (Sz8 (_)) -> immediate8 (strm) + case Sz16 -> immediate16 (strm) + case _ -> immediate32 (strm) + } + +function (qword, ostream) oimmediate ((size) sz, (ostream) strm) = + switch strm { + case (Some (s)) -> immediate (sz, s) + case None -> ((qword) undefined, (ostream) None) + } + +function (qword, ostream) full_immediate ((size) sz, (byte_stream) strm) = + if sz == Sz64 then immediate64 (strm) else immediate (sz, strm) + +(* - Parse ModR/M and SIB bytes --------------------------------------------- *) + +typedef REX = register bits [3 : 0] { + 3 : W; + 2 : R; + 1 : X; + 0 : B +} + +function regn rex_reg ((bit[1]) b, (bit[3]) r) = unsigned(b : r) + +function (qword, ostream) read_displacement ((bit[2]) Mod, (byte_stream) strm) = + if Mod == 0b01 + then immediate8 (strm) + else if Mod == 0b10 + then immediate32 (strm) + else (0x0000000000000000, (Some (strm))) + +function (qword, ostream) + read_sib_displacement ((bit[2]) Mod, (byte_stream) strm) = + if Mod == 0b01 then immediate8 (strm) else immediate32 (strm) + +function (rm, ostream) + read_SIB ((REX) rex, (bit[2]) Mod, (byte_stream) strm) = + switch strm { + case ((bit[2]) SS : (bit[3]) Index : (bit[3]) Base) :: strm1 -> + (let bbase = rex_reg (rex.B, Base) in + let index = rex_reg (rex.X, Index) in + let scaled_index = if index == 4 (* RSP *) then + (option) None + else let x = (scale_index) (SS, index) in + Some (x) in + (if bbase == 5 (* RBP *) + then let (displacement, strm2) = + read_sib_displacement (Mod, strm1) in + let bbase = if Mod == 0b00 then NoBase else RegBase (bbase) + in + (Mem (scaled_index, bbase, displacement), strm2) + else let (displacement, strm2) = read_displacement (Mod, strm1) in + (Mem (scaled_index, RegBase (bbase), displacement), strm2))) + case _ -> ((rm) undefined, (ostream) None) + } + +function (regn, rm, ostream) read_ModRM ((REX) rex, (byte_stream) strm) = + switch strm { + case (0b00 : (bit[3]) RegOpc : 0b101) :: strm1 -> + let (displacement, strm2) = immediate32 (strm1) in + (rex_reg (rex.R, RegOpc), Mem (None, RipBase, displacement), strm2) + case (0b11 : (bit[3]) REG : (bit[3]) RM) :: strm1 -> + (rex_reg (rex.R, REG), Reg (rex_reg (rex.B, RM)), Some (strm1)) + case ((bit[2]) Mod : (bit[3]) RegOpc : 0b100) :: strm1 -> + let (sib, strm2) = read_SIB (rex, Mod, strm1) in + (rex_reg (rex.R, RegOpc), sib, strm2) + case ((bit[2]) Mod : (bit[3]) RegOpc : (bit[3]) RM) :: strm1 -> + let (displacement, strm2) = read_displacement (Mod, strm1) in + (rex_reg (rex.R, RegOpc), + Mem (None, RegBase (rex_reg (rex.B, RM)), displacement), + strm2) + case _ -> ((regn) undefined, (rm) undefined, (ostream) None) + } + +function (bit[3], rm, ostream) + read_opcode_ModRM ((REX) rex, (byte_stream) strm) = + let (opcode, r, strm1) = read_ModRM (rex, strm) in + ((bit[3]) (cast_int_vec((int) opcode mod 8)), r, strm1) + +(* - Prefixes --------------------------------------------------------------- *) + +typedef prefix = [|5|] + +function prefix prefix_group ((byte) b) = + switch b { + case 0xf0 -> 1 + case 0xf2 -> 1 + case 0xf3 -> 1 + case 0x26 -> 2 + case 0x2e -> 2 + case 0x36 -> 2 + case 0x3e -> 2 + case 0x64 -> 2 + case 0x65 -> 2 + case 0x66 -> 3 + case 0x67 -> 4 + case _ -> if b[7 .. 4] == 0b0100 then 5 else 0 + } + +typedef atuple = (byte_stream, bool, REX, byte_stream) + +val (list, byte_stream, byte_stream) -> option effect {undef} read_prefix + +function rec option read_prefix + ((list) s, (byte_stream) p, (byte_stream) strm) = + switch strm { + case h :: strm1 -> + let group = prefix_group (h) in + if group == 0 then + let x = (p, false, (REX) 0b0000, strm) in Some (x) + else if group == 5 then + let x = (p, true, (REX) (h[3 .. 0]), strm1) in Some (x) + else if ismember (group, s) then + None + else + read_prefix (group :: s, h :: p, strm1) + case _ -> let x = (p, false, (REX) undefined, strm) in Some (x) + } + +function option read_prefixes ((byte_stream) strm) = + read_prefix ([||||], [||||], strm) + +function size op_size ((bool) have_rex, (bit[1]) w, (bit[1]) v, (bool) override) = + if v == 1 then + Sz8 (have_rex) + else if w == 1 then + Sz64 + else if override then + Sz16 + else + Sz32 + +function bool is_mem ((rm) r) = + switch r {case (Mem (_, _, _)) -> true case _ -> false} + +(* - Decoder ---------------------------------------------------------------- *) + +function (ast, ostream) decode_aux + ((byte_stream) strm, (bool) have_rex, (REX) rex, (bool) op_size_override) = + switch strm + { + case (0b00 : (bit[3]) opc : 0b0 : (bit[1]) x : (bit[1]) v) :: strm2 -> + let (reg, r, strm3) = read_ModRM (rex, strm2) in + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let binop = opc_to_binop_name (EXTZ (opc)) in + let src_dst = if x == 0 then Rm_r (r, reg) else R_rm (reg, r) in + (Binop (binop, sz, src_dst), strm3) + case (0b00 : (bit[3]) opc : 0b10 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let binop = opc_to_binop_name (EXTZ (opc)) in + let (imm, strm3) = immediate (sz, strm2) in + (Binop (binop, sz, Rm_i (Reg (0), imm)), strm3) + case (0x5 : (bit[1]) b : (bit[3]) r) :: strm2 -> + let reg = Reg (([|15|]) (rex.B : r)) in + (if b == 0b0 then PUSH (Rm (reg)) else POP (reg), Some (strm2)) + case 0x63 :: strm2 -> + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (MOVSX (Sz32, R_rm (reg, r), Sz64), strm3) + case (0x6 : 0b10 : (bit[1]) b : 0b0) :: strm2 -> + let (imm, strm3) = if b == 1 then immediate8 (strm2) + else immediate32 (strm2) in + (PUSH (Imm (imm)), strm3) + case (0x7 : (bit[4]) c) :: strm2 -> + let (imm, strm3) = immediate8 (strm2) in + (Jcc (bv_to_cond (c), imm), strm3) + case (0x8 : 0b000 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + let (imm, strm4) = oimmediate (sz, strm3) in + let binop = opc_to_binop_name (EXTZ (opc)) in + (Binop (binop, sz, Rm_i (r, imm)), strm4) + case 0x83 :: strm2 -> + let sz = op_size (have_rex, rex.W, 1, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + let (imm, strm4) = oimmediate (sz, strm3) in + let binop = opc_to_binop_name (EXTZ (opc)) in + (Binop (binop, sz, Rm_i (r, imm)), strm4) + case (0x8 : 0b010 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (Binop (Test, sz, Rm_r (r, reg)), strm3) + case (0x8 : 0b011 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (XCHG (sz, r, reg), strm3) + case (0x8 : 0b10 : (bit[1]) x : (bit[1]) v) :: strm2 -> + let (reg, r, strm3) = read_ModRM (rex, strm2) in + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let src_dst = if x == 0 then Rm_r (r, reg) else R_rm (reg, r) in + (MOV (ALWAYS, sz, src_dst), strm3) + case 0x8d :: strm2 -> + let sz = op_size (true, rex.W, 1, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + if is_mem (r) then (LEA (sz, R_rm (reg, r)), strm3) else exit () + case 0x8f :: strm2 -> + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + if opc == 0 then (POP (r), strm3) else exit () + case (0x9 : 0b0 : (bit[3]) r) :: strm2 -> + let sz = op_size (true, rex.W, 1, op_size_override) in + let reg = rex_reg (rex.B, r) in + if reg == 0 then + (NOP (listlength (strm)), Some (strm2)) + else + (XCHG (sz, Reg (0), reg), Some (strm2)) + case (0xa : 0b100 : (bit[1]) v) :: strm2 -> + let sz = op_size (true, rex.W, v, op_size_override) in + let (imm, strm3) = immediate (sz, strm2) in + (Binop (Test, sz, Rm_i (Reg (0), imm)), strm3) + case (0xb : (bit[1]) v : (bit[3]) r) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (imm, strm3) = full_immediate (sz, strm2) in + let reg = rex_reg (rex.B, r) in + (MOV (ALWAYS, sz, Rm_i (Reg (reg), imm)), strm3) + case (0xc : 0b000 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + let (imm, strm4) = oimmediate8 (strm3) in + let binop = opc_to_binop_name (0b1 : opc) in + if opc == 0b110 then exit () + else (Binop (binop, sz, Rm_i (r, imm)), strm4) + case (0xc : 0b001 : (bit[1]) v) :: strm2 -> + if v == 0 then + let (imm, strm3) = immediate16 (strm2) in (RET (imm), strm3) + else + (RET (0), Some (strm2)) + case (0xc : 0b011 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + let (imm, strm4) = oimmediate (sz, strm3) in + if opc == 0 then (MOV (ALWAYS, sz, Rm_i (r, imm)), strm4) + else exit () + case 0xc9 :: strm2 -> + (LEAVE, Some (strm2)) + case (0xd : 0b00 : (bit[1]) b : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + let shift = if b == 0 then Rm_i (r, 1) else Rm_r (r, 1) in + let binop = opc_to_binop_name (0b1 : opc) in + if opc == 0b110 then exit () + else (Binop (binop, sz, shift), strm3) + case (0xe : 0b000 : (bit[1]) b) :: strm2 -> + let (imm, strm3) = immediate8 (strm2) in + let cnd = if b == 0 then NE else E in + (LOOP (cnd, imm), strm3) + case 0xe2 :: strm2 -> + let (imm, strm3) = immediate8 (strm2) in + (LOOP (ALWAYS, imm), strm3) + case 0xe8 :: strm2 -> + let (imm, strm3) = immediate32 (strm2) in + (CALL (Imm (imm)), strm3) + case (0xe : 0b10 : (bit[1]) b : 0b1) :: strm2 -> + let (imm, strm3) = if b == 0 then immediate32 (strm2) + else immediate8 (strm2) in + (Jcc (ALWAYS, imm), strm3) + case 0xf5 :: strm2 -> (CMC, Some (strm2)) + case 0xf8 :: strm2 -> (CLC, Some (strm2)) + case 0xf9 :: strm2 -> (STC, Some (strm2)) + case (0xf : 0b011 : (bit[1]) v) :: strm2 -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + switch opc { + case 0b000 -> let (imm, strm4) = oimmediate (sz, strm3) in + (Binop (Test, sz, Rm_i (r, imm)), strm4) + case 0b010 -> (Monop (Not, sz, r), strm3) + case 0b011 -> (Monop (Neg, sz, r), strm3) + case 0b100 -> (MUL (sz, r), strm3) + case 0b110 -> (DIV (sz, r), strm3) + case _ -> exit () + } + case 0xfe :: strm2 -> + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + switch opc { + case 0b000 -> (Monop (Inc, Sz8 (have_rex), r), strm3) + case 0b001 -> (Monop (Dec, Sz8 (have_rex), r), strm3) + case _ -> exit () + } + case 0xff :: strm2 -> + let sz = op_size (have_rex, rex.W, 1, op_size_override) in + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + switch opc { + case 0b000 -> (Monop (Inc, sz, r), strm3) + case 0b001 -> (Monop (Dec, sz, r), strm3) + case 0b010 -> (CALL (Rm (r)), strm3) + case 0b100 -> (JMP (r), strm3) + case 0b110 -> (PUSH (Rm (r)), strm3) + case _ -> exit () + } + case 0x0f :: opc :: strm2 -> + switch opc { + case 0x1f -> + let (opc, r, strm3) = read_opcode_ModRM (rex, strm2) in + (NOP (listlength (strm)), strm3) + case (0x4 : (bit[4]) c) -> + let sz = op_size (true, rex.W, 1, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (MOV (bv_to_cond (c), sz, R_rm (reg, r)), strm3) + case (0x8 : (bit[4]) c) -> + let (imm, strm3) = immediate32 (strm2) in + (Jcc (bv_to_cond (c), imm), strm3) + case (0x9 : (bit[4]) c) -> + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (SET (bv_to_cond (c), have_rex, r), strm3) + case (0xb : 0b000 : (bit[1]) v) -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (CMPXCHG (sz, r, reg), strm3) + case (0xc : 0b000 : (bit[1]) v) -> + let sz = op_size (have_rex, rex.W, v, op_size_override) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + (XADD (sz, r, reg), strm3) + case (0xb : (bit[1]) s : 0b11 : (bit[1]) v) -> + let sz2 = op_size (have_rex, rex.W, 1, op_size_override) in + let sz = if v == 1 then Sz16 else Sz8 (have_rex) in + let (reg, r, strm3) = read_ModRM (rex, strm2) in + if s == 1 then + (MOVSX (sz, R_rm (reg, r), sz2), strm3) + else + (MOVZX (sz, R_rm (reg, r), sz2), strm3) + case _ -> exit () + } + case _ -> exit () + } + +function (byte_stream, ast, nat) decode ((byte_stream) strm) = + switch read_prefixes (strm) + { + case None -> exit () + case (Some (prefixes, have_rex, rex, strm1)) -> + let op_size_override = ismember (0x66, prefixes) in + if rex.W == 1 & op_size_override | ismember (0x67, prefixes) then + exit () + else + switch decode_aux (strm1, have_rex, rex, op_size_override) { + case (instr, (Some (strm2))) -> (prefixes, instr, listlength (strm2)) + case _ -> exit () + } + } + *) + +let (vector <0, 16, inc, string >) GPRstr = + ["RAX","RCX","RDX","RBX","RSP","RBP","RSI","RDI","R8","R9","R10","R11","R12","R13","R14","R15"] + +function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis (instr) = { + iR := [|| ||]; + oR := [|| ||]; + aR := [|| ||]; + ik := IK_simple; + Nias := [|| NIAFP_successor ||]; + Dia := DIAFP_none; + x := (qword) RIP; + (*switch instr { + case (EBREAK) -> () + case (UTYPE ( imm, rd, op)) -> { + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (JAL ( imm, rd)) -> { + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + let (bit[64]) offset = EXTS(imm) in + Nias := [|| NIAFP_concrete_address (PC + offset) ||] + } + case (JALR ( imm, rs, rd)) -> { + if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + let (bit[64]) offset = EXTS(imm) in + Nias := [|| NIAFP_register (RFull(GPRstr[rs])) ||]; (* XXX this should br rs + offset... *) + } + case (BTYPE ( imm, rs2, rs1, op)) -> { + if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; + if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; + ik := IK_cond_branch; + let (bit[64]) offset = EXTS(imm) in + Nias := NIAFP_concrete_address(PC + offset) :: Nias; + } + case (ITYPE ( imm, rs, rd, op)) -> { + if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (SHIFTIOP ( imm, rs, rd, op)) -> { + if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (RTYPE ( rs2, rs1, rd, op)) -> { + if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; + if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (LOAD ( imm, rs, rd, unsign, width, aq)) -> { (* 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 := if aq then IK_mem_read (Read_RISCV_acquire) else IK_mem_read (Read_plain); + } + case (STORE( imm, rs2, rs1, width)) -> { + if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; + if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; + if (rs1 == 0) then () else aR := RFull(GPRstr[rs1]) :: aR; + ik := IK_mem_write (Write_plain); + } + case (ADDIW ( imm, rs, rd)) -> { + if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (SHIFTW ( imm, rs, rd, op)) -> { + if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (RTYPEW ( rs2, rs1, rd, op))-> { + if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; + if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; + if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; + } + case (FENCE(pred, succ)) -> { + ik := + switch(pred, succ) { + case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) + case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) + case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) + case _ -> exit "unsupported fence" + }; + } + };*) + (iR,oR,aR,Nias,Dia,ik) +} -- cgit v1.2.3 From 78a35c575021679b5e512539598d47603a6822f0 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Tue, 22 Aug 2017 11:09:47 +0100 Subject: adapt state.lem to RISCV additions --- src/gen_lib/state.lem | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/gen_lib/state.lem b/src/gen_lib/state.lem index 430ee562..2e29d19a 100644 --- a/src/gen_lib/state.lem +++ b/src/gen_lib/state.lem @@ -60,6 +60,9 @@ let read_mem dir read_kind addr sz state = | Sail_impl_base.Read_exclusive -> true | Sail_impl_base.Read_exclusive_acquire -> true | Sail_impl_base.Read_stream -> false + | Sail_impl_base.Read_RISCV_acquire -> false + | Sail_impl_base.Read_RISCV_reserved -> true + | Sail_impl_base.Read_RISCV_reserved_acquire -> true end in if is_exclusive -- cgit v1.2.3 From 6cc248cc27d9133e23da1454f115176f0799a572 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Tue, 22 Aug 2017 14:16:01 +0100 Subject: added RISC-V "fence w,w" and "fence.i"; fixed the interpreter nias analysis; --- etc/regfp.sail | 2 ++ risc-v/hgen/ast.hgen | 1 + risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 1 + risc-v/hgen/lexer.hgen | 1 + risc-v/hgen/parser.hgen | 4 ++- risc-v/hgen/pretty.hgen | 1 + risc-v/hgen/sail_trans_out.hgen | 1 + risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 1 + risc-v/hgen/token_types.hgen | 1 + risc-v/hgen/tokens.hgen | 1 + risc-v/hgen/trans_sail.hgen | 4 +++ risc-v/riscv.sail | 9 +++-- risc-v/riscv_extras.lem | 2 ++ risc-v/riscv_extras_embed.lem | 4 +++ risc-v/riscv_extras_embed_sequential.lem | 4 +++ risc-v/riscv_regfp.sail | 20 ++++++----- src/lem_interp/interp_inter_imp.lem | 49 ++++++++++++++++++++++++--- src/lem_interp/sail_impl_base.lem | 4 +++ 18 files changed, 94 insertions(+), 16 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index 71f53547..776e22af 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -71,6 +71,8 @@ typedef barrier_kind = enumerate { Barrier_RISCV_rw_rw; Barrier_RISCV_r_rw; Barrier_RISCV_rw_w; + Barrier_RISCV_w_w; + Barrier_RISCV_i; } typedef trans_kind = enumerate { diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index a0a59e4a..6fd52b03 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -11,5 +11,6 @@ | `RISCVSHIFTW of bit5 * reg * reg * riscvSop | `RISCVRTYPEW of reg * reg * reg * riscvRopw | `RISCVFENCE of bit4 * bit4 +| `RISCVFENCEI | `RISCVLoadRes of bool * bool * reg * wordWidth * reg | `RISCVStoreCon of bool * bool * reg * reg * wordWidth * reg diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index ffea1575..770f9263 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -60,6 +60,7 @@ | `RISCVFENCE(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, diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index abc0ff82..d422e82f 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -75,6 +75,7 @@ "r", FENCEOPTION Fence_R; "w", FENCEOPTION Fence_W; "rw", FENCEOPTION Fence_RW; +"fence.i", FENCEI (); "lr.w", LOADRES {width=RISCVWORD; aq=false; rl=false}; "lr.w.aq", LOADRES {width=RISCVWORD; aq=true; rl=false}; diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index d077c2df..5b000725 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -27,13 +27,15 @@ | (Fence_RW, Fence_RW) -> `RISCVFENCE (0b0011, 0b0011) | (Fence_R, Fence_RW) -> `RISCVFENCE (0b0010, 0b0011) | (Fence_RW, Fence_W) -> `RISCVFENCE (0b0011, 0b0001) + | (Fence_W, Fence_W) -> `RISCVFENCE (0b0001, 0b0001) | (Fence_RW, Fence_R) -> failwith "'fence rw,r' is not supported" | (Fence_R, Fence_R) -> failwith "'fence r,r' is not supported" | (Fence_R, Fence_W) -> failwith "'fence r,w' is not supported" | (Fence_W, Fence_RW) -> failwith "'fence w,rw' is not supported" | (Fence_W, Fence_R) -> failwith "'fence w,r' is not supported" - | (Fence_W, Fence_W) -> failwith "'fence w,w' is not supported" } +| FENCEI + { `RISCVFENCEI } | LOADRES reg COMMA LPAR reg RPAR { `RISCVLoadRes($1.aq, $1.rl, $5, $1.width, $2) } | STORECON reg COMMA reg COMMA LPAR reg RPAR diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index b4516b16..0b6548ea 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -15,6 +15,7 @@ | `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(pred, succ) -> sprintf "fence %s, %s" (pp_riscv_fence_option pred) (pp_riscv_fence_option succ) +| `RISCVFENCEI -> sprintf "fence.i" | `RISCVLoadRes(aq, rl, rs1, width, rd) -> assert (rl = false); diff --git a/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index f216180a..61477f43 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -14,6 +14,7 @@ | ("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(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]) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index 01d8dded..f84ed1fa 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -14,6 +14,7 @@ | 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(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) diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index c0ef8445..242a7173 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -11,6 +11,7 @@ type token_ADDIW = unit type token_SHIFTW = {op : riscvSop } type token_RTYPEW = {op : riscvRopw } type token_FENCE = unit +type token_FENCEI = unit type token_LoadRes = {width : wordWidth; aq: bool; rl: bool } type token_StoreCon = {width : wordWidth; aq: bool; rl: bool } diff --git a/risc-v/hgen/tokens.hgen b/risc-v/hgen/tokens.hgen index 1276fd68..449be0f0 100644 --- a/risc-v/hgen/tokens.hgen +++ b/risc-v/hgen/tokens.hgen @@ -12,5 +12,6 @@ %token RTYPEW %token FENCE %token FENCEOPTION +%token FENCEI %token LOADRES %token STORECON diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index 4d568fe8..6d10471c 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -112,6 +112,10 @@ translate_imm4 "succ" succ; ], []) +| `RISCVFENCEI -> + ("FENCEI", + [], + []) | `RISCVLoadRes(aq, rl, rs1, width, rd) -> ("LOADRES", [ diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index b5a25578..1d1867c4 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -104,6 +104,8 @@ function forall Nat 'n. bool effect { wmv } mem_write_conditional_value( (bit[64 val extern unit -> unit effect { barr } MEM_fence_rw_rw val extern unit -> unit effect { barr } MEM_fence_r_rw val extern unit -> unit effect { barr } MEM_fence_rw_w +val extern unit -> unit effect { barr } MEM_fence_w_w +val extern unit -> unit effect { barr } MEM_fence_i (* Ideally these would be sail builtin *) function (bit[64]) shift_right_arith64 ((bit[64]) v, (bit[6]) shift) = @@ -337,17 +339,18 @@ function clause execute (FENCE(pred, succ)) = { case (0b0011, 0b0011) -> MEM_fence_rw_rw() case (0b0010, 0b0011) -> MEM_fence_r_rw() case (0b0011, 0b0001) -> MEM_fence_rw_w() + case (0b0001, 0b0001) -> MEM_fence_w_w() case _ -> not_implemented("unsupported fence") } } union ast member unit FENCEI -function clause decode (0b0000 : 0b0000 : 0b0000 : 0b00000 : 0b001 : 0b00000 : 0b0001111) = Some(FENCEI) -function clause execute FENCEI = () (* XXX TODO *) +function clause decode (0b000000000000 : 0b00000 : 0b001 : 0b00000 : 0b0001111) = Some(FENCEI) +function clause execute FENCEI = MEM_fence_i() union ast member unit ECALL function clause decode (0b000000000000 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(ECALL ()) -function clause execute ECALL = () +function clause execute ECALL = not_implemented("ECALL is not implemented") union ast member unit EBREAK function clause decode (0b000000000001 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(EBREAK ()) diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index 3803839d..59e3cd4a 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -69,4 +69,6 @@ let barrier_functions = [ ("MEM_fence_rw_rw", Barrier_RISCV_rw_rw); ("MEM_fence_r_rw", Barrier_RISCV_r_rw); ("MEM_fence_rw_w", Barrier_RISCV_rw_w); + ("MEM_fence_w_w", Barrier_RISCV_w_w); + ("MEM_fence_i", Barrier_RISCV_i); ] diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index 35d217ff..6bfc2490 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -37,10 +37,14 @@ let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit val MEM_fence_rw_w : unit -> M unit +val MEM_fence_w_w : unit -> M unit +val MEM_fence_i : unit -> M unit let MEM_fence_rw_rw () = barrier Barrier_RISCV_rw_rw let MEM_fence_r_rw () = barrier Barrier_RISCV_r_rw let MEM_fence_rw_w () = barrier Barrier_RISCV_rw_w +let MEM_fence_w_w () = barrier Barrier_RISCV_w_w +let MEM_fence_i () = barrier Barrier_RISCV_i let duplicate (bit,len) = let bits = repeat [bit] len in diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index 93b5dfec..0fca7709 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -37,10 +37,14 @@ let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit val MEM_fence_rw_w : unit -> M unit +val MEM_fence_w_w : unit -> M unit +val MEM_fence_i : unit -> M unit let MEM_fence_rw_rw () = barrier Barrier_RISCV_rw_rw let MEM_fence_r_rw () = barrier Barrier_RISCV_r_rw let MEM_fence_rw_w () = barrier Barrier_RISCV_rw_w +let MEM_fence_w_w () = barrier Barrier_RISCV_w_w +let MEM_fence_i () = barrier Barrier_RISCV_i let duplicate (bit,len) = let bits = repeat [bit] len in diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index 1cfc68d7..20da3da3 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -29,7 +29,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; let (bit[64]) offset = EXTS(imm) in - Nias := [|| NIAFP_register (RFull(GPRstr[rs])) ||]; (* XXX this should br rs + offset... *) + Nias := [|| NIAFP_register (RFull(GPRstr[rs])) ||]; } case (BTYPE ( imm, rs2, rs1, op)) -> { if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; @@ -77,13 +77,17 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; } case (FENCE(pred, succ)) -> { - ik := - switch(pred, succ) { - case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) - case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) - case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) - case _ -> exit "not implemented" - }; + ik := + switch(pred, succ) { + case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) + case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) + case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) + case (0b0001, 0b0001) -> IK_barrier (Barrier_RISCV_w_w) + case _ -> exit "not implemented" + }; + } + case (FENCEI) -> { + ik := IK_barrier (Barrier_RISCV_i); } case (LOADRES ( aq, rl, rs1, width, rd)) -> { if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index fda9d5dd..6a9a77a1 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -1267,6 +1267,10 @@ let nias_of_instruction else [NIA_successor] | _ -> [ NIA_successor ] end + | ("PPCGEN_ism", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"PPCGEN_ism\", \"" ^ s ^ "\")") in + [ NIA_successor ] (* AARch64 label branch (i.e. address must be known) although these instructions take the address as an offset from PC, in here @@ -1301,7 +1305,10 @@ let nias_of_instruction | (Reg name _ _ _) -> name = n_reg | _ -> false end] - + | ("AArch64HandSail", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"AArch64HandSail\", \"" ^ s ^ "\")") in + [ NIA_successor ] (** hacky cut-and-paste for AArch64Gen, duplicating code just to see if this suffices *) @@ -1334,18 +1341,52 @@ let nias_of_instruction | (Reg name _ _ _) -> name = n_reg | _ -> false end] + | ("AArch64GenSail", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"AArch64GenSail\", \"" ^ s ^ "\")") in + [ NIA_successor ] (** end of hacky *) | ("AArch64LitmusSail", "CtrlDep") -> NIA_successor :: nias + | ("AArch64LitmusSail", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"AArch64LitmusSail\", \"" ^ s ^ "\")") in + [ NIA_successor ] | ("MIPS_ism", "B") -> fail + | ("MIPS_ism", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"MIPS_ism\", \"" ^ s ^ "\")") in + [ NIA_successor ] - | (s1,s2) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\""^s1^"\", \""^s2^"\")") in + | ("RISCV_ism", "JAL") -> nias + | ("RISCV_ism", "JALR") -> + let rs1_integer = + match instruction_fields with + | [_; (_, _, rs1); _] -> integer_of_bit_list rs1 + | _ -> fail + end + in + let () = ensure (0 <= rs1_integer && rs1_integer <= 31) + "expected register number from 0 to 31" + in + if rs1_integer = 0 then nias + else + let rs1_reg = "x" ^ (String_extra.stringFromInteger rs1_integer) in + [NIA_register r | forall (r MEM regs_in) + | match r with + | (Reg name _ _ _) -> name = rs1_reg + | _ -> false + end] + | ("RISCV_ism", "BTYPE") -> NIA_successor :: nias + | ("RISCV_ism", s) -> + let () = ensure (not unknown_nia_address) + ("unexpected unknown/undefined address in nia_values 4 (\"RISCV_ism\", \"" ^ s ^ "\")") in [ NIA_successor ] + + | (s1, s2) -> failwith ("unexpected (thread_ism, instruction_name): (" ^ s1 ^ ", " ^ s2 ^ ")") end let interp_instruction_analysis diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index caec3838..ebf0db4a 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -479,6 +479,8 @@ type barrier_kind = | Barrier_RISCV_rw_rw | Barrier_RISCV_r_rw | Barrier_RISCV_rw_w + | Barrier_RISCV_w_w + | Barrier_RISCV_i instance (Show barrier_kind) @@ -499,6 +501,8 @@ instance (Show barrier_kind) | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw" | Barrier_RISCV_r_rw -> "Barrier_RISCV_r_rw" | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" + | Barrier_RISCV_w_w -> "Barrier_RISCV_w_w" + | Barrier_RISCV_I -> "Barrier_RISCV_i" end end -- cgit v1.2.3 From d8c238ddac07ed8bf828596ff68198d0c63758f5 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Tue, 22 Aug 2017 14:39:20 +0100 Subject: and fix that other places --- src/gen_lib/state.lem | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/src/gen_lib/state.lem b/src/gen_lib/state.lem index 2e29d19a..2ea1247e 100644 --- a/src/gen_lib/state.lem +++ b/src/gen_lib/state.lem @@ -47,25 +47,27 @@ let set_reg state reg bitv = <| state with regstate = Map.insert reg bitv state.regstate |> +let is_exclusive = function + | Sail_impl_base.Read_plain -> false + | Sail_impl_base.Read_reserve -> true + | Sail_impl_base.Read_acquire -> false + | Sail_impl_base.Read_exclusive -> true + | Sail_impl_base.Read_exclusive_acquire -> true + | Sail_impl_base.Read_stream -> false + | Sail_impl_base.Read_RISCV_acquire -> false + | Sail_impl_base.Read_RISCV_reserved -> true + | Sail_impl_base.Read_RISCV_reserved_acquire -> true +end + + val read_mem : bool -> read_kind -> vector bitU -> integer -> M (vector bitU) let read_mem dir read_kind addr sz state = let addr = integer_of_address (address_of_bitv addr) in let addrs = range addr (addr+sz-1) in let memory_value = List.map (fun addr -> Map_extra.find addr state.memstate) addrs in let value = Sail_values.internal_mem_value dir memory_value in - let is_exclusive = match read_kind with - | Sail_impl_base.Read_plain -> false - | Sail_impl_base.Read_reserve -> true - | Sail_impl_base.Read_acquire -> false - | Sail_impl_base.Read_exclusive -> true - | Sail_impl_base.Read_exclusive_acquire -> true - | Sail_impl_base.Read_stream -> false - | Sail_impl_base.Read_RISCV_acquire -> false - | Sail_impl_base.Read_RISCV_reserved -> true - | Sail_impl_base.Read_RISCV_reserved_acquire -> true - end in - if is_exclusive + if is_exclusive read_kind then [(Left value, <| state with last_exclusive_operation_was_load = true |>)] else [(Left value, state)] @@ -79,17 +81,8 @@ let read_tag dir read_kind addr state = | Just t -> t | Nothing -> B0 end in - let is_exclusive = match read_kind with - | Sail_impl_base.Read_plain -> false - | Sail_impl_base.Read_reserve -> true - | Sail_impl_base.Read_acquire -> false - | Sail_impl_base.Read_exclusive -> true - | Sail_impl_base.Read_exclusive_acquire -> true - | Sail_impl_base.Read_stream -> false - end in - (* TODO Should reading a tag set the exclusive flag? *) - if is_exclusive + if is_exclusive read_kind then [(Left tag, <| state with last_exclusive_operation_was_load = true |>)] else [(Left tag, state)] -- cgit v1.2.3 From 7f534961bd02a86779160a0ee656aba3b7eb5dd9 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 22 Aug 2017 15:10:27 +0100 Subject: x86: rename size type to avoid name clash in RMEM. --- x86/x64.sail | 96 ++++++++++++++++++++++++++++++------------------------------ 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index 16c71d12..902a861e 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -120,7 +120,7 @@ function forall Nat 'n. unit effect {eamem, wmv} wMEM ((qword) addr, ([|'n|]) le (* Instruction addressing modes *) -typedef size = const union { +typedef wsize = const union { bool Sz8; unit Sz16; unit Sz32; @@ -206,9 +206,9 @@ function cond bv_to_cond ((bit[4]) v) = (* Effective addresses *) typedef ea = const union { - (size,qword) Ea_i; - (size,regn) Ea_r; - (size,qword) Ea_m; + (wsize,qword) Ea_i; + (wsize,regn) Ea_r; + (wsize,qword) Ea_m; } function qword ea_index ((option) index) = @@ -228,20 +228,20 @@ function qword ea_base ((base) b) = case (RegBase(b)) -> REG[b] } -function ea ea_rm ((size) sz, (rm) r) = +function ea ea_rm ((wsize) sz, (rm) r) = switch r { case (Reg(n)) -> Ea_r (sz, n) case (Mem(idx, b, d)) -> Ea_m (sz, ea_index(idx) + (qword) (ea_base(b) + d)) } -function ea ea_dest ((size) sz, (dest_src) ds) = +function ea ea_dest ((wsize) sz, (dest_src) ds) = switch ds { case (Rm_i (v, _)) -> ea_rm (sz, v) case (Rm_r (v, _)) -> ea_rm (sz, v) case (R_rm (v, _)) -> Ea_r (sz, v) } -function ea ea_src ((size) sz, (dest_src) ds) = +function ea ea_src ((wsize) sz, (dest_src) ds) = switch ds { case (Rm_i (_, v)) -> Ea_i (sz, v) case (Rm_r (_, v)) -> Ea_r (sz, v) @@ -254,7 +254,7 @@ function ea ea_imm_rm ((imm_rm) i_rm) = case (Imm (v)) -> Ea_i (Sz64, v) } -function qword restrict_size ((size) sz, (qword) imm) = +function qword restrict_size ((wsize) sz, (qword) imm) = switch sz { case (Sz8(_)) -> imm & 0x00000000000000FF case Sz16 -> imm & 0x000000000000FFFF @@ -309,7 +309,7 @@ function unit effect { wmem, wreg, escape } wEA ((ea) e, (qword) w) = case (Ea_m(Sz64,a)) -> wMEM(a, 8, w) } -function (ea, qword, qword) read_dest_src_ea ((size) sz, (dest_src) ds) = +function (ea, qword, qword) read_dest_src_ea ((wsize) sz, (dest_src) ds) = let e = ea_dest (sz, ds) in (e, EA(e), EA(ea_src(sz, ds))) @@ -338,7 +338,7 @@ function bit byte_parity ((byte) b) = (bit) (acc mod 2 == 0) } -function [|64|] size_width ((size) sz) = +function [|64|] size_width ((wsize) sz) = switch sz { case (Sz8(_)) -> 8 case Sz16 -> 16 @@ -346,7 +346,7 @@ function [|64|] size_width ((size) sz) = case Sz64 -> 64 } -function [|63|] size_width_sub1 ((size) sz) = +function [|63|] size_width_sub1 ((wsize) sz) = switch sz { case (Sz8(_)) -> 7 case Sz16 -> 15 @@ -355,16 +355,16 @@ function [|63|] size_width_sub1 ((size) sz) = } (* XXXXX -function bit word_size_msb ((size) sz, (qword) w) = w[size_width(sz) - 1] +function bit word_size_msb ((wsize) sz, (qword) w) = w[size_width(sz) - 1] *) -function bit word_size_msb ((size) sz, (qword) w) = w[size_width_sub1(sz)] +function bit word_size_msb ((wsize) sz, (qword) w) = w[size_width_sub1(sz)] function unit write_PF ((qword) w) = PF := byte_parity (w[7 .. 0]) -function unit write_SF ((size) sz, (qword) w) = SF := word_size_msb (sz, w) +function unit write_SF ((wsize) sz, (qword) w) = SF := word_size_msb (sz, w) -function unit write_ZF ((size) sz, (qword) w) = +function unit write_ZF ((wsize) sz, (qword) w) = ZF := (bit) (switch sz { case (Sz8(_)) -> w[7 .. 0] == 0x00 @@ -373,7 +373,7 @@ function unit write_ZF ((size) sz, (qword) w) = case Sz64 -> w == 0x0000000000000000 }) -function unit write_arith_eflags_except_CF_OF ((size) sz, (qword) w) = +function unit write_arith_eflags_except_CF_OF ((wsize) sz, (qword) w) = { AF := undefined; write_PF(w); @@ -381,14 +381,14 @@ function unit write_arith_eflags_except_CF_OF ((size) sz, (qword) w) = write_ZF(sz, w); } -function unit write_arith_eflags ((size) sz, (qword) w, (bit) c, (bit) x) = +function unit write_arith_eflags ((wsize) sz, (qword) w, (bit) c, (bit) x) = { CF := c; OF := x; write_arith_eflags_except_CF_OF (sz, w) } -function unit write_logical_eflags ((size) sz, (qword) w) = +function unit write_logical_eflags ((wsize) sz, (qword) w) = write_arith_eflags (sz, w, bitzero, bitzero) function unit erase_eflags () = @@ -404,36 +404,36 @@ function unit erase_eflags () = (* XXXXX *) function nat power ((nat) x, ([|64|]) y) = undefined -function nat value_width ((size) sz) = power (2, size_width(sz)) +function nat value_width ((wsize) sz) = power (2, size_width(sz)) -function bit word_signed_overflow_add ((size) sz, (qword) a, (qword) b) = +function bit word_signed_overflow_add ((wsize) sz, (qword) a, (qword) b) = (bit) (word_size_msb (sz, a) == word_size_msb (sz, b) & word_size_msb (sz, a + b) != word_size_msb (sz, a)) -function bit word_signed_overflow_sub ((size) sz, (qword) a, (qword) b) = +function bit word_signed_overflow_sub ((wsize) sz, (qword) a, (qword) b) = (bit) (word_size_msb (sz, a) != word_size_msb (sz, b) & word_size_msb (sz, a - b) != word_size_msb (sz, a)) -function (qword, bit, bit) add_with_carry_out ((size) sz, (qword) a, (qword) b) = +function (qword, bit, bit) add_with_carry_out ((wsize) sz, (qword) a, (qword) b) = (a + b, (bit) ((int) (value_width (sz)) <= unsigned(a) + unsigned(b)), word_signed_overflow_add (sz, a, b)) -function (qword, bit, bit) sub_with_borrow ((size) sz, (qword) a, (qword) b) = +function (qword, bit, bit) sub_with_borrow ((wsize) sz, (qword) a, (qword) b) = (a - b, (bit) (a < b), word_signed_overflow_sub (sz, a, b)) -function unit write_arith_result ((size) sz, (qword) w, (bit) c, (bit) x, (ea) e) = +function unit write_arith_result ((wsize) sz, (qword) w, (bit) c, (bit) x, (ea) e) = { write_arith_eflags (sz, w, c, x); wEA (e) := w; } -function unit write_arith_result_no_CF_OF ((size) sz, (qword) w, (ea) e) = +function unit write_arith_result_no_CF_OF ((wsize) sz, (qword) w, (ea) e) = { write_arith_eflags_except_CF_OF (sz, w); wEA (e) := w; } -function unit write_logical_result ((size) sz, (qword) w, (ea) e) = +function unit write_logical_result ((wsize) sz, (qword) w, (ea) e) = { write_arith_eflags_except_CF_OF (sz, w); wEA (e) := w; @@ -445,7 +445,7 @@ function unit write_result_erase_eflags ((qword) w, (ea) e) = wEA (e) := w; } -function qword effect { escape } sign_extension ((qword) w, (size) size1, (size) size2) = +function qword effect { escape } sign_extension ((qword) w, (wsize) size1, (wsize) size2) = { (qword) x := w; switch (size1, size2) { @@ -460,10 +460,10 @@ function qword effect { escape } sign_extension ((qword) w, (size) size1, (size) x; } -function [|64|] mask_shift ((size) sz, (qword) w) = +function [|64|] mask_shift ((wsize) sz, (qword) w) = if sz == Sz64 then w[5 .. 0] else w[4 .. 0] -function qword rol ((size) sz, (qword) a, (qword) b) = +function qword rol ((wsize) sz, (qword) a, (qword) b) = switch sz { case (Sz8(_)) -> EXTZ (ROL8 (a[7 .. 0], b[2 .. 0])) case Sz16 -> EXTZ (ROL16 (a[15 .. 0], b[3 .. 0])) @@ -471,7 +471,7 @@ function qword rol ((size) sz, (qword) a, (qword) b) = case Sz64 -> ROL64 (a, b[5 .. 0]) } -function qword ror ((size) sz, (qword) a, (qword) b) = +function qword ror ((wsize) sz, (qword) a, (qword) b) = switch sz { case (Sz8(_)) -> EXTZ (ROR8 (a[7 .. 0], b[2 .. 0])) case Sz16 -> EXTZ (ROR16 (a[15 .. 0], b[3 .. 0])) @@ -479,7 +479,7 @@ function qword ror ((size) sz, (qword) a, (qword) b) = case Sz64 -> ROR64 (a, b[5 .. 0]) } -function qword sar ((size) sz, (qword) a, (qword) b) = +function qword sar ((wsize) sz, (qword) a, (qword) b) = switch sz { case (Sz8(_)) -> EXTZ (ASR8 (a[7 .. 0], b[2 .. 0])) case Sz16 -> EXTZ (ASR16 (a[15 .. 0], b[3 .. 0])) @@ -487,7 +487,7 @@ function qword sar ((size) sz, (qword) a, (qword) b) = case Sz64 -> ASR64 (a, b[5 .. 0]) } -function unit write_binop ((size) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = +function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = switch bop { case Add -> let (w,c,x) = add_with_carry_out (sz, a, b) in write_arith_result (sz, w, c, x, e) @@ -527,7 +527,7 @@ function unit write_binop ((size) sz, (binop_name) bop, (qword) a, (qword) b, (e case _ -> exit () } -function unit write_monop ((size) sz, (monop_name) mop, (qword) a, (ea) e) = +function unit write_monop ((wsize) sz, (monop_name) mop, (qword) a, (ea) e) = switch mop { case Not -> wEA(e) := ~(a) case Dec -> write_arith_result_no_CF_OF (sz, a - 1, e) @@ -591,7 +591,7 @@ val ast -> unit effect {escape, rmem, rreg, undef, eamem, wmv, wreg} execute Binop ========================================================================== *) -union ast member (binop_name,size,dest_src) Binop +union ast member (binop_name,wsize,dest_src) Binop function clause execute (Binop (bop,sz,ds)) = let (e, val_dst, val_src) = read_dest_src_ea (sz, ds) in @@ -629,7 +629,7 @@ function clause execute CMC = CF := ~(CF) CMPXCHG ========================================================================== *) -union ast member (size,rm,regn) CMPXCHG +union ast member (wsize,rm,regn) CMPXCHG function clause execute (CMPXCHG (sz,r,n)) = let src = Ea_r(sz, n) in @@ -649,7 +649,7 @@ function clause execute (CMPXCHG (sz,r,n)) = DIV ========================================================================== *) -union ast member (size,rm) DIV +union ast member (wsize,rm) DIV function clause execute (DIV (sz,r)) = let w = (int) (value_width(sz)) in @@ -688,7 +688,7 @@ function clause execute (JMP (r)) = RIP := EA (ea_rm (Sz64, r)) LEA ========================================================================== *) -union ast member (size,dest_src) LEA +union ast member (wsize,dest_src) LEA function clause execute (LEA (sz,ds)) = let src = ea_src (sz, ds) in @@ -723,7 +723,7 @@ function clause execute (LOOP (c,i)) = Monop ========================================================================== *) -union ast member (monop_name,size,rm) Monop +union ast member (monop_name,wsize,rm) Monop function clause execute (Monop (mop,sz,r)) = let e = ea_rm (sz, r) in write_monop (sz, mop, EA(e), e) @@ -732,7 +732,7 @@ function clause execute (Monop (mop,sz,r)) = MOV ========================================================================== *) -union ast member (cond,size,dest_src) MOV +union ast member (cond,wsize,dest_src) MOV function clause execute (MOV (c,sz,ds)) = if read_cond (c) then @@ -745,7 +745,7 @@ function clause execute (MOV (c,sz,ds)) = MOVSX ========================================================================== *) -union ast member (size,dest_src,size) MOVSX +union ast member (wsize,dest_src,wsize) MOVSX function clause execute (MOVSX (sz1,ds,sz2)) = let src = ea_src (sz1, ds) in @@ -756,7 +756,7 @@ function clause execute (MOVSX (sz1,ds,sz2)) = MOVZX ========================================================================== *) -union ast member (size,dest_src,size) MOVZX +union ast member (wsize,dest_src,wsize) MOVZX function clause execute (MOVZX (sz1,ds,sz2)) = let src = ea_src (sz1, ds) in @@ -767,7 +767,7 @@ function clause execute (MOVZX (sz1,ds,sz2)) = MUL ========================================================================== *) -union ast member (size,rm) MUL +union ast member (wsize,rm) MUL function clause execute (MUL (sz,r)) = let eax = Ea_r (sz, 0) in (* RAX *) @@ -841,7 +841,7 @@ function clause execute STC = CF := true XADD ========================================================================== *) -union ast member (size,rm,regn) XADD +union ast member (wsize,rm,regn) XADD function clause execute (XADD (sz,r,n)) = let src = Ea_r (sz, n) in @@ -857,7 +857,7 @@ function clause execute (XADD (sz,r,n)) = XCHG ========================================================================== *) -union ast member (size,rm,regn) XCHG +union ast member (wsize,rm,regn) XCHG function clause execute (XCHG (sz,r,n)) = let src = Ea_r (sz, n) in @@ -905,20 +905,20 @@ function (qword,ostream) immediate64 ((byte_stream) strm) = case _ -> ((qword) undefined, (ostream) None) } -function (qword, ostream) immediate ((size) sz, (byte_stream) strm) = +function (qword, ostream) immediate ((wsize) sz, (byte_stream) strm) = switch sz { case (Sz8 (_)) -> immediate8 (strm) case Sz16 -> immediate16 (strm) case _ -> immediate32 (strm) } -function (qword, ostream) oimmediate ((size) sz, (ostream) strm) = +function (qword, ostream) oimmediate ((wsize) sz, (ostream) strm) = switch strm { case (Some (s)) -> immediate (sz, s) case None -> ((qword) undefined, (ostream) None) } -function (qword, ostream) full_immediate ((size) sz, (byte_stream) strm) = +function (qword, ostream) full_immediate ((wsize) sz, (byte_stream) strm) = if sz == Sz64 then immediate64 (strm) else immediate (sz, strm) (* - Parse ModR/M and SIB bytes --------------------------------------------- *) @@ -1030,7 +1030,7 @@ function rec option read_prefix function option read_prefixes ((byte_stream) strm) = read_prefix ([||||], [||||], strm) -function size op_size ((bool) have_rex, (bit[1]) w, (bit[1]) v, (bool) override) = +function wsize op_size ((bool) have_rex, (bit[1]) w, (bit[1]) v, (bool) override) = if v == 1 then Sz8 (have_rex) else if w == 1 then -- cgit v1.2.3 From 888b0f2bd01b8a2e026d6a081e85ffe2df3ed16c Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 24 Aug 2017 10:06:34 +0100 Subject: added barrier-kind for x86 MFENCE; fixed some compare functions; --- src/lem_interp/sail_impl_base.lem | 168 ++++++++++++++++++++++---------------- 1 file changed, 96 insertions(+), 72 deletions(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index ebf0db4a..b52eb58f 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -481,6 +481,8 @@ type barrier_kind = | Barrier_RISCV_rw_w | Barrier_RISCV_w_w | Barrier_RISCV_i + (* X86 *) + | Barrier_X86_MFENCE instance (Show barrier_kind) @@ -503,6 +505,7 @@ instance (Show barrier_kind) | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" | Barrier_RISCV_w_w -> "Barrier_RISCV_w_w" | Barrier_RISCV_I -> "Barrier_RISCV_i" + | Barrier_X86_MFENCE -> "Barrier_X86_MFENCE" end end @@ -546,48 +549,42 @@ end let ~{ocaml} read_kindCompare rk1 rk2 = match (rk1, rk2) with - | (Read_plain, Read_plain) -> EQ - | (Read_plain, Read_reserve) -> LT - | (Read_plain, Read_acquire) -> LT - | (Read_plain, Read_exclusive) -> LT - | (Read_plain, Read_exclusive_acquire) -> LT - | (Read_plain, Read_stream) -> LT - - | (Read_reserve, Read_plain) -> GT - | (Read_reserve, Read_reserve) -> EQ - | (Read_reserve, Read_acquire) -> LT - | (Read_reserve, Read_exclusive) -> LT - | (Read_reserve, Read_exclusive_acquire) -> LT - | (Read_reserve, Read_stream) -> LT - - | (Read_acquire, Read_plain) -> GT - | (Read_acquire, Read_reserve) -> GT - | (Read_acquire, Read_acquire) -> EQ - | (Read_acquire, Read_exclusive) -> LT - | (Read_acquire, Read_exclusive_acquire) -> LT - | (Read_acquire, Read_stream) -> LT - - | (Read_exclusive, Read_plain) -> GT - | (Read_exclusive, Read_reserve) -> GT - | (Read_exclusive, Read_acquire) -> GT - | (Read_exclusive, Read_exclusive) -> EQ - | (Read_exclusive, Read_exclusive_acquire) -> LT - | (Read_exclusive, Read_stream) -> LT - - | (Read_exclusive_acquire, Read_plain) -> GT - | (Read_exclusive_acquire, Read_reserve) -> GT - | (Read_exclusive_acquire, Read_acquire) -> GT - | (Read_exclusive_acquire, Read_exclusive) -> GT + | (Read_plain, Read_plain) -> EQ + | (Read_plain, _) -> LT + | (_, Read_plain) -> GT + + | (Read_reserve, Read_reserve) -> EQ + | (Read_reserve, _) -> LT + | (_, Read_reserve) -> GT + + | (Read_acquire, Read_acquire) -> EQ + | (Read_acquire, _) -> LT + | (_, Read_acquire) -> GT + + | (Read_exclusive, Read_exclusive) -> EQ + | (Read_exclusive, _) -> LT + | (_, Read_exclusive) -> GT + | (Read_exclusive_acquire, Read_exclusive_acquire) -> EQ - | (Read_exclusive_acquire, Read_stream) -> GT - - | (Read_stream, Read_plain) -> GT - | (Read_stream, Read_reserve) -> GT - | (Read_stream, Read_acquire) -> GT - | (Read_stream, Read_exclusive) -> GT - | (Read_stream, Read_exclusive_acquire) -> GT - | (Read_stream, Read_stream) -> EQ -end + | (Read_exclusive_acquire, _) -> LT + | (_, Read_exclusive_acquire) -> GT + + | (Read_stream, Read_stream) -> EQ + | (Read_stream, _) -> LT + | (_, Read_stream) -> GT + + | (Read_RISCV_acquire, Read_RISCV_acquire) -> EQ + | (Read_RISCV_acquire, _) -> LT + | (_, Read_RISCV_acquire) -> GT + + | (Read_RISCV_reserved, Read_RISCV_reserved) -> EQ + | (Read_RISCV_reserved, _) -> LT + | (_, Read_RISCV_reserved) -> GT + + | (Read_RISCV_reserved_acquire, Read_RISCV_reserved_acquire) -> EQ + (*| (Read_RISCV_reserved_acquire, _) -> LT + | (_, Read_RISCV_reserved_acquire) -> GT*) + end let inline {ocaml} read_kindCompare = defaultCompare let ~{ocaml} read_kindLess b1 b2 = read_kindCompare b1 b2 = LT @@ -610,36 +607,39 @@ end let ~{ocaml} write_kindCompare wk1 wk2 = match (wk1, wk2) with - | (Write_plain, Write_plain) -> EQ - | (Write_plain, Write_conditional) -> LT - | (Write_plain, Write_release) -> LT - | (Write_plain, Write_exclusive) -> LT - | (Write_plain, Write_exclusive_release) -> LT - - | (Write_conditional, Write_plain) -> GT - | (Write_conditional, Write_conditional) -> EQ - | (Write_conditional, Write_release) -> LT - | (Write_conditional, Write_exclusive) -> LT - | (Write_conditional, Write_exclusive_release) -> LT - - | (Write_release, Write_plain) -> GT - | (Write_release, Write_conditional) -> GT - | (Write_release, Write_release) -> EQ - | (Write_release, Write_exclusive) -> LT - | (Write_release, Write_exclusive_release) -> LT - - | (Write_exclusive, Write_plain) -> GT - | (Write_exclusive, Write_conditional) -> GT - | (Write_exclusive, Write_release) -> GT - | (Write_exclusive, Write_exclusive) -> EQ - | (Write_exclusive, Write_exclusive_release) -> LT - - | (Write_exclusive_release, Write_plain) -> GT - | (Write_exclusive_release, Write_conditional) -> GT - | (Write_exclusive_release, Write_release) -> GT - | (Write_exclusive_release, Write_exclusive) -> GT + | (Write_plain, Write_plain) -> EQ + | (Write_plain, _) -> LT + | (_, Write_plain) -> GT + + | (Write_conditional, Write_conditional) -> EQ + | (Write_conditional, _) -> LT + | (_, Write_conditional) -> GT + + + | (Write_release, Write_release) -> EQ + | (Write_release, _) -> LT + | (_, Write_release) -> GT + + | (Write_exclusive, Write_exclusive) -> EQ + | (Write_exclusive, _) -> LT + | (_, Write_exclusive) -> GT + | (Write_exclusive_release, Write_exclusive_release) -> EQ -end + | (Write_exclusive_release, _) -> LT + | (_, Write_exclusive_release) -> GT + + | (Write_RISCV_release, Write_RISCV_release) -> EQ + | (Write_RISCV_release, _) -> LT + | (_, Write_RISCV_release) -> GT + + | (Write_RISCV_conditional, Write_RISCV_conditional) -> EQ + | (Write_RISCV_conditional, _) -> LT + | (_, Write_RISCV_conditional) -> GT + + | (Write_RISCV_conditional_release, Write_RISCV_conditional_release) -> EQ + (*| (Write_RISCV_conditional_release, _) -> LT + | (_, Write_RISCV_conditional_release) -> GT*) + end let inline {ocaml} write_kindCompare = defaultCompare let ~{ocaml} write_kindLess b1 b2 = write_kindCompare b1 b2 = LT @@ -660,6 +660,7 @@ instance (Ord write_kind) let (>=) = write_kindGreaterEq end + let ~{ocaml} barrier_kindCompare bk1 bk2 = match (bk1, bk2) with | (Barrier_Sync, Barrier_Sync) -> EQ @@ -711,9 +712,32 @@ let ~{ocaml} barrier_kindCompare bk1 bk2 = | (_, Barrier_TM_COMMIT) -> GT | (Barrier_MIPS_SYNC, Barrier_MIPS_SYNC) -> EQ - (* | (Barrier_MIPS_SYNC, _) -> LT - | (_, Barrier_MIPS_SYNC) -> GT *) + | (Barrier_MIPS_SYNC, _) -> LT + | (_, Barrier_MIPS_SYNC) -> GT + + | (Barrier_RISCV_rw_rw, Barrier_RISCV_rw_rw) -> EQ + | (Barrier_RISCV_rw_rw, _) -> LT + | (_, Barrier_RISCV_rw_rw) -> GT + + | (Barrier_RISCV_r_rw, Barrier_RISCV_r_rw) -> EQ + | (Barrier_RISCV_r_rw, _) -> LT + | (_, Barrier_RISCV_r_rw) -> GT + + | (Barrier_RISCV_rw_w, Barrier_RISCV_rw_w) -> EQ + | (Barrier_RISCV_rw_w, _) -> LT + | (_, Barrier_RISCV_rw_w) -> GT + + | (Barrier_RISCV_w_w, Barrier_RISCV_w_w) -> EQ + | (Barrier_RISCV_w_w, _) -> LT + | (_, Barrier_RISCV_w_w) -> GT + + | (Barrier_RISCV_i, Barrier_RISCV_i) -> EQ + | (Barrier_RISCV_i, _) -> LT + | (_, Barrier_RISCV_i) -> GT + | (Barrier_X86_MFENCE, Barrier_X86_MFENCE) -> EQ + (*| (Barrier_X86_MFENCE, _) -> LT + | (_, Barrier_X86_MFENCE) -> GT*) end let inline {ocaml} barrier_kindCompare = defaultCompare -- cgit v1.2.3 From 3721093caa882173526ab7ba03ccaa3226e2a94f Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 24 Aug 2017 10:09:00 +0100 Subject: typo --- src/lem_interp/sail_impl_base.lem | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index b52eb58f..60beffb4 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -504,7 +504,7 @@ instance (Show barrier_kind) | Barrier_RISCV_r_rw -> "Barrier_RISCV_r_rw" | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" | Barrier_RISCV_w_w -> "Barrier_RISCV_w_w" - | Barrier_RISCV_I -> "Barrier_RISCV_i" + | Barrier_RISCV_i -> "Barrier_RISCV_i" | Barrier_X86_MFENCE -> "Barrier_X86_MFENCE" end end -- cgit v1.2.3 From 1dd42197633a1b608303187fac8cc7f5b30ec22e Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 24 Aug 2017 10:11:22 +0100 Subject: typo --- src/lem_interp/sail_impl_base.lem | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 60beffb4..65ae87c2 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -482,7 +482,7 @@ type barrier_kind = | Barrier_RISCV_w_w | Barrier_RISCV_i (* X86 *) - | Barrier_X86_MFENCE + | Barrier_x86_MFENCE instance (Show barrier_kind) @@ -505,7 +505,7 @@ instance (Show barrier_kind) | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" | Barrier_RISCV_w_w -> "Barrier_RISCV_w_w" | Barrier_RISCV_i -> "Barrier_RISCV_i" - | Barrier_X86_MFENCE -> "Barrier_X86_MFENCE" + | Barrier_x86_MFENCE -> "Barrier_x86_MFENCE" end end @@ -735,9 +735,9 @@ let ~{ocaml} barrier_kindCompare bk1 bk2 = | (Barrier_RISCV_i, _) -> LT | (_, Barrier_RISCV_i) -> GT - | (Barrier_X86_MFENCE, Barrier_X86_MFENCE) -> EQ - (*| (Barrier_X86_MFENCE, _) -> LT - | (_, Barrier_X86_MFENCE) -> GT*) + | (Barrier_x86_MFENCE, Barrier_x86_MFENCE) -> EQ + (*| (Barrier_x86_MFENCE, _) -> LT + | (_, Barrier_x86_MFENCE) -> GT*) end let inline {ocaml} barrier_kindCompare = defaultCompare -- cgit v1.2.3 From d9e3c14533806986f7c6ce843148cf1973f9711b Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Wed, 30 Aug 2017 14:44:28 +0100 Subject: typeclass instance Ord(opcode) --- src/lem_interp/sail_impl_base.lem | 32 +++++++++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 65ae87c2..3886f919 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -110,7 +110,7 @@ type address = Address of list byte (* of length 8 *) * integer type opcode = Opcode of list byte (* of length 4 *) (** typeclass instantiations *) - + let ~{ocaml} bitCompare (b1:bit) (b2:bit) = match (b1,b2) with | (Bitc_zero, Bitc_zero) -> EQ @@ -214,6 +214,36 @@ instance (Ord byte) let (>=) = byteGreaterEq end + + + + +let ~{ocaml} opcodeCompare (Opcode o1) (Opcode o2) = + compare o1 o2 +let {ocaml} opcodeCompare = defaultCompare + +let ~{ocaml} opcodeLess b1 b2 = opcodeCompare b1 b2 = LT +let ~{ocaml} opcodeLessEq b1 b2 = opcodeCompare b1 b2 <> GT +let ~{ocaml} opcodeGreater b1 b2 = opcodeCompare b1 b2 = GT +let ~{ocaml} opcodeGreaterEq b1 b2 = opcodeCompare b1 b2 <> LT + +let inline {ocaml} opcodeLess = defaultLess +let inline {ocaml} opcodeLessEq = defaultLessEq +let inline {ocaml} opcodeGreater = defaultGreater +let inline {ocaml} opcodeGreaterEq = defaultGreaterEq + +instance (Ord opcode) + let compare = opcodeCompare + let (<) = opcodeLess + let (<=) = opcodeLessEq + let (>) = opcodeGreater + let (>=) = opcodeGreaterEq +end + + + + + let addressCompare (Address b1 i1) (Address b2 i2) = compare i1 i2 (* this cannot be defaultCompare for OCaml because addresses contain big ints *) -- cgit v1.2.3 From 07fad742df72ff6e7bfb948c1c353a2cf12f5e28 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 31 Aug 2017 15:08:10 +0100 Subject: added RISC-V AMOs --- etc/regfp.sail | 1 + risc-v/hgen/ast.hgen | 1 + risc-v/hgen/fold.hgen | 1 + risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 8 ++ risc-v/hgen/herdtools_types_to_shallow_types.hgen | 11 ++ risc-v/hgen/lexer.hgen | 80 +++++++++++++ risc-v/hgen/map.hgen | 1 + risc-v/hgen/parser.hgen | 2 + risc-v/hgen/pretty.hgen | 7 ++ risc-v/hgen/sail_trans_out.hgen | 2 + risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 2 + risc-v/hgen/shallow_types_to_herdtools_types.hgen | 11 ++ risc-v/hgen/token_types.hgen | 1 + risc-v/hgen/tokens.hgen | 1 + risc-v/hgen/trans_sail.hgen | 12 ++ risc-v/hgen/types.hgen | 32 +++++ risc-v/hgen/types_sail_trans_out.hgen | 12 ++ risc-v/hgen/types_trans_sail.hgen | 1 + risc-v/riscv.sail | 138 +++++++++++++++------- risc-v/riscv_extras.lem | 19 ++- risc-v/riscv_extras_embed.lem | 10 +- risc-v/riscv_extras_embed_sequential.lem | 10 +- risc-v/riscv_regfp.sail | 15 +++ src/lem_interp/interp_inter_imp.lem | 39 +++++- src/lem_interp/sail_impl_base.lem | 25 ++-- 25 files changed, 374 insertions(+), 68 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index 776e22af..761737db 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -83,6 +83,7 @@ typedef instruction_kind = const union { (barrier_kind) IK_barrier; (read_kind) IK_mem_read; (write_kind) IK_mem_write; + (read_kind, write_kind) IK_mem_rmw; IK_cond_branch; (trans_kind) IK_trans; IK_simple diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index 6fd52b03..1839557f 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -14,3 +14,4 @@ | `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/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen index 4cbaf779..d8806a37 100644 --- a/risc-v/hgen/fold.hgen +++ b/risc-v/hgen/fold.hgen @@ -13,3 +13,4 @@ | `RISCVRTYPEW (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (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/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index 770f9263..2e508678 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -74,3 +74,11 @@ 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/risc-v/hgen/herdtools_types_to_shallow_types.hgen b/risc-v/hgen/herdtools_types_to_shallow_types.hgen index 4d8bd87a..a63f9aed 100644 --- a/risc-v/hgen/herdtools_types_to_shallow_types.hgen +++ b/risc-v/hgen/herdtools_types_to_shallow_types.hgen @@ -47,6 +47,17 @@ let translate_ropw op = match op with | RISCVSRLW -> SRLW | RISCVSRAW -> 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 diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index d422e82f..9d5df538 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -86,3 +86,83 @@ "sc.w.rl", STORECON {width=RISCVWORD; aq=false; rl=true}; "sc.d", STORECON {width=RISCVDOUBLE; aq=false; rl=false}; "sc.d.rl", STORECON {width=RISCVDOUBLE; aq=false; rl=true}; + +"amoswap.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOSWAP}; +"amoadd.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOADD}; +"amoand.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOAND}; +"amoor.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOOR}; +"amoxor.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOXOR}; +"amomax.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOMAX}; +"amomin.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOMIN}; +"amomaxu.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOMAXU}; +"amominu.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOMINU}; + +"amoswap.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOSWAP}; +"amoadd.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOADD}; +"amoand.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOAND}; +"amoor.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOOR}; +"amoxor.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOXOR}; +"amomax.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOMAX}; +"amomin.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOMIN}; +"amomaxu.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOMAXU}; +"amominu.d", AMO {width=RISCVDOUBLE; aq=false; rl=false; op=RISCVAMOMINU}; + +"amoswap.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOSWAP}; +"amoadd.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOADD}; +"amoand.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOAND}; +"amoor.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOOR}; +"amoxor.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOXOR}; +"amomax.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOMAX}; +"amomin.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOMIN}; +"amomaxu.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOMAXU}; +"amominu.w.aq", AMO {width=RISCVWORD; aq=true; rl=false; op=RISCVAMOMINU}; + +"amoswap.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOSWAP}; +"amoadd.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOADD}; +"amoand.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOAND}; +"amoor.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOOR}; +"amoxor.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOXOR}; +"amomax.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOMAX}; +"amomin.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOMIN}; +"amomaxu.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOMAXU}; +"amominu.d.aq", AMO {width=RISCVDOUBLE; aq=true; rl=false; op=RISCVAMOMINU}; + +"amoswap.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOSWAP}; +"amoadd.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOADD}; +"amoand.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOAND}; +"amoor.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOOR}; +"amoxor.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOXOR}; +"amomax.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOMAX}; +"amomin.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOMIN}; +"amomaxu.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOMAXU}; +"amominu.w.rl", AMO {width=RISCVWORD; aq=false; rl=true; op=RISCVAMOMINU}; + +"amoswap.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOSWAP}; +"amoadd.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOADD}; +"amoand.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOAND}; +"amoor.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOOR}; +"amoxor.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOXOR}; +"amomax.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOMAX}; +"amomin.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOMIN}; +"amomaxu.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOMAXU}; +"amominu.d.rl", AMO {width=RISCVDOUBLE; aq=false; rl=true; op=RISCVAMOMINU}; + +"amoswap.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOSWAP}; +"amoadd.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOADD}; +"amoand.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOAND}; +"amoor.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOOR}; +"amoxor.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOXOR}; +"amomax.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOMAX}; +"amomin.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOMIN}; +"amomaxu.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOMAXU}; +"amominu.w.aq.rl", AMO {width=RISCVWORD; aq=true; rl=true; op=RISCVAMOMINU}; + +"amoswap.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOSWAP}; +"amoadd.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOADD}; +"amoand.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOAND}; +"amoor.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOOR}; +"amoxor.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOXOR}; +"amomax.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMAX}; +"amomin.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMIN}; +"amomaxu.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMAXU}; +"amominu.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMINU}; diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen index 639a68bd..91eecc56 100644 --- a/risc-v/hgen/map.hgen +++ b/risc-v/hgen/map.hgen @@ -12,3 +12,4 @@ | `RISCVRTYPEW (r0, r1, r2, x) -> `RISCVRTYPEW (r0, map_reg r1, map_reg r2, x) | `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/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index 5b000725..4440ffda 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -40,3 +40,5 @@ { `RISCVLoadRes($1.aq, $1.rl, $5, $1.width, $2) } | STORECON reg COMMA reg COMMA LPAR reg RPAR { `RISCVStoreCon($1.aq, $1.rl, $4, $7, $1.width, $2) } +| AMO reg COMMA reg COMMA LPAR reg RPAR + { `RISCVAMO($1.op, $1.aq, $1.rl, $4, $7, $1.width, $2) } diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index 0b6548ea..b5068c71 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -31,3 +31,10 @@ (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/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index 61477f43..bec35203 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -19,3 +19,5 @@ -> `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/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index f84ed1fa..662b1044 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -19,3 +19,5 @@ -> `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/risc-v/hgen/shallow_types_to_herdtools_types.hgen b/risc-v/hgen/shallow_types_to_herdtools_types.hgen index a891d7d0..03b8820c 100644 --- a/risc-v/hgen/shallow_types_to_herdtools_types.hgen +++ b/risc-v/hgen/shallow_types_to_herdtools_types.hgen @@ -53,6 +53,17 @@ let translate_out_ropw op = match op with | SRLW -> RISCVSRLW | 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 diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index 242a7173..9b469a27 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -14,5 +14,6 @@ type token_FENCE = 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 diff --git a/risc-v/hgen/tokens.hgen b/risc-v/hgen/tokens.hgen index 449be0f0..b0cf1d88 100644 --- a/risc-v/hgen/tokens.hgen +++ b/risc-v/hgen/tokens.hgen @@ -15,3 +15,4 @@ %token FENCEI %token LOADRES %token STORECON +%token AMO diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index 6d10471c..12da62d8 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -137,3 +137,15 @@ 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/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 1471812c..83deb4a2 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -140,6 +140,38 @@ let pp_riscv_store_conditional_op (aq, rl, 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 (op, aq, rl, width) = + "amo" ^ + begin match op with + | RISCVAMOSWAP -> "swap" + | RISCVAMOADD -> "add" + | RISCVAMOXOR -> "xor" + | RISCVAMOAND -> "and" + | RISCVAMOOR -> "or" + | RISCVAMOMIN -> "min" + | RISCVAMOMAX -> "max" + | RISCVAMOMINU -> "minu" + | RISCVAMOMAXU -> "maxu" + end ^ + 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" diff --git a/risc-v/hgen/types_sail_trans_out.hgen b/risc-v/hgen/types_sail_trans_out.hgen index e22110d0..66a2020c 100644 --- a/risc-v/hgen/types_sail_trans_out.hgen +++ b/risc-v/hgen/types_sail_trans_out.hgen @@ -84,3 +84,15 @@ let translate_out_ropw op = match translate_out_enum op with | 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" diff --git a/risc-v/hgen/types_trans_sail.hgen b/risc-v/hgen/types_trans_sail.hgen index 1bf174fa..7528a522 100644 --- a/risc-v/hgen/types_trans_sail.hgen +++ b/risc-v/hgen/types_trans_sail.hgen @@ -16,6 +16,7 @@ let translate_iop = translate_enum [RISCVADDI; RISCVSLTI; RISCVSLTIU; RISCVXORI; 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_reg name value = (name, Bvector (Some 5), bit_list_of_integer 5 (Nat_big_num.of_int (reg_to_int value))) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 1d1867c4..5b749656 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -40,7 +40,10 @@ register (bit[64]) PC register (bit[64]) nextPC let (vector <0, 32, inc, (register<(regval)>)>) GPRs = - [x0, x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31] + [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, + x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, + x28, x29, x30, x31 + ] function (regval) rGPR ((regno) r) = if (r == 0) then @@ -71,35 +74,29 @@ function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release -function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl) = - switch rl { - case false -> MEMea(addr, width) - case true -> MEMea_release(addr, width) +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release +function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl, (bool) con) = + switch (rl, con) { + case (false, false) -> MEMea(addr, width) + case (true, false) -> MEMea_release(addr, width) + case (false, true) -> MEMea_conditional(addr, width) + case (true , true) -> MEMea_conditional_release(addr, width) } val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release -function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl) = - switch rl { - case false -> MEMval(addr, width, value) - case true -> MEMval_release(addr, width, value) +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_release +function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl, (bool) con) = + switch (rl, con) { + case (false, false) -> MEMval(addr, width, value) + case (true, false) -> MEMval_release(addr, width, value) + case (false, true) -> MEMval_conditional(addr, width, value) + case (true, true) -> MEMval_conditional_release(addr, width, value) } -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release -function forall Nat 'n. unit effect { eamem } mem_write_conditional_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl) = - switch rl { - case false -> MEMea_conditional(addr, width) - case true -> MEMea_conditional_release(addr, width) - } - -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> bool effect { wmv } MEMval_conditional -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> bool effect { wmv } MEMval_conditional_release -function forall Nat 'n. bool effect { wmv } mem_write_conditional_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl) = - switch rl { - case false -> MEMval_conditional(addr, width, value) - case true -> MEMval_conditional_release(addr, width, value) - } +val extern unit -> bool effect {exmem} speculate_conditional_success val extern unit -> unit effect { barr } MEM_fence_rw_rw val extern unit -> unit effect { barr } MEM_fence_r_rw @@ -122,6 +119,9 @@ typedef iop = enumerate {ADDI; SLTI; SLTIU; XORI; ORI; ANDI} (* immediate ops *) typedef sop = enumerate {SLLI; SRLI; SRAI} (* shift ops *) typedef rop = enumerate {ADD; SUB; SLL; SLT; SLTU; XOR; SRL; SRA; OR; AND} (* reg-reg ops *) typedef ropw = enumerate {ADDW; SUBW; SLLW; SRLW; SRAW} (* reg-reg 32-bit ops *) +typedef amoop = enumerate {AMOSWAP; AMOADD; AMOXOR; AMOAND; AMOOR; + AMOMIN; AMOMAX; AMOMINU; AMOMAXU} (* AMO ops *) + typedef word_width = enumerate {BYTE; HALF; WORD; DOUBLE} @@ -279,17 +279,17 @@ function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit function clause execute (STORE(imm, rs2, rs1, width, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in { switch (width) { - case BYTE -> mem_write_ea(addr, 1, rl) - case HALF -> mem_write_ea(addr, 2, rl) - case WORD -> mem_write_ea(addr, 4, rl) - case DOUBLE -> mem_write_ea(addr, 8, rl) + case BYTE -> mem_write_ea(addr, 1, rl, false) + case HALF -> mem_write_ea(addr, 2, rl, false) + case WORD -> mem_write_ea(addr, 4, rl, false) + case DOUBLE -> mem_write_ea(addr, 8, rl, false) }; let rs2_val = rGPR(rs2) in switch (width) { - case BYTE -> mem_write_value(addr, 1, rs2_val[7..0], rl) - case HALF -> mem_write_value(addr, 2, rs2_val[15..0], rl) - case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl) - case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl) + case BYTE -> mem_write_value(addr, 1, rs2_val[7..0], rl, false) + case HALF -> mem_write_value(addr, 2, rs2_val[15..0], rl, false) + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, false) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, false) } } @@ -376,21 +376,77 @@ function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b01 function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, DOUBLE, rd)) function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { if aq then not_implemented("store-conditional-acquire is not implemented"); + + (*(bit)*) status := if speculate_conditional_success() then 0 else 1; + wGPR(rd) := (bit[64]) (EXTZ([status])); + (bit[64]) addr := rGPR(rs1); switch width { - case WORD -> mem_write_conditional_ea(addr, 4, rl) - case DOUBLE -> mem_write_conditional_ea(addr, 8, rl) + case WORD -> mem_write_ea(addr, 4, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, rl, true) }; rs2_val := rGPR(rs2); - (bool) success := - switch width { - case WORD -> mem_write_conditional_value(addr, 4, rs2_val[31..0], rl) - case DOUBLE -> mem_write_conditional_value(addr, 8, rs2_val, rl) - }; - if success then wGPR(rd, 0) - else wGPR(rd, 1); + switch width { + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, true) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, true) + }; } +union ast member (amoop, bool, bool, regno, regno, word_width, regno) AMO + +function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOSWAP, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOSWAP, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOADD , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOADD , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOXOR , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOXOR , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOAND , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOAND , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOOR , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOOR , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMIN , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMIN , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMAX , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMAX , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMINU, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMINU, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { + (bit[64]) addr := rGPR(rs1); + + switch (width) { + case WORD -> mem_write_ea(addr, 4, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, rl, true) + }; + + (bit[64]) loaded := + switch (width) { + case WORD -> EXTS(mem_read(addr, 4, aq, true)) + case DOUBLE -> mem_read(addr, 8, aq, true) + }; + wGPR(rd, loaded); + + (bit[64]) rs2_val := rGPR(rs2); + (bit[64]) result := + switch(op) { + case AMOSWAP -> rs2_val + case AMOADD -> rs2_val + loaded + case AMOXOR -> rs2_val ^ loaded + case AMOAND -> rs2_val & loaded + case AMOOR -> rs2_val | loaded + + case AMOMIN -> (bit[64]) (min(signed(rs2_val), signed(loaded))) + case AMOMAX -> (bit[64]) (max(signed(rs2_val), signed(loaded))) + case AMOMINU -> (bit[64]) (min(unsigned(rs2_val), unsigned(loaded))) + case AMOMAXU -> (bit[64]) (max(unsigned(rs2_val), unsigned(loaded))) + }; + + switch (width) { + case WORD -> mem_write_value(addr, 4, result[31..0], rl, true) + case DOUBLE -> mem_write_value(addr, 8, result, rl, true) + }; +} function clause decode _ = None diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index 59e3cd4a..62a7bb91 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -51,20 +51,27 @@ let memory_eas : memory_write_eas = let memory_vals : memory_write_vals = [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing)); ("MEMval_release", (MV memory_parameter_transformer_option_address Nothing)); - ("MEMval_conditional", - (MV memory_parameter_transformer_option_address + ("MEMval_conditional", (MV memory_parameter_transformer_option_address Nothing)); + (* (MV memory_parameter_transformer_option_address (Just (fun (IState interp context) b -> let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in - (IState (Interp.add_answer_to_stack interp bit) context))))); - ("MEMval_conditional_release", - (MV memory_parameter_transformer_option_address + (IState (Interp.add_answer_to_stack interp bit) context))))); *) + ("MEMval_conditional_release", (MV memory_parameter_transformer_option_address Nothing)); + (* (MV memory_parameter_transformer_option_address (Just (fun (IState interp context) b -> let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in - (IState (Interp.add_answer_to_stack interp bit) context))))); + (IState (Interp.add_answer_to_stack interp bit) context))))); *) ] +let speculate_conditional_success : excl_res = + let f = fun (IState interp context) b -> + let bool_res = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in + IState (Interp.add_answer_to_stack interp bool_res) context + in + Just ("speculate_conditional_success", (ER (Just f))) + let barrier_functions = [ ("MEM_fence_rw_rw", Barrier_RISCV_rw_rw); ("MEM_fence_r_rw", Barrier_RISCV_r_rw); diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index 6bfc2490..3f04f9a2 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -26,13 +26,15 @@ let MEMea_conditional_release (addr,size) = write_mem_ea Write_RISCV_conditional val MEMval : (vector bitU * integer * vector bitU) -> M unit val MEMval_release : (vector bitU * integer * vector bitU) -> M unit -val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU -val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M bitU +val MEMval_conditional : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M unit let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) -let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) + +let speculate_conditional_success () = excl_result () >>= fun b -> return (if b then B1 else B0) val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index 0fca7709..dabd4d12 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -26,13 +26,15 @@ let MEMea_conditional_release (addr,size) = write_mem_ea Write_RISCV_conditional val MEMval : (vector bitU * integer * vector bitU) -> M unit val MEMval_release : (vector bitU * integer * vector bitU) -> M unit -val MEMval_conditional : (vector bitU * integer * vector bitU) -> M bitU -val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M bitU +val MEMval_conditional : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M unit let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) -let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun b -> return (if b then B1 else B0) +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) + +let speculate_conditional_success () = excl_result () >>= fun b -> return (if b then B1 else B0) val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index 20da3da3..e6813c37 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -103,12 +103,27 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( 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 := switch (aq, rl) { case (false, false) -> IK_mem_write (Write_RISCV_conditional) case (false, true) -> IK_mem_write (Write_RISCV_conditional_release) case (true, _) -> exit "not implemented" }; } + case (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 := switch (aq, rl) { + case (false, false) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional) + case (false, true) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional_release) + case (true, false) -> IK_mem_rmw (Read_RISCV_reserved_acquire, Write_RISCV_conditional) + case (true, true) -> IK_mem_rmw (Read_RISCV_reserved_acquire, Write_RISCV_conditional_release) + }; + } }; (iR,oR,aR,Nias,Dia,ik) } diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index 6a9a77a1..411ad3fc 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -1416,6 +1416,41 @@ let interp_instruction_analysis if forall (inst_kind' MEM inst_kinds). inst_kind' = inst_kind then inst_kind + + else if + (forall (inst_kind' MEM (inst_kind :: inst_kinds)). + match inst_kind' with + | IK_mem_read _ -> true + | IK_mem_write _ -> true + | IK_mem_rmw _ -> false + | IK_barrier _ -> false + | IK_cond_branch -> false + | IK_trans _ -> false + | IK_simple -> false + end) && + (exists (inst_kind' MEM (inst_kind :: inst_kinds)). + match inst_kind' with + | IK_mem_read _ -> true + | _ -> false + end) && + (exists (inst_kind' MEM (inst_kind :: inst_kinds)). + match inst_kind' with + | IK_mem_write _ -> true + | _ -> false + end) + then + match + List.partition + (function IK_mem_read _ -> true | _ -> false end) + (inst_kind :: inst_kinds) + with + | ((IK_mem_read r) :: rs, (IK_mem_write w) :: ws) -> + let () = ensure (forall (r' MEM rs). r' = IK_mem_read r) "more than one kind of read" in + let () = ensure (forall (w' MEM ws). w' = IK_mem_write w) "more than one kind of write" in + IK_mem_rmw (r, w) + | _ -> fail + end + (* the TSTART instruction can also be aborted so it will have two kinds of events *) else if (exists (inst_kind' MEM (inst_kind :: inst_kinds)). inst_kind' = IK_trans Transaction_start) && @@ -1424,7 +1459,9 @@ let interp_instruction_analysis || inst_kind' = IK_trans Transaction_abort) then IK_trans Transaction_start - else failwith "multiple instruction kinds" + + else + failwith "multiple instruction kinds" end in (regs_in, regs_out, regs_feeding_address, nias, dia, inst_kind) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 3886f919..721c0226 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -552,26 +552,27 @@ instance (Show trans_kind) end type instruction_kind = - | IK_barrier of barrier_kind - | IK_mem_read of read_kind + | IK_barrier of barrier_kind + | IK_mem_read of read_kind | IK_mem_write of write_kind -(* SS reinstating cond_branches -at present branches are not distinguished in the instruction_kind; -they just have particular nias (and will be IK_simple *) - | IK_cond_branch -(* | IK_uncond_branch *) - | IK_trans of trans_kind + | IK_mem_rmw of (read_kind * write_kind) + | IK_cond_branch + (* unconditional branches are not distinguished in the instruction_kind; + they just have particular nias (and will be IK_simple *) + (* | IK_uncond_branch *) + | IK_trans of trans_kind | IK_simple instance (Show instruction_kind) let show = function | IK_barrier barrier_kind -> "IK_barrier " ^ (show barrier_kind) - | IK_mem_read read_kind -> "IK_mem_read " ^ (show read_kind) + | IK_mem_read read_kind -> "IK_mem_read " ^ (show read_kind) | IK_mem_write write_kind -> "IK_mem_write " ^ (show write_kind) - | IK_cond_branch -> "IK_cond_branch" - | IK_trans trans_kind -> "IK_trans " ^ (show trans_kind) - | IK_simple -> "IK_simple" + | IK_mem_rmw (r, w) -> "IK_mem_rmw " ^ (show r) ^ " " ^ (show w) + | IK_cond_branch -> "IK_cond_branch" + | IK_trans trans_kind -> "IK_trans " ^ (show trans_kind) + | IK_simple -> "IK_simple" end end -- cgit v1.2.3 From f83c3d00f60a2507dfa5c3f31de6ddfc08eee610 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Thu, 31 Aug 2017 17:25:30 +0100 Subject: add EnumerationType type class: if a type is a member you get Ord membership and Set membership for free --- src/lem_interp/sail_impl_base.lem | 361 ++++++++++---------------------------- 1 file changed, 89 insertions(+), 272 deletions(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 721c0226..c577c44b 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -42,6 +42,29 @@ open import Pervasives_extra + + +class ( EnumerationType 'a ) + val toNat : 'a -> nat +end + + +val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering +let ~{ocaml} enumeration_typeCompare e1 e2 = + compare (toNat e1) (toNat e2) +let inline {ocaml} enumeration_typeCompare = defaultCompare + + +default_instance forall 'a. EnumerationType 'a => (Ord 'a) + let compare = enumeration_typeCompare + let (<) r1 r2 = (enumeration_typeCompare r1 r2) = LT + let (<=) r1 r2 = (enumeration_typeCompare r1 r2) <> GT + let (>) r1 r2 = (enumeration_typeCompare r1 r2) = GT + let (>=) r1 r2 = (enumeration_typeCompare r1 r2) <> LT +end + + + (* maybe isn't a member of type Ord - this should be in the Lem standard library*) instance forall 'a. Ord 'a => (Ord (maybe 'a)) let compare = maybeCompare compare @@ -111,65 +134,21 @@ type opcode = Opcode of list byte (* of length 4 *) (** typeclass instantiations *) -let ~{ocaml} bitCompare (b1:bit) (b2:bit) = - match (b1,b2) with - | (Bitc_zero, Bitc_zero) -> EQ - | (Bitc_one, Bitc_one) -> EQ - | (Bitc_zero, _) -> LT - | (_,_) -> GT + +instance (EnumerationType bit) + let toNat = function + | Bitc_zero -> 0 + | Bitc_one -> 1 end -let inline {ocaml} bitCompare = defaultCompare - -let ~{ocaml} bitLess b1 b2 = bitCompare b1 b2 = LT -let ~{ocaml} bitLessEq b1 b2 = bitCompare b1 b2 <> GT -let ~{ocaml} bitGreater b1 b2 = bitCompare b1 b2 = GT -let ~{ocaml} bitGreaterEq b1 b2 = bitCompare b1 b2 <> LT - -let inline {ocaml} bitLess = defaultLess -let inline {ocaml} bitLessEq = defaultLessEq -let inline {ocaml} bitGreater = defaultGreater -let inline {ocaml} bitGreaterEq = defaultGreaterEq - -instance (Ord bit) - let compare = bitCompare - let (<) = bitLess - let (<=) = bitLessEq - let (>) = bitGreater - let (>=) = bitGreaterEq end -let ~{ocaml} bit_liftedCompare (bl1:bit_lifted) (bl2:bit_lifted) = - match (bl1,bl2) with - | (Bitl_zero, Bitl_zero) -> EQ - | (Bitl_zero,_) -> LT - | (Bitl_one, Bitl_zero) -> GT - | (Bitl_one, Bitl_one) -> EQ - | (Bitl_one, _) -> LT - | (Bitl_undef,Bitl_zero) -> GT - | (Bitl_undef,Bitl_one) -> GT - | (Bitl_undef,Bitl_undef) -> EQ - | (Bitl_undef,_) -> LT - | (Bitl_unknown,Bitl_unknown) -> EQ - | (Bitl_unknown,_) -> GT +instance (EnumerationType bit_lifted) + let toNat = function + | Bitl_zero -> 0 + | Bitl_one -> 1 + | Bitl_undef -> 2 + | Bitl_unknown -> 3 end -let inline {ocaml} bit_liftedCompare = defaultCompare - -let ~{ocaml} bit_liftedLess b1 b2 = bit_liftedCompare b1 b2 = LT -let ~{ocaml} bit_liftedLessEq b1 b2 = bit_liftedCompare b1 b2 <> GT -let ~{ocaml} bit_liftedGreater b1 b2 = bit_liftedCompare b1 b2 = GT -let ~{ocaml} bit_liftedGreaterEq b1 b2 = bit_liftedCompare b1 b2 <> LT - -let inline {ocaml} bit_liftedLess = defaultLess -let inline {ocaml} bit_liftedLessEq = defaultLessEq -let inline {ocaml} bit_liftedGreater = defaultGreater -let inline {ocaml} bit_liftedGreaterEq = defaultGreaterEq - -instance (Ord bit_lifted) - let compare = bit_liftedCompare - let (<) = bit_liftedLess - let (<=) = bit_liftedLessEq - let (>) = bit_liftedGreater - let (>=) = bit_liftedGreaterEq end let ~{ocaml} byte_liftedCompare (Byte_lifted b1) (Byte_lifted b2) = compare b1 b2 @@ -578,233 +557,71 @@ end -let ~{ocaml} read_kindCompare rk1 rk2 = - match (rk1, rk2) with - | (Read_plain, Read_plain) -> EQ - | (Read_plain, _) -> LT - | (_, Read_plain) -> GT - - | (Read_reserve, Read_reserve) -> EQ - | (Read_reserve, _) -> LT - | (_, Read_reserve) -> GT - - | (Read_acquire, Read_acquire) -> EQ - | (Read_acquire, _) -> LT - | (_, Read_acquire) -> GT - - | (Read_exclusive, Read_exclusive) -> EQ - | (Read_exclusive, _) -> LT - | (_, Read_exclusive) -> GT - - | (Read_exclusive_acquire, Read_exclusive_acquire) -> EQ - | (Read_exclusive_acquire, _) -> LT - | (_, Read_exclusive_acquire) -> GT - - | (Read_stream, Read_stream) -> EQ - | (Read_stream, _) -> LT - | (_, Read_stream) -> GT - - | (Read_RISCV_acquire, Read_RISCV_acquire) -> EQ - | (Read_RISCV_acquire, _) -> LT - | (_, Read_RISCV_acquire) -> GT - - | (Read_RISCV_reserved, Read_RISCV_reserved) -> EQ - | (Read_RISCV_reserved, _) -> LT - | (_, Read_RISCV_reserved) -> GT - - | (Read_RISCV_reserved_acquire, Read_RISCV_reserved_acquire) -> EQ - (*| (Read_RISCV_reserved_acquire, _) -> LT - | (_, Read_RISCV_reserved_acquire) -> GT*) +instance (EnumerationType read_kind) + let toNat = function + | Read_plain -> 0 + | Read_reserve -> 1 + | Read_acquire -> 2 + | Read_exclusive -> 3 + | Read_exclusive_acquire -> 4 + | Read_stream -> 5 + | Read_RISCV_acquire -> 6 + | Read_RISCV_reserved -> 7 + | Read_RISCV_reserved_acquire -> 8 end -let inline {ocaml} read_kindCompare = defaultCompare - -let ~{ocaml} read_kindLess b1 b2 = read_kindCompare b1 b2 = LT -let ~{ocaml} read_kindLessEq b1 b2 = read_kindCompare b1 b2 <> GT -let ~{ocaml} read_kindGreater b1 b2 = read_kindCompare b1 b2 = GT -let ~{ocaml} read_kindGreaterEq b1 b2 = read_kindCompare b1 b2 <> LT - -let inline {ocaml} read_kindLess = defaultLess -let inline {ocaml} read_kindLessEq = defaultLessEq -let inline {ocaml} read_kindGreater = defaultGreater -let inline {ocaml} read_kindGreaterEq = defaultGreaterEq - -instance (Ord read_kind) - let compare = read_kindCompare - let (<) = read_kindLess - let (<=) = read_kindLessEq - let (>) = read_kindGreater - let (>=) = read_kindGreaterEq end -let ~{ocaml} write_kindCompare wk1 wk2 = - match (wk1, wk2) with - | (Write_plain, Write_plain) -> EQ - | (Write_plain, _) -> LT - | (_, Write_plain) -> GT - - | (Write_conditional, Write_conditional) -> EQ - | (Write_conditional, _) -> LT - | (_, Write_conditional) -> GT - - - | (Write_release, Write_release) -> EQ - | (Write_release, _) -> LT - | (_, Write_release) -> GT - - | (Write_exclusive, Write_exclusive) -> EQ - | (Write_exclusive, _) -> LT - | (_, Write_exclusive) -> GT - - | (Write_exclusive_release, Write_exclusive_release) -> EQ - | (Write_exclusive_release, _) -> LT - | (_, Write_exclusive_release) -> GT - - | (Write_RISCV_release, Write_RISCV_release) -> EQ - | (Write_RISCV_release, _) -> LT - | (_, Write_RISCV_release) -> GT - - | (Write_RISCV_conditional, Write_RISCV_conditional) -> EQ - | (Write_RISCV_conditional, _) -> LT - | (_, Write_RISCV_conditional) -> GT - - | (Write_RISCV_conditional_release, Write_RISCV_conditional_release) -> EQ - (*| (Write_RISCV_conditional_release, _) -> LT - | (_, Write_RISCV_conditional_release) -> GT*) +instance (EnumerationType write_kind) + let toNat = function + | Write_plain -> 0 + | Write_conditional -> 1 + | Write_release -> 2 + | Write_exclusive -> 3 + | Write_exclusive_release -> 4 + | Write_RISCV_release -> 5 + | Write_RISCV_conditional -> 6 + | Write_RISCV_conditional_release -> 7 end -let inline {ocaml} write_kindCompare = defaultCompare - -let ~{ocaml} write_kindLess b1 b2 = write_kindCompare b1 b2 = LT -let ~{ocaml} write_kindLessEq b1 b2 = write_kindCompare b1 b2 <> GT -let ~{ocaml} write_kindGreater b1 b2 = write_kindCompare b1 b2 = GT -let ~{ocaml} write_kindGreaterEq b1 b2 = write_kindCompare b1 b2 <> LT - -let inline {ocaml} write_kindLess = defaultLess -let inline {ocaml} write_kindLessEq = defaultLessEq -let inline {ocaml} write_kindGreater = defaultGreater -let inline {ocaml} write_kindGreaterEq = defaultGreaterEq - -instance (Ord write_kind) - let compare = write_kindCompare - let (<) = write_kindLess - let (<=) = write_kindLessEq - let (>) = write_kindGreater - let (>=) = write_kindGreaterEq end - -let ~{ocaml} barrier_kindCompare bk1 bk2 = - match (bk1, bk2) with - | (Barrier_Sync, Barrier_Sync) -> EQ - | (Barrier_Sync, _) -> LT - | (_, Barrier_Sync) -> GT - - | (Barrier_LwSync, Barrier_LwSync) -> EQ - | (Barrier_LwSync, _) -> LT - | (_, Barrier_LwSync) -> GT - - | (Barrier_Eieio, Barrier_Eieio) -> EQ - | (Barrier_Eieio, _) -> LT - | (_, Barrier_Eieio) -> GT - - | (Barrier_Isync, Barrier_Isync) -> EQ - | (Barrier_Isync, _) -> LT - | (_, Barrier_Isync) -> GT - - | (Barrier_DMB, Barrier_DMB) -> EQ - | (Barrier_DMB, _) -> LT - | (_, Barrier_DMB) -> GT - - | (Barrier_DMB_ST, Barrier_DMB_ST) -> EQ - | (Barrier_DMB_ST, _) -> LT - | (_, Barrier_DMB_ST) -> GT - - | (Barrier_DMB_LD, Barrier_DMB_LD) -> EQ - | (Barrier_DMB_LD, _) -> LT - | (_, Barrier_DMB_LD) -> GT - - | (Barrier_DSB, Barrier_DSB) -> EQ - | (Barrier_DSB, _) -> LT - | (_, Barrier_DSB) -> GT - - | (Barrier_DSB_ST, Barrier_DSB_ST) -> EQ - | (Barrier_DSB_ST, _) -> LT - | (_, Barrier_DSB_ST) -> GT - - | (Barrier_DSB_LD, Barrier_DSB_LD) -> EQ - | (Barrier_DSB_LD, _) -> LT - | (_, Barrier_DSB_LD) -> GT - - | (Barrier_ISB, Barrier_ISB) -> EQ - | (Barrier_ISB, _) -> LT - | (_, Barrier_ISB) -> GT - - | (Barrier_TM_COMMIT, Barrier_TM_COMMIT) -> EQ - | (Barrier_TM_COMMIT, _) -> LT - | (_, Barrier_TM_COMMIT) -> GT - - | (Barrier_MIPS_SYNC, Barrier_MIPS_SYNC) -> EQ - | (Barrier_MIPS_SYNC, _) -> LT - | (_, Barrier_MIPS_SYNC) -> GT - - | (Barrier_RISCV_rw_rw, Barrier_RISCV_rw_rw) -> EQ - | (Barrier_RISCV_rw_rw, _) -> LT - | (_, Barrier_RISCV_rw_rw) -> GT - - | (Barrier_RISCV_r_rw, Barrier_RISCV_r_rw) -> EQ - | (Barrier_RISCV_r_rw, _) -> LT - | (_, Barrier_RISCV_r_rw) -> GT - - | (Barrier_RISCV_rw_w, Barrier_RISCV_rw_w) -> EQ - | (Barrier_RISCV_rw_w, _) -> LT - | (_, Barrier_RISCV_rw_w) -> GT - - | (Barrier_RISCV_w_w, Barrier_RISCV_w_w) -> EQ - | (Barrier_RISCV_w_w, _) -> LT - | (_, Barrier_RISCV_w_w) -> GT - - | (Barrier_RISCV_i, Barrier_RISCV_i) -> EQ - | (Barrier_RISCV_i, _) -> LT - | (_, Barrier_RISCV_i) -> GT - - | (Barrier_x86_MFENCE, Barrier_x86_MFENCE) -> EQ - (*| (Barrier_x86_MFENCE, _) -> LT - | (_, Barrier_x86_MFENCE) -> GT*) +instance (EnumerationType barrier_kind) + let toNat = function + | Barrier_Sync -> 0 + | Barrier_LwSync -> 1 + | Barrier_Eieio ->2 + | Barrier_Isync -> 3 + | Barrier_DMB -> 4 + | Barrier_DMB_ST -> 5 + | Barrier_DMB_LD -> 6 + | Barrier_DSB -> 7 + | Barrier_DSB_ST -> 8 + | Barrier_DSB_LD -> 9 + | Barrier_ISB -> 10 + | Barrier_TM_COMMIT -> 11 + | Barrier_MIPS_SYNC -> 12 + | Barrier_RISCV_rw_rw -> 13 + | Barrier_RISCV_r_rw -> 14 + | Barrier_RISCV_rw_w -> 15 + | Barrier_RISCV_w_w -> 16 + | Barrier_RISCV_i -> 17 + | Barrier_x86_MFENCE -> 18 end -let inline {ocaml} barrier_kindCompare = defaultCompare - -let ~{ocaml} barrier_kindLess b1 b2 = barrier_kindCompare b1 b2 = LT -let ~{ocaml} barrier_kindLessEq b1 b2 = barrier_kindCompare b1 b2 <> GT -let ~{ocaml} barrier_kindGreater b1 b2 = barrier_kindCompare b1 b2 = GT -let ~{ocaml} barrier_kindGreaterEq b1 b2 = barrier_kindCompare b1 b2 <> LT - -let inline {ocaml} barrier_kindLess = defaultLess -let inline {ocaml} barrier_kindLessEq = defaultLessEq -let inline {ocaml} barrier_kindGreater = defaultGreater -let inline {ocaml} barrier_kindGreaterEq = defaultGreaterEq - -instance (Ord barrier_kind) - let compare = barrier_kindCompare - let (<) = barrier_kindLess - let (<=) = barrier_kindLessEq - let (>) = barrier_kindGreater - let (>=) = barrier_kindGreaterEq end - type event = -| E_read_mem of read_kind * address_lifted * nat * maybe (list reg_name) -| E_read_memt of read_kind * address_lifted * nat * maybe (list reg_name) -| E_write_mem of write_kind * address_lifted * nat * maybe (list reg_name) * memory_value * maybe (list reg_name) -| E_write_ea of write_kind * address_lifted * nat * maybe (list reg_name) -| E_excl_res -| E_write_memv of maybe address_lifted * memory_value * maybe (list reg_name) -| E_write_memvt of maybe address_lifted * (bit_lifted * memory_value) * maybe (list reg_name) -| E_barrier of barrier_kind -| E_footprint -| E_read_reg of reg_name -| E_write_reg of reg_name * register_value -| E_escape -| E_error of string + | E_read_mem of read_kind * address_lifted * nat * maybe (list reg_name) + | E_read_memt of read_kind * address_lifted * nat * maybe (list reg_name) + | E_write_mem of write_kind * address_lifted * nat * maybe (list reg_name) * memory_value * maybe (list reg_name) + | E_write_ea of write_kind * address_lifted * nat * maybe (list reg_name) + | E_excl_res + | E_write_memv of maybe address_lifted * memory_value * maybe (list reg_name) + | E_write_memvt of maybe address_lifted * (bit_lifted * memory_value) * maybe (list reg_name) + | E_barrier of barrier_kind + | E_footprint + | E_read_reg of reg_name + | E_write_reg of reg_name * register_value + | E_escape + | E_error of string let eventCompare e1 e2 = -- cgit v1.2.3 From 016cb11c78f84d02b40988958098b464dffc0f26 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Sat, 2 Sep 2017 08:09:44 +0100 Subject: check the status of SC before doing the memory write --- risc-v/riscv.sail | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 5b749656..cd0e5bf9 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -380,15 +380,17 @@ function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { (*(bit)*) status := if speculate_conditional_success() then 0 else 1; wGPR(rd) := (bit[64]) (EXTZ([status])); - (bit[64]) addr := rGPR(rs1); - switch width { - case WORD -> mem_write_ea(addr, 4, rl, true) - case DOUBLE -> mem_write_ea(addr, 8, rl, true) - }; - rs2_val := rGPR(rs2); - switch width { - case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, true) - case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, true) + if status == 1 then () else { + (bit[64]) addr := rGPR(rs1); + switch width { + case WORD -> mem_write_ea(addr, 4, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, rl, true) + }; + rs2_val := rGPR(rs2); + switch width { + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, true) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, true) + }; }; } -- cgit v1.2.3 From 69dbe323ef6a8195465e2662fd447e1853e40866 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Sat, 2 Sep 2017 10:23:33 +0100 Subject: fix for parsing diy generated tests --- risc-v/hgen/parser.hgen | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index 4440ffda..dc61e566 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -38,7 +38,13 @@ { `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) } -- cgit v1.2.3 From 75022d46352525305b4c06b4988bf2df15f9f29e Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Sun, 3 Sep 2017 15:05:23 +0100 Subject: added RISC-V strong-acquire/release --- etc/regfp.sail | 4 + risc-v/hgen/ast.hgen | 4 +- risc-v/hgen/fold.hgen | 26 ++--- risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 8 +- risc-v/hgen/lexer.hgen | 86 ++++++++------ risc-v/hgen/map.hgen | 24 ++-- risc-v/hgen/parser.hgen | 7 +- risc-v/hgen/pretty.hgen | 42 +++---- risc-v/hgen/sail_trans_out.hgen | 8 +- risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 8 +- risc-v/hgen/token_types.hgen | 4 +- risc-v/hgen/trans_sail.hgen | 6 +- risc-v/hgen/types.hgen | 14 ++- risc-v/hgen/types_trans_sail.hgen | 17 +++ risc-v/riscv.sail | 155 ++++++++++++++------------ risc-v/riscv_extras.lem | 29 ++--- risc-v/riscv_extras_embed.lem | 19 +++- risc-v/riscv_extras_embed_sequential.lem | 19 +++- risc-v/riscv_regfp.sail | 33 ++++-- src/gen_lib/sail_values.lem | 3 + src/gen_lib/state.lem | 2 + src/lem_interp/sail_impl_base.lem | 24 +++- 22 files changed, 328 insertions(+), 214 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index 761737db..f7744e8c 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -39,8 +39,10 @@ typedef read_kind = enumerate { Read_exclusive_acquire; Read_stream; Read_RISCV_acquire; + Read_RISCV_strong_acquire; Read_RISCV_reserved; Read_RISCV_reserved_acquire; + Read_RISCV_reserved_strong_acquire; } typedef write_kind = enumerate { @@ -51,8 +53,10 @@ typedef write_kind = enumerate { Write_exclusive; Write_exclusive_release; Write_RISCV_release; + Write_RISCV_strong_release; Write_RISCV_conditional; Write_RISCV_conditional_release; + Write_RISCV_conditional_strong_release; } typedef barrier_kind = enumerate { diff --git a/risc-v/hgen/ast.hgen b/risc-v/hgen/ast.hgen index 1839557f..b1968173 100644 --- a/risc-v/hgen/ast.hgen +++ b/risc-v/hgen/ast.hgen @@ -5,8 +5,8 @@ | `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 -| `RISCVStore of bit12 * reg * reg * wordWidth * bool +| `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 diff --git a/risc-v/hgen/fold.hgen b/risc-v/hgen/fold.hgen index d8806a37..4c51e114 100644 --- a/risc-v/hgen/fold.hgen +++ b/risc-v/hgen/fold.hgen @@ -1,16 +1,16 @@ -| `RISCVThreadStart -> (y_reg, y_sreg) -| `RISCVUTYPE (_, r0, _) -> fold_reg r0 (y_reg, y_sreg) -| `RISCVJAL (_, r0) -> fold_reg r0 (y_reg, y_sreg) -| `RISCVJALR (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVBType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVIType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVShiftIop (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVRType (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg))) -| `RISCVLoad (_, r0, r1, _, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVStore (_, r0, r1, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVADDIW (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVSHIFTW (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) -| `RISCVRTYPEW (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg))) +| `RISCVThreadStart -> (y_reg, y_sreg) +| `RISCVUTYPE (_, r0, _) -> fold_reg r0 (y_reg, y_sreg) +| `RISCVJAL (_, r0) -> fold_reg r0 (y_reg, y_sreg) +| `RISCVJALR (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVBType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVIType (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVShiftIop (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVRType (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg))) +| `RISCVLoad (_, r0, r1, _, _, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVStore (_, r0, r1, _, _, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVADDIW (_, r0, r1) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVSHIFTW (_, r0, r1, _) -> fold_reg r0 (fold_reg r1 (y_reg, y_sreg)) +| `RISCVRTYPEW (r0, r1, r2, _) -> fold_reg r0 (fold_reg r1 (fold_reg r2 (y_reg, y_sreg))) | `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/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index 2e508678..e66608e6 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -30,18 +30,20 @@ translate_reg "rs1" rs1, translate_reg "rd" rd, translate_rop op) -| `RISCVLoad(imm, rs, rd, unsigned, width, aq) -> LOAD( +| `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) -| `RISCVStore(imm, rs, rd, width, rl) -> STORE ( + 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, diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index 9d5df538..27df99f4 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -33,31 +33,44 @@ "or", RTYPE{op=RISCVOR}; "and", RTYPE{op=RISCVAND}; -"lb", LOAD{unsigned=false; width=RISCVBYTE; aq=false}; -"lbu", LOAD{unsigned=true; width=RISCVBYTE; aq=false}; -"lh", LOAD{unsigned=false; width=RISCVHALF; aq=false}; -"lhu", LOAD{unsigned=true; width=RISCVHALF; aq=false}; -"lw", LOAD{unsigned=false; width=RISCVWORD; aq=false}; -"lwu", LOAD{unsigned=true; width=RISCVWORD; aq=false}; -"ld", LOAD{unsigned=false; width=RISCVDOUBLE; aq=false}; - -"lb.aq", LOAD{unsigned=false; width=RISCVBYTE; aq=true}; -"lbu.aq", LOAD{unsigned=true; width=RISCVBYTE; aq=true}; -"lh.aq", LOAD{unsigned=false; width=RISCVHALF; aq=true}; -"lhu.aq", LOAD{unsigned=true; width=RISCVHALF; aq=true}; -"lw.aq", LOAD{unsigned=false; width=RISCVWORD; aq=true}; -"lwu.aq", LOAD{unsigned=true; width=RISCVWORD; aq=true}; -"ld.aq", LOAD{unsigned=false; width=RISCVDOUBLE; aq=true}; - -"sb", STORE{width=RISCVBYTE; rl=false}; -"sh", STORE{width=RISCVHALF; rl=false}; -"sw", STORE{width=RISCVWORD; rl=false}; -"sd", STORE{width=RISCVDOUBLE; rl=false}; - -"sb.rl", STORE{width=RISCVBYTE; rl=true}; -"sh.rl", STORE{width=RISCVHALF; rl=true}; -"sw.rl", STORE{width=RISCVWORD; rl=true}; -"sd.rl", STORE{width=RISCVDOUBLE; rl=true}; +"lb", LOAD{unsigned=false; width=RISCVBYTE; aq=false; rl=false}; +"lbu", LOAD{unsigned=true; width=RISCVBYTE; aq=false; rl=false}; +"lh", LOAD{unsigned=false; width=RISCVHALF; aq=false; rl=false}; +"lhu", LOAD{unsigned=true; width=RISCVHALF; aq=false; rl=false}; +"lw", LOAD{unsigned=false; width=RISCVWORD; aq=false; rl=false}; +"lwu", LOAD{unsigned=true; width=RISCVWORD; aq=false; rl=false}; +"ld", LOAD{unsigned=false; width=RISCVDOUBLE; aq=false; rl=false}; + +"lb.aq", LOAD{unsigned=false; width=RISCVBYTE; aq=true; rl=false}; +"lbu.aq", LOAD{unsigned=true; width=RISCVBYTE; aq=true; rl=false}; +"lh.aq", LOAD{unsigned=false; width=RISCVHALF; aq=true; rl=false}; +"lhu.aq", LOAD{unsigned=true; width=RISCVHALF; aq=true; rl=false}; +"lw.aq", LOAD{unsigned=false; width=RISCVWORD; aq=true; rl=false}; +"lwu.aq", LOAD{unsigned=true; width=RISCVWORD; aq=true; rl=false}; +"ld.aq", LOAD{unsigned=false; width=RISCVDOUBLE; aq=true; rl=false}; + +"lb.aq.rl", LOAD{unsigned=false; width=RISCVBYTE; aq=true; rl=true}; +"lbu.aq.rl", LOAD{unsigned=true; width=RISCVBYTE; aq=true; rl=true}; +"lh.aq.rl", LOAD{unsigned=false; width=RISCVHALF; aq=true; rl=true}; +"lhu.aq.rl", LOAD{unsigned=true; width=RISCVHALF; aq=true; rl=true}; +"lw.aq.rl", LOAD{unsigned=false; width=RISCVWORD; aq=true; rl=true}; +"lwu.aq.rl", LOAD{unsigned=true; width=RISCVWORD; aq=true; rl=true}; +"ld.aq.rl", LOAD{unsigned=false; width=RISCVDOUBLE; aq=true; rl=true}; + +"sb", STORE{width=RISCVBYTE; aq=false; rl=false}; +"sh", STORE{width=RISCVHALF; aq=false; rl=false}; +"sw", STORE{width=RISCVWORD; aq=false; rl=false}; +"sd", STORE{width=RISCVDOUBLE; aq=false; rl=false}; + +"sb.rl", STORE{width=RISCVBYTE; aq=false; rl=true}; +"sh.rl", STORE{width=RISCVHALF; aq=false; rl=true}; +"sw.rl", STORE{width=RISCVWORD; aq=false; rl=true}; +"sd.rl", STORE{width=RISCVDOUBLE; aq=false; rl=true}; + +"sb.aq.rl", STORE{width=RISCVBYTE; aq=true; rl=true}; +"sh.aq.rl", STORE{width=RISCVHALF; aq=true; rl=true}; +"sw.aq.rl", STORE{width=RISCVWORD; aq=true; rl=true}; +"sd.aq.rl", STORE{width=RISCVDOUBLE; aq=true; rl=true}; "addiw", ADDIW (); @@ -75,17 +88,22 @@ "r", FENCEOPTION Fence_R; "w", FENCEOPTION Fence_W; "rw", FENCEOPTION Fence_RW; -"fence.i", FENCEI (); -"lr.w", LOADRES {width=RISCVWORD; aq=false; rl=false}; -"lr.w.aq", LOADRES {width=RISCVWORD; aq=true; rl=false}; -"lr.d", LOADRES {width=RISCVDOUBLE; aq=false; rl=false}; -"lr.d.aq", LOADRES {width=RISCVDOUBLE; aq=true; rl=false}; +"fence.i", FENCEI (); -"sc.w", STORECON {width=RISCVWORD; aq=false; rl=false}; -"sc.w.rl", STORECON {width=RISCVWORD; aq=false; rl=true}; -"sc.d", STORECON {width=RISCVDOUBLE; aq=false; rl=false}; -"sc.d.rl", STORECON {width=RISCVDOUBLE; aq=false; rl=true}; +"lr.w", LOADRES {width=RISCVWORD; aq=false; rl=false}; +"lr.w.aq", LOADRES {width=RISCVWORD; aq=true; rl=false}; +"lr.w.aq.rl", LOADRES {width=RISCVWORD; aq=true; rl=true}; +"lr.d", LOADRES {width=RISCVDOUBLE; aq=false; rl=false}; +"lr.d.aq", LOADRES {width=RISCVDOUBLE; aq=true; rl=false}; +"lr.d.aq.rl", LOADRES {width=RISCVDOUBLE; aq=true; rl=true}; + +"sc.w", STORECON {width=RISCVWORD; aq=false; rl=false}; +"sc.w.rl", STORECON {width=RISCVWORD; aq=false; rl=true}; +"sc.w.aq.rl", STORECON {width=RISCVWORD; aq=true; rl=true}; +"sc.d", STORECON {width=RISCVDOUBLE; aq=false; rl=false}; +"sc.d.rl", STORECON {width=RISCVDOUBLE; aq=false; rl=true}; +"sc.d.aq.rl", STORECON {width=RISCVDOUBLE; aq=true; rl=true}; "amoswap.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOSWAP}; "amoadd.w", AMO {width=RISCVWORD; aq=false; rl=false; op=RISCVAMOADD}; diff --git a/risc-v/hgen/map.hgen b/risc-v/hgen/map.hgen index 91eecc56..bab5ced8 100644 --- a/risc-v/hgen/map.hgen +++ b/risc-v/hgen/map.hgen @@ -1,15 +1,15 @@ -| `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) -> `RISCVLoad (x, map_reg r0, map_reg r1, y, z, a) -| `RISCVStore (x, r0, r1, y, z) -> `RISCVStore (x, map_reg r0, map_reg r1, y, z) -| `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) +| `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) | `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/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index dc61e566..82bb1d5b 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -13,9 +13,9 @@ | RTYPE reg COMMA reg COMMA reg { `RISCVRType ($6, $4, $2, $1.op) } | LOAD reg COMMA NUM LPAR reg RPAR - { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width, $1.aq) } + { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width, $1.aq, $1.rl) } | STORE reg COMMA NUM LPAR reg RPAR - { `RISCVStore($4, $2, $6, $1.width, $1.rl) } + { `RISCVStore($4, $2, $6, $1.width, $1.aq, $1.rl) } | ADDIW reg COMMA reg COMMA NUM { `RISCVADDIW ($6, $4, $2) } | SHIFTW reg COMMA reg COMMA NUM @@ -48,3 +48,6 @@ `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' offset must be 0" else + `RISCVAMO($1.op, $1.aq, $1.rl, $4, $8, $1.width, $2) } diff --git a/risc-v/hgen/pretty.hgen b/risc-v/hgen/pretty.hgen index b5068c71..fc1c0000 100644 --- a/risc-v/hgen/pretty.hgen +++ b/risc-v/hgen/pretty.hgen @@ -7,34 +7,24 @@ | `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) - -> sprintf "%s %s, %d(%s)" (pp_riscv_load_op (unsigned, width, aq)) (pp_reg rd) imm (pp_reg rs) -| `RISCVStore(imm, rs2, rs1, width, rl) - -> sprintf "%s %s, %d(%s)" (pp_riscv_store_op (width, rl)) (pp_reg rs2) imm (pp_reg rs1) + +| `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(pred, succ) -> sprintf "fence %s, %s" (pp_riscv_fence_option pred) (pp_riscv_fence_option succ) | `RISCVFENCEI -> sprintf "fence.i" -| `RISCVLoadRes(aq, rl, rs1, width, rd) - -> - assert (rl = false); - 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) - -> - assert (aq = false); - 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) + +| `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/risc-v/hgen/sail_trans_out.hgen b/risc-v/hgen/sail_trans_out.hgen index bec35203..2f9a80f1 100644 --- a/risc-v/hgen/sail_trans_out.hgen +++ b/risc-v/hgen/sail_trans_out.hgen @@ -6,10 +6,10 @@ | ("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]) - -> `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) -| ("STORE", [imm; rs; rd; width; rl]) - -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, translate_out_bool rl) +| ("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) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index 662b1044..23bcc4cb 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -6,10 +6,10 @@ | 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) - -> `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) -| STORE( imm, rs, rd, width, rl) - -> `RISCVStore(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd, translate_out_wordWidth width, translate_out_bool rl) +| 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) diff --git a/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index 9b469a27..d338d865 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -5,8 +5,8 @@ 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 } -type token_Store = {width : wordWidth; rl: bool } +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 } diff --git a/risc-v/hgen/trans_sail.hgen b/risc-v/hgen/trans_sail.hgen index 12da62d8..8b7cbe11 100644 --- a/risc-v/hgen/trans_sail.hgen +++ b/risc-v/hgen/trans_sail.hgen @@ -58,7 +58,7 @@ translate_rop "op" op; ], []) -| `RISCVLoad(imm, rs, rd, unsigned, width, aq) -> +| `RISCVLoad(imm, rs, rd, unsigned, width, aq, rl) -> ("LOAD", [ translate_imm12 "imm" imm; @@ -67,15 +67,17 @@ translate_bool "unsigned" unsigned; translate_width "width" width; translate_bool "aq" aq; + translate_bool "rl" rl; ], []) -| `RISCVStore(imm, rs2, rs1, width, 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; ], []) diff --git a/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index 83deb4a2..e0caed2d 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -99,7 +99,7 @@ type wordWidth = | RISCVWORD | RISCVDOUBLE -let pp_riscv_load_op (unsigned, width, aq) = +let pp_riscv_load_op (unsigned, width, aq, rl) = begin match (unsigned, width) with | (false, RISCVBYTE) -> "lb" | (true, RISCVBYTE) -> "lbu" @@ -108,17 +108,19 @@ let pp_riscv_load_op (unsigned, width, aq) = | (false, RISCVWORD) -> "lw" | (true, RISCVWORD) -> "lwu" | (_, RISCVDOUBLE) -> "ld" - end - ^ (if aq then ".aq" else "") + end ^ + (if aq then ".aq" else "") ^ + (if rl then ".rl" else "") -let pp_riscv_store_op (width, rl) = +let pp_riscv_store_op (width, aq, rl) = begin match width with | RISCVBYTE -> "sb" | RISCVHALF -> "sh" | RISCVWORD -> "sw" | RISCVDOUBLE -> "sd" - end - ^ (if rl then ".rl" else "") + end ^ + (if aq then ".aq" else "") ^ + (if rl then ".rl" else "") let pp_riscv_load_reserved_op (aq, rl, width) = "lr" ^ diff --git a/risc-v/hgen/types_trans_sail.hgen b/risc-v/hgen/types_trans_sail.hgen index 7528a522..238c7e5b 100644 --- a/risc-v/hgen/types_trans_sail.hgen +++ b/risc-v/hgen/types_trans_sail.hgen @@ -11,30 +11,47 @@ let translate_enum enum_values name value = (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_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/risc-v/riscv.sail b/risc-v/riscv.sail index cd0e5bf9..c5b19d26 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -62,38 +62,56 @@ function forall 'a. 'a effect { escape } not_implemented((string) message) = val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_acquire +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_strong_acquire val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_acquire -function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) res) = - switch (aq, res) { - case (false, false) -> MEMr(addr, width) - case (true, false) -> MEMr_acquire(addr, width) - case (false, true) -> MEMr_reserved(addr, width) - case (true, true) -> MEMr_reserved_acquire(addr, width) +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_strong_acquire +function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) rl, (bool) res) = + switch (aq, rl, res) { + case (false, false, false) -> MEMr(addr, width) + case (true, false, false) -> MEMr_acquire(addr, width) + case (false, false, true) -> MEMr_reserved(addr, width) + case (true, false, true) -> MEMr_reserved_acquire(addr, width) + case (false, true, false) -> not_implemented("load.rl is not implemented") + case (true, true, false) -> MEMr_strong_acquire(addr, width) + case (false, true, true) -> not_implemented("lr.rl is not implemented") + case (true, true, true) -> MEMr_reserved_strong_acquire(addr, width) } val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_strong_release val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release -function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) rl, (bool) con) = - switch (rl, con) { - case (false, false) -> MEMea(addr, width) - case (true, false) -> MEMea_release(addr, width) - case (false, true) -> MEMea_conditional(addr, width) - case (true , true) -> MEMea_conditional_release(addr, width) +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_strong_release +function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) aq, (bool) rl, (bool) con) = + switch (aq, rl, con) { + case (false, false, false) -> MEMea(addr, width) + case (false, true, false) -> MEMea_release(addr, width) + case (false, false, true) -> MEMea_conditional(addr, width) + case (false, true , true) -> MEMea_conditional_release(addr, width) + case (true, false, false) -> not_implemented("store.aq is not implemented") + case (true, true, false) -> MEMea_strong_release(addr, width) + case (true, false, true) -> not_implemented("sc.aq is not implemented") + case (true, true , true) -> MEMea_conditional_strong_release(addr, width) } val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_strong_release val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_release -function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) rl, (bool) con) = - switch (rl, con) { - case (false, false) -> MEMval(addr, width, value) - case (true, false) -> MEMval_release(addr, width, value) - case (false, true) -> MEMval_conditional(addr, width, value) - case (true, true) -> MEMval_conditional_release(addr, width, value) +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_strong_release +function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) aq, (bool) rl, (bool) con) = + switch (aq, rl, con) { + case (false, false, false) -> MEMval(addr, width, value) + case (false, true, false) -> MEMval_release(addr, width, value) + case (false, false, true) -> MEMval_conditional(addr, width, value) + case (false, true, true) -> MEMval_conditional_release(addr, width, value) + case (true, false, false) -> not_implemented("store.aq is not implemented") + case (true, true, false) -> MEMval_strong_release(addr, width, value) + case (true, false, true) -> not_implemented("sc.aq is not implemented") + case (true, true, true) -> MEMval_conditional_strong_release(addr, width, value) } val extern unit -> bool effect {exmem} speculate_conditional_success @@ -245,51 +263,51 @@ function clause execute (RTYPE(rs2, rs1, rd, op)) = } in wGPR(rd, result) -union ast member ((bit[12]), regno, regno, bool, word_width, bool) LOAD -function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, DOUBLE, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF, false)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD, false)) -function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq)) = +union ast member ((bit[12]), regno, regno, bool, word_width, bool, bool) LOAD +function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, DOUBLE, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF, false, false)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD, false, false)) +function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in let (bit[64]) result = if unsigned then switch (width) { - case BYTE -> EXTZ(mem_read(addr, 1, aq, false)) - case HALF -> EXTZ(mem_read(addr, 2, aq, false)) - case WORD -> EXTZ(mem_read(addr, 4, aq, false)) - case DOUBLE -> mem_read(addr, 8, aq, false) + case BYTE -> EXTZ(mem_read(addr, 1, aq, rl, false)) + case HALF -> EXTZ(mem_read(addr, 2, aq, rl, false)) + case WORD -> EXTZ(mem_read(addr, 4, aq, rl, false)) + case DOUBLE -> mem_read(addr, 8, aq, rl, false) } else switch (width) { - case BYTE -> EXTS(mem_read(addr, 1, aq, false)) - case HALF -> EXTS(mem_read(addr, 2, aq, false)) - case WORD -> EXTS(mem_read(addr, 4, aq, false)) - case DOUBLE -> mem_read(addr, 8, aq, false) + case BYTE -> EXTS(mem_read(addr, 1, aq, rl, false)) + case HALF -> EXTS(mem_read(addr, 2, aq, rl, false)) + case WORD -> EXTS(mem_read(addr, 4, aq, rl, false)) + case DOUBLE -> mem_read(addr, 8, aq, rl, false) } in wGPR(rd, result) -union ast member ((bit[12]), regno, regno, word_width, bool) STORE -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE, false)) -function clause execute (STORE(imm, rs2, rs1, width, rl)) = +union ast member ((bit[12]), regno, regno, word_width, bool, bool) STORE +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE, false, false)) +function clause execute (STORE(imm, rs2, rs1, width, aq, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in { switch (width) { - case BYTE -> mem_write_ea(addr, 1, rl, false) - case HALF -> mem_write_ea(addr, 2, rl, false) - case WORD -> mem_write_ea(addr, 4, rl, false) - case DOUBLE -> mem_write_ea(addr, 8, rl, false) + case BYTE -> mem_write_ea(addr, 1, aq, rl, false) + case HALF -> mem_write_ea(addr, 2, aq, rl, false) + case WORD -> mem_write_ea(addr, 4, aq, rl, false) + case DOUBLE -> mem_write_ea(addr, 8, aq, rl, false) }; let rs2_val = rGPR(rs2) in switch (width) { - case BYTE -> mem_write_value(addr, 1, rs2_val[7..0], rl, false) - case HALF -> mem_write_value(addr, 2, rs2_val[15..0], rl, false) - case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, false) - case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, false) + case BYTE -> mem_write_value(addr, 1, rs2_val[7..0], aq, rl, false) + case HALF -> mem_write_value(addr, 2, rs2_val[15..0], aq, rl, false) + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], aq, rl, false) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, aq, rl, false) } } @@ -360,36 +378,31 @@ union ast member (bool, bool, regno, word_width, regno) LOADRES function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, WORD, rd)) function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, DOUBLE, rd)) function clause execute(LOADRES(aq, rl, rs1, width, rd)) = - if rl then not_implemented("load-reserved-release is not implemented") - else { - let (bit[64]) addr = rGPR(rs1) in - let (bit[64]) result = - switch width { - case WORD -> EXTS(mem_read(addr, 4, aq, true)) - case DOUBLE -> mem_read(addr, 8, aq, true) - } in - wGPR(rd, result) - } + let (bit[64]) addr = rGPR(rs1) in + let (bit[64]) result = + switch width { + case WORD -> EXTS(mem_read(addr, 4, aq, rl, true)) + case DOUBLE -> mem_read(addr, 8, aq, rl, true) + } in + wGPR(rd, result) union ast member (bool, bool, regno, regno, word_width, regno) STORECON function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, WORD, rd)) function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, DOUBLE, rd)) function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { - if aq then not_implemented("store-conditional-acquire is not implemented"); - (*(bit)*) status := if speculate_conditional_success() then 0 else 1; wGPR(rd) := (bit[64]) (EXTZ([status])); if status == 1 then () else { (bit[64]) addr := rGPR(rs1); switch width { - case WORD -> mem_write_ea(addr, 4, rl, true) - case DOUBLE -> mem_write_ea(addr, 8, rl, true) + case WORD -> mem_write_ea(addr, 4, aq, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, aq, rl, true) }; rs2_val := rGPR(rs2); switch width { - case WORD -> mem_write_value(addr, 4, rs2_val[31..0], rl, true) - case DOUBLE -> mem_write_value(addr, 8, rs2_val, rl, true) + case WORD -> mem_write_value(addr, 4, rs2_val[31..0], aq, rl, true) + case DOUBLE -> mem_write_value(addr, 8, rs2_val, aq, rl, true) }; }; } @@ -418,14 +431,14 @@ function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { (bit[64]) addr := rGPR(rs1); switch (width) { - case WORD -> mem_write_ea(addr, 4, rl, true) - case DOUBLE -> mem_write_ea(addr, 8, rl, true) + case WORD -> mem_write_ea(addr, 4, aq, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, aq, rl, true) }; (bit[64]) loaded := switch (width) { - case WORD -> EXTS(mem_read(addr, 4, aq, true)) - case DOUBLE -> mem_read(addr, 8, aq, true) + case WORD -> EXTS(mem_read(addr, 4, aq, rl, true)) + case DOUBLE -> mem_read(addr, 8, aq, rl, true) }; wGPR(rd, loaded); @@ -445,8 +458,8 @@ function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { }; switch (width) { - case WORD -> mem_write_value(addr, 4, result[31..0], rl, true) - case DOUBLE -> mem_write_value(addr, 8, result, rl, true) + case WORD -> mem_write_value(addr, 4, result[31..0], aq, rl, true) + case DOUBLE -> mem_write_value(addr, 8, result, aq, rl, true) }; } diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index 62a7bb91..280095e5 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -34,8 +34,11 @@ let memory_parameter_transformer_option_address _mode v = let read_memory_functions : memory_reads = [ ("MEMr", (MR Read_plain memory_parameter_transformer)); ("MEMr_acquire", (MR Read_RISCV_acquire memory_parameter_transformer)); + ("MEMr_strong_acquire", (MR Read_RISCV_strong_acquire memory_parameter_transformer)); ("MEMr_reserved", (MR Read_RISCV_reserved memory_parameter_transformer)); ("MEMr_reserved_acquire", (MR Read_RISCV_reserved_acquire memory_parameter_transformer)); + ("MEMr_reserved_strong_acquire", + (MR Read_RISCV_reserved_acquire memory_parameter_transformer)); ] let memory_writes : memory_writes = @@ -44,25 +47,23 @@ let memory_writes : memory_writes = let memory_eas : memory_write_eas = [ ("MEMea", (MEA Write_plain memory_parameter_transformer)); ("MEMea_release", (MEA Write_RISCV_release memory_parameter_transformer)); + ("MEMea_strong_release", (MEA Write_RISCV_strong_release memory_parameter_transformer)); ("MEMea_conditional", (MEA Write_RISCV_conditional memory_parameter_transformer)); ("MEMea_conditional_release", (MEA Write_RISCV_conditional_release memory_parameter_transformer)); + ("MEMea_conditional_strong_release", + (MEA Write_RISCV_conditional_strong_release + memory_parameter_transformer)); ] let memory_vals : memory_write_vals = - [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing)); - ("MEMval_release", (MV memory_parameter_transformer_option_address Nothing)); - ("MEMval_conditional", (MV memory_parameter_transformer_option_address Nothing)); - (* (MV memory_parameter_transformer_option_address - (Just - (fun (IState interp context) b -> - let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in - (IState (Interp.add_answer_to_stack interp bit) context))))); *) - ("MEMval_conditional_release", (MV memory_parameter_transformer_option_address Nothing)); - (* (MV memory_parameter_transformer_option_address - (Just - (fun (IState interp context) b -> - let bit = Interp_ast.V_lit (L_aux (if b then L_one else L_zero) Interp_ast.Unknown) in - (IState (Interp.add_answer_to_stack interp bit) context))))); *) + [ ("MEMval", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_release", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_strong_release", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_conditional", (MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_conditional_release",(MV memory_parameter_transformer_option_address Nothing)); + ("MEMval_conditional_strong_release", + (MV memory_parameter_transformer_option_address Nothing)); + ] let speculate_conditional_success : excl_res = diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index 3f04f9a2..d89dc44c 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -6,33 +6,48 @@ open import Prompt val MEMr : (vector bitU * integer) -> M (vector bitU) val MEMr_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_strong_acquire : (vector bitU * integer) -> M (vector bitU) val MEMr_reserved : (vector bitU * integer) -> M (vector bitU) val MEMr_reserved_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved_strong_acquire : (vector bitU * integer) -> M (vector bitU) let MEMr (addr,size) = read_mem false Read_plain addr size let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr size +let MEMr_strong_acquire (addr,size) = read_mem false Read_RISCV_strong_acquire addr size let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size +let MEMr_reserved_strong_acquire (addr,size) + = read_mem false Read_RISCV_reserved_strong_acquire addr size val MEMea : (vector bitU * integer) -> M unit val MEMea_release : (vector bitU * integer) -> M unit +val MEMea_strong_release : (vector bitU * integer) -> M unit val MEMea_conditional : (vector bitU * integer) -> M unit val MEMea_conditional_release : (vector bitU * integer) -> M unit +val MEMea_conditional_strong_release : (vector bitU * integer) -> M unit 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 MEMval : (vector bitU * integer * vector bitU) -> M unit val MEMval_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_strong_release : (vector bitU * integer * vector bitU) -> M unit val MEMval_conditional : (vector bitU * integer * vector bitU) -> M unit val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional_strong_release : (vector bitU * integer * vector bitU) -> M unit let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) -let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) +let MEMval_strong_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional_strong_release (_,_,v) + = write_mem_val v >>= fun _ -> return () let speculate_conditional_success () = excl_result () >>= fun b -> return (if b then B1 else B0) diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index dabd4d12..1f2a0e47 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -6,33 +6,48 @@ open import State val MEMr : (vector bitU * integer) -> M (vector bitU) val MEMr_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_strong_acquire : (vector bitU * integer) -> M (vector bitU) val MEMr_reserved : (vector bitU * integer) -> M (vector bitU) val MEMr_reserved_acquire : (vector bitU * integer) -> M (vector bitU) +val MEMr_reserved_strong_acquire : (vector bitU * integer) -> M (vector bitU) let MEMr (addr,size) = read_mem false Read_plain addr size let MEMr_acquire (addr,size) = read_mem false Read_RISCV_acquire addr size +let MEMr_strong_acquire (addr,size) = read_mem false Read_RISCV_strong_acquire addr size let MEMr_reserved (addr,size) = read_mem false Read_RISCV_reserved addr size let MEMr_reserved_acquire (addr,size) = read_mem false Read_RISCV_reserved_acquire addr size +let MEMr_reserved_strong_acquire (addr,size) + = read_mem false Read_RISCV_reserved_strong_acquire addr size val MEMea : (vector bitU * integer) -> M unit val MEMea_release : (vector bitU * integer) -> M unit +val MEMea_strong_release : (vector bitU * integer) -> M unit val MEMea_conditional : (vector bitU * integer) -> M unit val MEMea_conditional_release : (vector bitU * integer) -> M unit +val MEMea_conditional_strong_release : (vector bitU * integer) -> M unit 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 MEMval : (vector bitU * integer * vector bitU) -> M unit val MEMval_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_strong_release : (vector bitU * integer * vector bitU) -> M unit val MEMval_conditional : (vector bitU * integer * vector bitU) -> M unit val MEMval_conditional_release : (vector bitU * integer * vector bitU) -> M unit +val MEMval_conditional_strong_release : (vector bitU * integer * vector bitU) -> M unit let MEMval (_,_,v) = write_mem_val v >>= fun _ -> return () let MEMval_release (_,_,v) = write_mem_val v >>= fun _ -> return () -let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) -let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () (* (if b then B1 else B0) *) +let MEMval_strong_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional_release (_,_,v) = write_mem_val v >>= fun _ -> return () +let MEMval_conditional_strong_release (_,_,v) + = write_mem_val v >>= fun _ -> return () let speculate_conditional_success () = excl_result () >>= fun b -> return (if b then B1 else B0) diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index e6813c37..602f0bec 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -51,17 +51,29 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; } - case (LOAD ( imm, rs, rd, unsign, width, aq)) -> { (* XXX "unsigned" causes name conflict in lem shallow embedding... *) + case (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 := if aq then IK_mem_read (Read_RISCV_acquire) else IK_mem_read (Read_plain); + ik := + switch (aq, rl) { + case (false, false) -> IK_mem_read (Read_plain) + case (true, false) -> IK_mem_read (Read_RISCV_acquire) + case (false, true) -> exit "not implemented" + case (true, true) -> IK_mem_read (Read_RISCV_strong_acquire) + }; } - case (STORE( imm, rs2, rs1, width, rl)) -> { + case (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 := if rl then IK_mem_write (Write_RISCV_release) else IK_mem_write (Write_plain); + ik := + switch (aq, rl) { + case (false, false) -> IK_mem_write (Write_plain) + case (true, false) -> exit "not implemented" + case (false, true) -> IK_mem_write (Write_RISCV_release) + case (true, true) -> IK_mem_write (Write_RISCV_strong_release) + }; } case (ADDIW ( imm, rs, rd)) -> { if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; @@ -96,7 +108,8 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( ik := switch (aq, rl) { case (false, false) -> IK_mem_read (Read_RISCV_reserved) case (true, false) -> IK_mem_read (Read_RISCV_reserved_acquire) - case (_, true) -> exit "not implemented" + case (false, true) -> exit "not implemented" + case (true, true) -> IK_mem_read (Read_RISCV_reserved_strong_acquire) }; } case (STORECON( aq, rl, rs2, rs1, width, rd)) -> { @@ -118,10 +131,12 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; ik := switch (aq, rl) { - case (false, false) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional) - case (false, true) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional_release) - case (true, false) -> IK_mem_rmw (Read_RISCV_reserved_acquire, Write_RISCV_conditional) - case (true, true) -> IK_mem_rmw (Read_RISCV_reserved_acquire, Write_RISCV_conditional_release) + case (false, false) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional) + case (false, true) -> IK_mem_rmw (Read_RISCV_reserved, Write_RISCV_conditional_release) + case (true, false) -> IK_mem_rmw (Read_RISCV_reserved_acquire, + Write_RISCV_conditional) + case (true, true) -> IK_mem_rmw (Read_RISCV_reserved_strong_acquire, + Write_RISCV_conditional_strong_release) }; } }; diff --git a/src/gen_lib/sail_values.lem b/src/gen_lib/sail_values.lem index 49f37381..121f6cc8 100644 --- a/src/gen_lib/sail_values.lem +++ b/src/gen_lib/sail_values.lem @@ -956,3 +956,6 @@ let diafp_to_dia reginfo = function | DIAFP_concrete v -> DIA_concrete_address (address_of_bitv v) | DIAFP_reg r -> DIA_register (regfp_to_reg reginfo r) end + +let max = uncurry max +let min = uncurry min diff --git a/src/gen_lib/state.lem b/src/gen_lib/state.lem index 2ea1247e..ac5cb869 100644 --- a/src/gen_lib/state.lem +++ b/src/gen_lib/state.lem @@ -55,8 +55,10 @@ let is_exclusive = function | Sail_impl_base.Read_exclusive_acquire -> true | Sail_impl_base.Read_stream -> false | Sail_impl_base.Read_RISCV_acquire -> false + | Sail_impl_base.Read_RISCV_strong_acquire -> false | Sail_impl_base.Read_RISCV_reserved -> true | Sail_impl_base.Read_RISCV_reserved_acquire -> true + | Sail_impl_base.Read_RISCV_reserved_strong_acquire -> true end diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index c577c44b..48ddd10e 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -436,7 +436,9 @@ type read_kind = (* AArch64 reads *) | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream (* RISC-V reads *) - | Read_RISCV_acquire | Read_RISCV_reserved | Read_RISCV_reserved_acquire + | Read_RISCV_acquire | Read_RISCV_strong_acquire + | Read_RISCV_reserved | Read_RISCV_reserved_acquire + | Read_RISCV_reserved_strong_acquire instance (Show read_kind) let show = function @@ -447,8 +449,10 @@ instance (Show read_kind) | Read_exclusive_acquire -> "Read_exclusive_acquire" | Read_stream -> "Read_stream" | Read_RISCV_acquire -> "Read_RISCV_acquire" + | Read_RISCV_strong_acquire -> "Read_RISCV_strong_acquire" | Read_RISCV_reserved -> "Read_RISCV_reserved" | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire" + | Read_RISCV_reserved_strong_acquire -> "Read_RISCV_reserved_strong_acquire" end end @@ -460,7 +464,9 @@ type write_kind = (* AArch64 writes *) | Write_release | Write_exclusive | Write_exclusive_release (* RISC-V *) - | Write_RISCV_release | Write_RISCV_conditional | Write_RISCV_conditional_release + | Write_RISCV_release | Write_RISCV_strong_release + | Write_RISCV_conditional | Write_RISCV_conditional_release + | Write_RISCV_conditional_strong_release instance (Show write_kind) let show = function @@ -470,8 +476,10 @@ instance (Show write_kind) | Write_exclusive -> "Write_exclusive" | Write_exclusive_release -> "Write_exclusive_release" | Write_RISCV_release -> "Write_RISCV_release" + | Write_RISCV_strong_release -> "Write_RISCV_strong_release" | Write_RISCV_conditional -> "Write_RISCV_conditional" | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release" + | Write_RISCV_conditional_strong_release -> "Write_RISCV_conditional_strong_release" end end @@ -566,8 +574,10 @@ instance (EnumerationType read_kind) | Read_exclusive_acquire -> 4 | Read_stream -> 5 | Read_RISCV_acquire -> 6 - | Read_RISCV_reserved -> 7 - | Read_RISCV_reserved_acquire -> 8 + | Read_RISCV_strong_acquire -> 7 + | Read_RISCV_reserved -> 8 + | Read_RISCV_reserved_acquire -> 9 + | Read_RISCV_reserved_strong_acquire -> 10 end end @@ -579,8 +589,10 @@ instance (EnumerationType write_kind) | Write_exclusive -> 3 | Write_exclusive_release -> 4 | Write_RISCV_release -> 5 - | Write_RISCV_conditional -> 6 - | Write_RISCV_conditional_release -> 7 + | Write_RISCV_strong_release -> 6 + | Write_RISCV_conditional -> 7 + | Write_RISCV_conditional_release -> 8 + | Write_RISCV_conditional_strong_release -> 9 end end -- cgit v1.2.3 From 5207f6f2c53c9661bb4087a65f46fe6c5a74a776 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Wed, 6 Sep 2017 16:46:14 +0100 Subject: power is builtin in old tc so use it. --- x86/x64.sail | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index 902a861e..2d17cf86 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -401,10 +401,7 @@ function unit erase_eflags () = ZF := undefined; } -(* XXXXX *) -function nat power ((nat) x, ([|64|]) y) = undefined - -function nat value_width ((wsize) sz) = power (2, size_width(sz)) +function nat value_width ((wsize) sz) = 2 ** size_width(sz) function bit word_signed_overflow_add ((wsize) sz, (qword) a, (qword) b) = (bit) (word_size_msb (sz, a) == word_size_msb (sz, b) & -- cgit v1.2.3 From c5b352f9fb87c1d42d93df4cb39cce7a0f8e0ff0 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Thu, 7 Sep 2017 11:59:27 +0100 Subject: add MFENCE --- x86/x64.sail | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/x86/x64.sail b/x86/x64.sail index 2d17cf86..2f75f540 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -108,6 +108,7 @@ val extern forall Nat 'n. (qword, [|'n|]) -> (bit[8 * 'n]) effect { rmem } rMEM val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval +val extern unit -> unit effect { barr } X86_MFENCE function forall Nat 'n. unit effect {eamem, wmv} wMEM ((qword) addr, ([|'n|]) len, (bit[8 * 'n]) data) = { MEMea(addr, len); @@ -582,7 +583,7 @@ function unit drop ((qword) i) = if i[7 ..0] != 0 then () else RSP := RSP + i scattered function unit execute scattered typedef ast = const union -val ast -> unit effect {escape, rmem, rreg, undef, eamem, wmv, wreg} execute +val ast -> unit effect {escape, rmem, rreg, undef, eamem, wmv, wreg, barr} execute (* ========================================================================== Binop @@ -716,6 +717,15 @@ function clause execute (LOOP (c,i)) = if RCX != 0 & read_cond (c) then RIP := RIP + i else (); } +(* ========================================================================== + MFENCE + ========================================================================== *) + +union ast member unit MFENCE + +function clause execute (MFENCE) = + X86_MFENCE () + (* ========================================================================== Monop ========================================================================== *) -- cgit v1.2.3 From 53f13aeb3ff1289d92211aec6181cf178df82993 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Mon, 11 Sep 2017 10:36:55 +0100 Subject: added xml pp --- risc-v/hgen/pretty_xml.hgen | 137 ++++++++++++++++++++++++++++++++++++++++++++ risc-v/hgen/types.hgen | 53 +++++++---------- 2 files changed, 159 insertions(+), 31 deletions(-) create mode 100644 risc-v/hgen/pretty_xml.hgen diff --git a/risc-v/hgen/pretty_xml.hgen b/risc-v/hgen/pretty_xml.hgen new file mode 100644 index 00000000..b0306161 --- /dev/null +++ b/risc-v/hgen/pretty_xml.hgen @@ -0,0 +1,137 @@ +| `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(pred, succ) -> + ("op_fence", + [ ("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/risc-v/hgen/types.hgen b/risc-v/hgen/types.hgen index e0caed2d..a0b75606 100644 --- a/risc-v/hgen/types.hgen +++ b/risc-v/hgen/types.hgen @@ -99,46 +99,36 @@ type wordWidth = | 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) = - begin match (unsigned, width) with - | (false, RISCVBYTE) -> "lb" - | (true, RISCVBYTE) -> "lbu" - | (false, RISCVHALF) -> "lh" - | (true, RISCVHALF) -> "lhu" - | (false, RISCVWORD) -> "lw" - | (true, RISCVWORD) -> "lwu" - | (_, RISCVDOUBLE) -> "ld" - end ^ + "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) = - begin match width with - | RISCVBYTE -> "sb" - | RISCVHALF -> "sh" - | RISCVWORD -> "sw" - | RISCVDOUBLE -> "sd" - end ^ + "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" ^ - begin match width with - | RISCVWORD -> ".w" - | RISCVDOUBLE -> ".d" - | _ -> assert false - end ^ + "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" ^ - begin match width with - | RISCVWORD -> ".w" - | RISCVDOUBLE -> ".d" - | _ -> assert false - end ^ + "sc." ^ + (pp_word_width width) ^ (if aq then ".aq" else "") ^ (if rl then ".rl" else "") @@ -153,9 +143,7 @@ type riscvAmoop = | RISCVAMOMINU | RISCVAMOMAXU -let pp_riscv_amo_op (op, aq, rl, width) = - "amo" ^ - begin match op with +let pp_riscv_amo_op_part = function | RISCVAMOSWAP -> "swap" | RISCVAMOADD -> "add" | RISCVAMOXOR -> "xor" @@ -165,7 +153,10 @@ let pp_riscv_amo_op (op, aq, rl, width) = | RISCVAMOMAX -> "max" | RISCVAMOMINU -> "minu" | RISCVAMOMAXU -> "maxu" - end ^ + +let pp_riscv_amo_op (op, aq, rl, width) = + "amo" ^ + pp_riscv_amo_op_part op ^ begin match width with | RISCVWORD -> ".w" | RISCVDOUBLE -> ".d" -- cgit v1.2.3 From 8c143d2aaebaa210e4d4778a0bcfd5326908bdf8 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Wed, 13 Sep 2017 15:33:47 +0100 Subject: add HLT instruction for RMEM integration. --- x86/x64.sail | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/x86/x64.sail b/x86/x64.sail index 2f75f540..9630a873 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -665,6 +665,15 @@ function clause execute (DIV (sz,r)) = erase_eflags(); } +(* ========================================================================== + HLT -- halt instruction used to end test in RMEM + ========================================================================== *) + +union ast member unit HLT + +function clause execute (HLT) = () + + (* ========================================================================== Jcc ========================================================================== *) -- cgit v1.2.3 From a97cd6081df6a76c9daa34c773d82f21f5d014c8 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Fri, 15 Sep 2017 11:50:54 +0100 Subject: reinstate deep/shallow conversion --- src/gen_lib/deep_shallow_convert.lem | 116 ++++++++++++--------- src/lem_interp/sail_impl_base.lem | 2 + src/pretty_print.mli | 2 +- src/pretty_print_lem.ml | 191 +++++++++++++++++------------------ src/process_file.ml | 13 ++- 5 files changed, 176 insertions(+), 148 deletions(-) diff --git a/src/gen_lib/deep_shallow_convert.lem b/src/gen_lib/deep_shallow_convert.lem index 23c34222..4af6eb2f 100644 --- a/src/gen_lib/deep_shallow_convert.lem +++ b/src/gen_lib/deep_shallow_convert.lem @@ -6,20 +6,20 @@ open import Sail_values class (ToFromInterpValue 'a) - val toInterpValue : 'a -> Interp.value - val fromInterpValue : Interp.value -> 'a + val toInterpValue : 'a -> Interp_ast.value + val fromInterpValue : Interp_ast.value -> 'a end let toInterValueBool = function - | true -> Interp.V_lit (L_aux (L_one) Unknown) - | false -> Interp.V_lit (L_aux (L_zero) Unknown) + | true -> Interp_ast.V_lit (L_aux (L_one) Unknown) + | false -> Interp_ast.V_lit (L_aux (L_zero) Unknown) end let rec fromInterpValueBool v = match v with - | Interp.V_lit (L_aux (L_true) _) -> true - | Interp.V_lit (L_aux (L_false) _) -> false - | Interp.V_lit (L_aux (L_one) _) -> true - | Interp.V_lit (L_aux (L_zero) _) -> false - | Interp.V_tuple [v] -> fromInterpValueBool v + | Interp_ast.V_lit (L_aux (L_true) _) -> true + | Interp_ast.V_lit (L_aux (L_false) _) -> false + | Interp_ast.V_lit (L_aux (L_one) _) -> true + | Interp_ast.V_lit (L_aux (L_zero) _) -> false + | Interp_ast.V_tuple [v] -> fromInterpValueBool v | v -> failwith ("fromInterpValue bool: unexpected value. " ^ Interp.debug_print_value v) end @@ -29,10 +29,10 @@ instance (ToFromInterpValue bool) end -let toInterpValueUnit () = Interp.V_lit (L_aux (L_unit) Unknown) +let toInterpValueUnit () = Interp_ast.V_lit (L_aux (L_unit) Unknown) let rec fromInterpValueUnit v = match v with - | Interp.V_lit (L_aux (L_unit) _) -> () - | Interp.V_tuple [v] -> fromInterpValueUnit v + | Interp_ast.V_lit (L_aux (L_unit) _) -> () + | Interp_ast.V_tuple [v] -> fromInterpValueUnit v | v -> failwith ("fromInterpValue unit: unexpected value. " ^ Interp.debug_print_value v) end @@ -44,8 +44,8 @@ end let toInterpValueInteger i = V_lit (L_aux (L_num i) Unknown) let rec fromInterpValueInteger v = match v with - | Interp.V_lit (L_aux (L_num i) _) -> i - | Interp.V_tuple [v] -> fromInterpValueInteger v + | Interp_ast.V_lit (L_aux (L_num i) _) -> i + | Interp_ast.V_tuple [v] -> fromInterpValueInteger v | v -> failwith ("fromInterpValue integer: unexpected value. " ^ Interp.debug_print_value v) end @@ -57,8 +57,8 @@ end let toInterpValueString s = V_lit (L_aux (L_string s) Unknown) let rec fromInterpValueString v = match v with - | Interp.V_lit (L_aux (L_string s) _) -> s - | Interp.V_tuple [v] -> fromInterpValueString v + | Interp_ast.V_lit (L_aux (L_string s) _) -> s + | Interp_ast.V_tuple [v] -> fromInterpValueString v | v -> failwith ("fromInterpValue integer: unexpected value. " ^ Interp.debug_print_value v) end @@ -69,17 +69,17 @@ end let toInterpValueBitU = function - | I -> Interp.V_lit (L_aux (L_one) Unknown) - | O -> Interp.V_lit (L_aux (L_zero) Unknown) - | Undef -> Interp.V_lit (L_aux (L_undef) Unknown) + | I -> Interp_ast.V_lit (L_aux (L_one) Unknown) + | O -> Interp_ast.V_lit (L_aux (L_zero) Unknown) + | Undef -> Interp_ast.V_lit (L_aux (L_undef) Unknown) end let rec fromInterpValueBitU v = match v with - | Interp.V_lit (L_aux (L_one) _) -> I - | Interp.V_lit (L_aux (L_zero) _) -> O - | Interp.V_lit (L_aux (L_undef) _) -> Undef - | Interp.V_lit (L_aux (L_true) _) -> I - | Interp.V_lit (L_aux (L_false) _) -> O - | Interp.V_tuple [v] -> fromInterpValueBitU v + | Interp_ast.V_lit (L_aux (L_one) _) -> B1 + | Interp_ast.V_lit (L_aux (L_zero) _) -> B0 + | Interp_ast.V_lit (L_aux (L_undef) _) -> BU + | Interp_ast.V_lit (L_aux (L_true) _) -> B1 + | Interp_ast.V_lit (L_aux (L_false) _) -> B0 + | Interp_ast.V_tuple [v] -> fromInterpValueBitU v | v -> failwith ("fromInterpValue bitU: unexpected value. " ^ Interp.debug_print_value v) end @@ -383,29 +383,31 @@ instance forall 'a. ToFromInterpValue 'a => (ToFromInterpValue (maybe 'a)) end -module SI = Interp -module SIA = Interp_ast - - let read_kindToInterpValue = function | Read_plain -> V_ctor (Id_aux (Id "Read_plain") Unknown) (T_id "read_kind") (C_Enum 0) (toInterpValue ()) - | Read_tag -> V_ctor (Id_aux (Id "Read_tag") Unknown) (T_id "read_kind") (C_Enum 1) (toInterpValue ()) - | Read_tag_reserve -> V_ctor (Id_aux (Id "Read_tag_reserve") Unknown) (T_id "read_kind") (C_Enum 1) (toInterpValue ()) | Read_reserve -> V_ctor (Id_aux (Id "Read_reserve") Unknown) (T_id "read_kind") (C_Enum 2) (toInterpValue ()) | Read_acquire -> V_ctor (Id_aux (Id "Read_acquire") Unknown) (T_id "read_kind") (C_Enum 3) (toInterpValue ()) | Read_exclusive -> V_ctor (Id_aux (Id "Read_exclusive") Unknown) (T_id "read_kind") (C_Enum 4) (toInterpValue ()) | Read_exclusive_acquire -> V_ctor (Id_aux (Id "Read_exclusive_acquire") Unknown) (T_id "read_kind") (C_Enum 5) (toInterpValue ()) | Read_stream -> V_ctor (Id_aux (Id "Read_stream") Unknown) (T_id "read_kind") (C_Enum 6) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_acquire") Unknown) (T_id "read_kind") (C_Enum 7) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) end let rec read_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Read_plain") _) _ _ v -> Read_plain - | V_ctor (Id_aux (Id "Read_tag") _) _ _ v -> Read_tag - | V_ctor (Id_aux (Id "Read_tag_reserve") _) _ _ v -> Read_tag_reserve | V_ctor (Id_aux (Id "Read_reserve") _) _ _ v -> Read_reserve | V_ctor (Id_aux (Id "Read_acquire") _) _ _ v -> Read_acquire | V_ctor (Id_aux (Id "Read_exclusive") _) _ _ v -> Read_exclusive | V_ctor (Id_aux (Id "Read_exclusive_acquire") _) _ _ v -> Read_exclusive_acquire | V_ctor (Id_aux (Id "Read_stream") _) _ _ v -> Read_stream + | V_ctor (Id_aux (Id "Read_RISCV_acquire") _) _ _ v -> Read_RISCV_acquire + | V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") _) _ _ v -> Read_RISCV_strong_acquire + | V_ctor (Id_aux (Id "Read_RISCV_reserved") _) _ _ v -> Read_RISCV_reserved + | V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") _) _ _ v -> Read_RISCV_reserved_acquire + | V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") _) _ _ v -> Read_RISCV_reserved_strong_acquire | V_tuple [v] -> read_kindFromInterpValue v | v -> failwith ("fromInterpValue read_kind: unexpected value. " ^ Interp.debug_print_value v) @@ -418,21 +420,27 @@ end let write_kindToInterpValue = function | Write_plain -> V_ctor (Id_aux (Id "Write_plain") Unknown) (T_id "write_kind") (C_Enum 0) (toInterpValue ()) - | Write_tag -> V_ctor (Id_aux (Id "Write_tag") Unknown) (T_id "write_kind") (C_Enum 1) (toInterpValue ()) - | Write_tag_conditional -> V_ctor (Id_aux (Id "Write_tag_conditional") Unknown) (T_id "write_kind") (C_Enum 1) (toInterpValue ()) | Write_conditional -> V_ctor (Id_aux (Id "Write_conditional") Unknown) (T_id "write_kind") (C_Enum 2) (toInterpValue ()) | Write_release -> V_ctor (Id_aux (Id "Write_release") Unknown) (T_id "write_kind") (C_Enum 3) (toInterpValue ()) | Write_exclusive -> V_ctor (Id_aux (Id "Write_exclusive") Unknown) (T_id "write_kind") (C_Enum 4) (toInterpValue ()) | Write_exclusive_release -> V_ctor (Id_aux (Id "Write_exclusive_release") Unknown) (T_id "write_kind") (C_Enum 5) (toInterpValue ()) + | Write_RISCV_release -> V_ctor (Id_aux (Id "Write_RISCV_release") Unknown) (T_id "write_kind") (C_Enum 6) (toInterpValue ()) + | Write_RISCV_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_strong_release") Unknown) (T_id "write_kind") (C_Enum 7) (toInterpValue ()) + | Write_RISCV_conditional -> V_ctor (Id_aux (Id "Write_RISCV_conditional") Unknown) (T_id "write_kind") (C_Enum 8) (toInterpValue ()) + | Write_RISCV_conditional_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_release") Unknown) (T_id "write_kind") (C_Enum 9) (toInterpValue ()) + | Write_RISCV_conditional_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") Unknown) (T_id "write_kind") (C_Enum 10) (toInterpValue ()) end let rec write_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Write_plain") _) _ _ v -> Write_plain - | V_ctor (Id_aux (Id "Write_tag") _) _ _ v -> Write_tag - | V_ctor (Id_aux (Id "Write_tag_conditional") _) _ _ v -> Write_tag_conditional | V_ctor (Id_aux (Id "Write_conditional") _) _ _ v -> Write_conditional | V_ctor (Id_aux (Id "Write_release") _) _ _ v -> Write_release | V_ctor (Id_aux (Id "Write_exclusive") _) _ _ v -> Write_exclusive | V_ctor (Id_aux (Id "Write_exclusive_release") _) _ _ v -> Write_exclusive_release + | V_ctor (Id_aux (Id "Write_RISCV_release") _) _ _ v -> Write_RISCV_release + | V_ctor (Id_aux (Id "Write_RISCV_strong_release") _) _ _ v -> Write_RISCV_strong_release + | V_ctor (Id_aux (Id "Write_RISCV_conditional") _) _ _ v -> Write_RISCV_conditional + | V_ctor (Id_aux (Id "Write_RISCV_conditional_release") _) _ _ v -> Write_RISCV_conditional_release + | V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") _) _ _ v -> Write_RISCV_conditional_strong_release | V_tuple [v] -> write_kindFromInterpValue v | v -> failwith ("fromInterpValue write_kind: unexpected value " ^ Interp.debug_print_value v) @@ -455,7 +463,14 @@ let barrier_kindToInterpValue = function | Barrier_DSB_ST -> V_ctor (Id_aux (Id "Barrier_DSB_ST") Unknown) (T_id "barrier_kind") (C_Enum 8) (toInterpValue ()) | Barrier_DSB_LD -> V_ctor (Id_aux (Id "Barrier_DSB_LD") Unknown) (T_id "barrier_kind") (C_Enum 9) (toInterpValue ()) | Barrier_ISB -> V_ctor (Id_aux (Id "Barrier_ISB") Unknown) (T_id "barrier_kind") (C_Enum 10) (toInterpValue ()) - | Barrier_MIPS_SYNC -> V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") Unknown) (T_id "barrier_kind") (C_Enum 11) (toInterpValue ()) + | Barrier_TM_COMMIT -> V_ctor (Id_aux (Id "Barrier_TM_COMMIT") Unknown) (T_id "barrier_kind") (C_Enum 11) (toInterpValue ()) + | Barrier_MIPS_SYNC -> V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") Unknown) (T_id "barrier_kind") (C_Enum 12) (toInterpValue ()) + | Barrier_RISCV_rw_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") Unknown) (T_id "barrier_kind") (C_Enum 13) (toInterpValue ()) + | Barrier_RISCV_r_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") Unknown) (T_id "barrier_kind") (C_Enum 14) (toInterpValue ()) + | Barrier_RISCV_rw_w -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") Unknown) (T_id "barrier_kind") (C_Enum 15) (toInterpValue ()) + | Barrier_RISCV_w_w -> V_ctor (Id_aux (Id "Barrier_RISCV_w_w") Unknown) (T_id "barrier_kind") (C_Enum 16) (toInterpValue ()) + | Barrier_RISCV_i -> V_ctor (Id_aux (Id "Barrier_RISCV_i") Unknown) (T_id "barrier_kind") (C_Enum 17) (toInterpValue ()) + | Barrier_x86_MFENCE -> V_ctor (Id_aux (Id "Barrier_x86_MFENCE") Unknown) (T_id "barrier_kind") (C_Enum 18) (toInterpValue ()) end let rec barrier_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Barrier_Sync") _) _ _ v -> Barrier_Sync @@ -469,7 +484,14 @@ let rec barrier_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Barrier_DSB_ST") _) _ _ v -> Barrier_DSB_ST | V_ctor (Id_aux (Id "Barrier_DSB_LD") _) _ _ v -> Barrier_DSB_LD | V_ctor (Id_aux (Id "Barrier_ISB") _) _ _ v -> Barrier_ISB + | V_ctor (Id_aux (Id "Barrier_TM_COMMIT") _) _ _ v -> Barrier_TM_COMMIT | V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") _) _ _ v -> Barrier_MIPS_SYNC + | V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") _) _ _ v -> Barrier_RISCV_rw_rw + | V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") _) _ _ v -> Barrier_RISCV_r_rw + | V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") _) _ _ v -> Barrier_RISCV_rw_w + | V_ctor (Id_aux (Id "Barrier_RISCV_w_w") _) _ _ v -> Barrier_RISCV_w_w + | V_ctor (Id_aux (Id "Barrier_RISCV_i") _) _ _ v -> Barrier_RISCV_i + | V_ctor (Id_aux (Id "Barrier_x86_MFENCE") _) _ _ v -> Barrier_x86_MFENCE | V_tuple [v] -> barrier_kindFromInterpValue v | v -> failwith ("fromInterpValue barrier_kind: unexpected value. " ^ Interp.debug_print_value v) @@ -503,18 +525,18 @@ instance (ToFromInterpValue instruction_kind) end let regfpToInterpValue = function - | RFull v -> SI.V_ctor (SIA.Id_aux (SIA.Id "RFull") SIA.Unknown) (SIA.T_id "regfp") SI.C_Union (toInterpValue v) - | RSlice v -> SI.V_ctor (SIA.Id_aux (SIA.Id "RSlice") SIA.Unknown) (SIA.T_id "regfp") SI.C_Union (toInterpValue v) - | RSliceBit v -> SI.V_ctor (SIA.Id_aux (SIA.Id "RSliceBit") SIA.Unknown) (SIA.T_id "regfp") SI.C_Union (toInterpValue v) - | RField v -> SI.V_ctor (SIA.Id_aux (SIA.Id "RField") SIA.Unknown) (SIA.T_id "regfp") SI.C_Union (toInterpValue v) + | RFull v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RFull") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v) + | RSlice v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSlice") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v) + | RSliceBit v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSliceBit") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v) + | RField v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RField") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v) end let rec regfpFromInterpValue v = match v with - | SI.V_ctor (SIA.Id_aux (SIA.Id "RFull") _) _ _ v -> RFull (fromInterpValue v) - | SI.V_ctor (SIA.Id_aux (SIA.Id "RSlice") _) _ _ v -> RSlice (fromInterpValue v) - | SI.V_ctor (SIA.Id_aux (SIA.Id "RSliceBit") _) _ _ v -> RSliceBit (fromInterpValue v) - | SI.V_ctor (SIA.Id_aux (SIA.Id "RField") _) _ _ v -> RField (fromInterpValue v) - | SI.V_tuple [v] -> regfpFromInterpValue v + | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RFull") _) _ _ v -> RFull (fromInterpValue v) + | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSlice") _) _ _ v -> RSlice (fromInterpValue v) + | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSliceBit") _) _ _ v -> RSliceBit (fromInterpValue v) + | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RField") _) _ _ v -> RField (fromInterpValue v) + | Interp_ast.V_tuple [v] -> regfpFromInterpValue v | v -> failwith ("fromInterpValue regfp: unexpected value. " ^ Interp.debug_print_value v) end diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 48ddd10e..e6169762 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -428,6 +428,8 @@ end (* Data structures for building up instructions *) +(* careful: changes in the read/write/barrier kinds have to be + reflected in deep_shallow_convert *) type read_kind = (* common reads *) | Read_plain diff --git a/src/pretty_print.mli b/src/pretty_print.mli index 9a002454..034db664 100644 --- a/src/pretty_print.mli +++ b/src/pretty_print.mli @@ -52,7 +52,7 @@ val pat_to_string : tannot pat -> string val pp_lem_defs : Format.formatter -> tannot defs -> unit val pp_defs_ocaml : out_channel -> tannot defs -> string -> string list -> unit -val pp_defs_lem : (out_channel * string list) -> (out_channel * string list) -> (out_channel * string list) -> tannot defs -> string -> unit +val pp_defs_lem : (out_channel * string list) -> (out_channel * string list) -> (out_channel * string list) -> (out_channel * string list) -> tannot defs -> string -> unit val pp_format_annot_ascii : tannot -> string diff --git a/src/pretty_print_lem.ml b/src/pretty_print_lem.ml index 9758b2de..cf8fda59 100644 --- a/src/pretty_print_lem.ml +++ b/src/pretty_print_lem.ml @@ -50,7 +50,7 @@ open Pretty_print_common * PPrint-based sail-to-lem pprinter ****************************************************************************) -let print_to_from_interp_value = ref false +let print_to_from_interp_value = ref true let langlebar = string "<|" let ranglebar = string "|>" let anglebars = enclose langlebar ranglebar @@ -805,8 +805,8 @@ let rec doc_range_lem (BF_aux(r,_)) = match r with let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with | TD_abbrev(id,nm,typschm) -> - doc_op equals (concat [string "type"; space; doc_id_lem_type id]) - (doc_typschm_lem regtypes typschm) + (doc_op equals (concat [string "type"; space; doc_id_lem_type id]) + (doc_typschm_lem regtypes typschm),empty) | TD_record(id,nm,typq,fs,_) -> let f_pp (typ,fid) = let fname = if prefix_recordtype @@ -814,19 +814,19 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with else doc_id_lem_type fid in concat [fname;space;colon;space;doc_typ_lem regtypes typ; semi] in let fs_doc = group (separate_map (break 1) f_pp fs) in - doc_op equals + (doc_op equals (concat [string "type"; space; doc_id_lem_type id;]) - (doc_typquant_lem typq (anglebars (space ^^ align fs_doc ^^ space))) + (doc_typquant_lem typq (anglebars (space ^^ align fs_doc ^^ space))),empty) | TD_variant(id,nm,typq,ar,_) -> (match id with - | Id_aux ((Id "read_kind"),_) -> empty - | Id_aux ((Id "write_kind"),_) -> empty - | Id_aux ((Id "barrier_kind"),_) -> empty - | Id_aux ((Id "trans_kind"),_) -> empty - | Id_aux ((Id "instruction_kind"),_) -> empty - | Id_aux ((Id "regfp"),_) -> empty - | Id_aux ((Id "niafp"),_) -> empty - | Id_aux ((Id "diafp"),_) -> empty + | Id_aux ((Id "read_kind"),_) -> (empty,empty) + | Id_aux ((Id "write_kind"),_) -> (empty,empty) + | Id_aux ((Id "barrier_kind"),_) -> (empty,empty) + | Id_aux ((Id "trans_kind"),_) -> (empty,empty) + | Id_aux ((Id "instruction_kind"),_) -> (empty,empty) + | Id_aux ((Id "regfp"),_) -> (empty,empty) + | Id_aux ((Id "niafp"),_) -> (empty,empty) + | Id_aux ((Id "diafp"),_) -> (empty,empty) | _ -> let ar_doc = group (separate_map (break 1) (doc_type_union_lem regtypes) ar) in let typ_pp = @@ -835,9 +835,9 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with (concat [string "type"; space; doc_id_lem_type id;]) (doc_typquant_lem typq ar_doc) in let make_id pat id = - separate space [string "SIA.Id_aux"; - parens (string "SIA.Id " ^^ string_lit (doc_id id)); - if pat then underscore else string "SIA.Unknown"] in + separate space [string "Interp_ast.Id_aux"; + parens (string "Interp_ast.Id " ^^ string_lit (doc_id id)); + if pat then underscore else string "Interp_ast.Unknown"] in let fromInterpValueF = concat [doc_id_lem_type id;string "FromInterpValue"] in let toInterpValueF = concat [doc_id_lem_type id;string "ToInterpValue"] in let fromInterpValuePP = @@ -849,18 +849,18 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with match tu with | Tu_ty_id (ty,cid) -> (separate space) - [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; + [pipe;string "Interp_ast.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; arrow; doc_id_lem_ctor cid; parens (string "fromInterpValue v")] | Tu_id cid -> (separate space) - [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; + [pipe;string "Interp_ast.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; arrow; doc_id_lem_ctor cid]) ar) ^/^ - ((separate space) [pipe;string "SI.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^ + ((separate space) [pipe;string "Interp_ast.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^ let failmessage = (string_lit @@ -879,43 +879,40 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with | Tu_ty_id (ty,cid) -> (separate space) [pipe;doc_id_lem_ctor cid;string "v";arrow; - string "SI.V_ctor"; + string "Interp_ast.V_ctor"; parens (make_id false cid); - parens (string "SIA.T_id " ^^ string_lit (doc_id id)); - string "SI.C_Union"; + parens (string "Interp_ast.T_id " ^^ string_lit (doc_id id)); + string "Interp_ast.C_Union"; parens (string "toInterpValue v")] | Tu_id cid -> (separate space) [pipe;doc_id_lem_ctor cid;arrow; - string "SI.V_ctor"; + string "Interp_ast.V_ctor"; parens (make_id false cid); - parens (string "SIA.T_id " ^^ string_lit (doc_id id)); - string "SI.C_Union"; + parens (string "Interp_ast.T_id " ^^ string_lit (doc_id id)); + string "Interp_ast.C_Union"; parens (string "toInterpValue ()")]) ar) ^/^ string "end") in let fromToInterpValuePP = + toInterpValuePP ^^ hardline ^^ hardline ^^ + fromInterpValuePP ^^ hardline ^^ hardline ^^ ((prefix 2 1) (concat [string "instance ";parens (string "ToFromInterpValue " ^^ doc_id_lem_type id)]) (concat [string "let toInterpValue = ";toInterpValueF;hardline; string "let fromInterpValue = ";fromInterpValueF])) ^/^ string "end" in - typ_pp ^^ hardline ^^ hardline ^^ - if !print_to_from_interp_value then - toInterpValuePP ^^ hardline ^^ hardline ^^ - fromInterpValuePP ^^ hardline ^^ hardline ^^ - fromToInterpValuePP ^^ hardline - else empty) + (typ_pp ^^ hardline,fromToInterpValuePP ^^ hardline)) | TD_enum(id,nm,enums,_) -> (match id with - | Id_aux ((Id "read_kind"),_) -> empty - | Id_aux ((Id "write_kind"),_) -> empty - | Id_aux ((Id "barrier_kind"),_) -> empty - | Id_aux ((Id "trans_kind"),_) -> empty - | Id_aux ((Id "instruction_kind"),_) -> empty - | Id_aux ((Id "regfp"),_) -> empty - | Id_aux ((Id "niafp"),_) -> empty - | Id_aux ((Id "diafp"),_) -> empty + | Id_aux ((Id "read_kind"),_) -> (empty,empty) + | Id_aux ((Id "write_kind"),_) -> (empty,empty) + | Id_aux ((Id "barrier_kind"),_) -> (empty,empty) + | Id_aux ((Id "trans_kind"),_) -> (empty,empty) + | Id_aux ((Id "instruction_kind"),_) -> (empty,empty) + | Id_aux ((Id "regfp"),_) -> (empty,empty) + | Id_aux ((Id "niafp"),_) -> (empty,empty) + | Id_aux ((Id "diafp"),_) -> (empty,empty) | _ -> let rec range i j = if i > j then [] else i :: (range (i+1) j) in let nats = range 0 in @@ -926,9 +923,9 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with let fromInterpValueF = concat [doc_id_lem_type id;string "FromInterpValue"] in let toInterpValueF = concat [doc_id_lem_type id;string "ToInterpValue"] in let make_id pat id = - separate space [string "SIA.Id_aux"; - parens (string "SIA.Id " ^^ string_lit (doc_id id)); - if pat then underscore else string "SIA.Unknown"] in + separate space [string "Interp_ast.Id_aux"; + parens (string "Interp_ast.Id " ^^ string_lit (doc_id id)); + if pat then underscore else string "Interp_ast.Unknown"] in let fromInterpValuePP = (prefix 2 1) (separate space [string "let rec";fromInterpValueF;string "v";equals;string "match v with"]) @@ -936,7 +933,7 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with ((separate_map (break 1)) (fun (cid) -> (separate space) - [pipe;string "SI.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; + [pipe;string "Interp_ast.V_ctor";parens (make_id true cid);underscore;underscore;string "v"; arrow;doc_id_lem_ctor cid] ) enums @@ -944,7 +941,7 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with ( (align ((prefix 3 1) - (separate space [pipe;string ("SI.V_lit (SIA.L_aux (SIA.L_num n) _)");arrow]) + (separate space [pipe;string ("Interp_ast.V_lit (Interp_ast.L_aux (Interp_ast.L_num n) _)");arrow]) (separate space [string "match";parens(string "natFromInteger n");string "with"] ^/^ ( ((separate_map (break 1)) @@ -960,7 +957,7 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with ) ) ^/^ - ((separate space) [pipe;string "SI.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^ + ((separate space) [pipe;string "Interp_ast.V_tuple [v]";arrow;fromInterpValueF;string "v"]) ^/^ let failmessage = (string_lit @@ -978,25 +975,23 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with (fun (cid,number) -> (separate space) [pipe;doc_id_lem_ctor cid;arrow; - string "SI.V_ctor"; + string "Interp_ast.V_ctor"; parens (make_id false cid); - parens (string "SIA.T_id " ^^ string_lit (doc_id id)); - parens (string ("SI.C_Enum " ^ string_of_int number)); + parens (string "Interp_ast.T_id " ^^ string_lit (doc_id id)); + parens (string ("Interp_ast.C_Enum " ^ string_of_int number)); parens (string "toInterpValue ()")]) (List.combine enums (nats ((List.length enums) - 1)))) ^/^ string "end") in let fromToInterpValuePP = + toInterpValuePP ^^ hardline ^^ hardline ^^ + fromInterpValuePP ^^ hardline ^^ hardline ^^ ((prefix 2 1) (concat [string "instance ";parens (string "ToFromInterpValue " ^^ doc_id_lem_type id)]) (concat [string "let toInterpValue = ";toInterpValueF;hardline; string "let fromInterpValue = ";fromInterpValueF])) ^/^ string "end" in - typ_pp ^^ hardline ^^ hardline ^^ - if !print_to_from_interp_value - then toInterpValuePP ^^ hardline ^^ hardline ^^ - fromInterpValuePP ^^ hardline ^^ hardline ^^ - fromToInterpValuePP ^^ hardline - else empty) + (typ_pp ^^ hardline, + fromToInterpValuePP ^^ hardline)) | TD_register(id,n1,n2,rs) -> match n1,n2 with | Nexp_aux(Nexp_constant i1,_),Nexp_aux(Nexp_constant i2,_) -> @@ -1010,11 +1005,11 @@ let doc_typdef_lem regtypes (TD_aux(td,_)) = match td with let dir_b = i1 < i2 in let dir = string (if dir_b then "true" else "false") in let size = if dir_b then i2-i1 +1 else i1-i2 + 1 in - (doc_op equals) + ((doc_op equals) (concat [string "let";space;string "build_";doc_id_lem id;space;string "regname"]) (string "Register" ^^ space ^^ align (separate space [string "regname"; doc_int size; doc_int i1; dir; - break 0 ^^ brackets (align doc_rids)])) + break 0 ^^ brackets (align doc_rids)])),empty) (*^^ hardline ^^ separate_map hardline doc_rfield rs *) @@ -1147,26 +1142,29 @@ let doc_spec_lem regtypes (VS_aux (valspec,annot)) = let rec doc_def_lem regtypes def = match def with - | DEF_spec v_spec -> (doc_spec_lem regtypes v_spec,empty) - | DEF_type t_def -> (group (doc_typdef_lem regtypes t_def) ^/^ hardline,empty) - | DEF_reg_dec dec -> (group (doc_dec_lem dec),empty) + | DEF_spec v_spec -> ((doc_spec_lem regtypes v_spec,empty),empty) + | DEF_type t_def -> + let (typdefs,fromtodefs) = doc_typdef_lem regtypes t_def in + ((group typdefs ^/^ hardline,fromtodefs),empty) + | DEF_reg_dec dec -> ((group (doc_dec_lem dec),empty),empty) - | DEF_default df -> (empty,empty) - | DEF_fundef f_def -> (empty,group (doc_fundef_lem regtypes f_def) ^/^ hardline) - | DEF_val lbind -> (empty,group (doc_let_lem regtypes lbind) ^/^ hardline) + | DEF_default df -> ((empty,empty),empty) + | DEF_fundef f_def -> ((empty,empty),group (doc_fundef_lem regtypes f_def) ^/^ hardline) + | DEF_val lbind -> ((empty,empty),group (doc_let_lem regtypes lbind) ^/^ hardline) | DEF_scattered sdef -> failwith "doc_def_lem: shoulnd't have DEF_scattered at this point" - | DEF_kind _ -> (empty,empty) + | DEF_kind _ -> ((empty,empty),empty) - | DEF_comm (DC_comm s) -> (empty,comment (string s)) + | DEF_comm (DC_comm s) -> ((empty,empty),comment (string s)) | DEF_comm (DC_comm_struct d) -> - let (typdefs,vdefs) = doc_def_lem regtypes d in - (empty,comment (typdefs ^^ hardline ^^ vdefs)) + let ((typdefs,tofromdefs),vdefs) = doc_def_lem regtypes d in + ((empty,empty),comment (typdefs ^^ hardline ^^ tofromdefs ^^ hardline ^^ vdefs)) let doc_defs_lem regtypes (Defs defs) = let (typdefs,valdefs) = List.split (List.map (doc_def_lem regtypes) defs) in - (separate empty typdefs,separate empty valdefs) + let (typdefs,tofromdefs) = List.split typdefs in + (separate empty typdefs,separate empty tofromdefs, separate empty valdefs) let find_regtypes (Defs defs) = List.fold_left @@ -1180,38 +1178,33 @@ let find_regtypes (Defs defs) = let typ_to_t env = Type_check.typ_to_t env false false -let pp_defs_lem (types_file,types_modules) (prompt_file,prompt_modules) (state_file,state_modules) d top_line = +let pp_defs_lem + (types_file,types_modules) + (prompt_file,prompt_modules) + (state_file,state_modules) + (tofrom_file,tofrom_modules) + d top_line = + let pp_aux file modules defs = + (print file) + (concat + [string "(*" ^^ (string top_line) ^^ string "*)";hardline; + (separate_map hardline) + (fun lib -> separate space [string "open import";string lib]) modules;hardline; + defs]); + in + + let regtypes = find_regtypes d in - let (typdefs,valdefs) = doc_defs_lem regtypes d in - (print types_file) - (concat - [string "(*" ^^ (string top_line) ^^ string "*)";hardline; - (separate_map hardline) - (fun lib -> separate space [string "open import";string lib]) types_modules;hardline; - if !print_to_from_interp_value - then - concat - [(separate_map hardline) - (fun lib -> separate space [string " import";string lib]) ["Interp";"Interp_ast"]; - string "open import Deep_shallow_convert"; - hardline; - hardline; - string "module SI = Interp"; hardline; - string "module SIA = Interp_ast"; hardline; - hardline] - else empty; - typdefs]); - (print prompt_file) - (concat - [string "(*" ^^ (string top_line) ^^ string "*)";hardline; - (separate_map hardline) - (fun lib -> separate space [string "open import";string lib]) prompt_modules;hardline; - hardline; - valdefs]); - (print state_file) + let (typdefs,tofromdefs,valdefs) = doc_defs_lem regtypes d in + + pp_aux types_file types_modules typdefs; + pp_aux prompt_file prompt_modules valdefs; + pp_aux state_file state_modules valdefs; + + (print tofrom_file) (concat [string "(*" ^^ (string top_line) ^^ string "*)";hardline; - (separate_map hardline) - (fun lib -> separate space [string "open import";string lib]) state_modules;hardline; - hardline; - valdefs]); + (separate_map hardline) (fun lib -> separate space [string "open import";string lib]) tofrom_modules;hardline; + (separate_map hardline) (fun lib -> separate space [string " import";string lib]) ["Interp";"Interp_ast"];hardline; + string "open import Deep_shallow_convert"; + hardline;tofromdefs]) diff --git a/src/process_file.ml b/src/process_file.ml index 273979cf..39a8bf58 100644 --- a/src/process_file.ml +++ b/src/process_file.ml @@ -172,18 +172,23 @@ let output1 libpath out_arg filename defs = | Lem_out None -> let generated_line = generated_line filename in let types_module = (f' ^ "_embed_types") in + let tofrom_module = (f' ^ "_toFromInterp") in let ((o,_, _) as ext_o) = open_output_with_check_unformatted (f' ^ "_embed_types.lem") in let ((o',_, _) as ext_o') = open_output_with_check_unformatted (f' ^ "_embed.lem") in let ((o'',_, _) as ext_o'') = open_output_with_check_unformatted (f' ^ "_embed_sequential.lem") in + let ((o''',_, _) as ext_o''') = + open_output_with_check_unformatted (f' ^ "_toFromInterp.lem") in (Pretty_print.pp_defs_lem (o,["Pervasives_extra";"Sail_impl_base";"Sail_values"]) (o',["Pervasives_extra";"Sail_impl_base";"Prompt";"Sail_values"; String.capitalize types_module]) (o'',["Pervasives_extra";"Sail_impl_base";"State";"Sail_values"; String.capitalize types_module]) + (o''',["Pervasives_extra";"Sail_impl_base";"Sail_values"; + String.capitalize types_module]) defs generated_line); close_output_with_check ext_o; close_output_with_check ext_o'; @@ -191,22 +196,28 @@ let output1 libpath out_arg filename defs = | Lem_out (Some lib) -> let generated_line = generated_line filename in let types_module = (f' ^ "_embed_types") in + let tofrom_module = (f' ^ "_toFromInterp") in let ((o,_, _) as ext_o) = open_output_with_check_unformatted (f' ^ "_embed_types.lem") in let ((o',_, _) as ext_o') = open_output_with_check_unformatted (f' ^ "_embed.lem") in let ((o'',_, _) as ext_o'') = open_output_with_check_unformatted (f' ^ "_embed_sequential.lem") in + let ((o''',_, _) as ext_o''') = + open_output_with_check_unformatted (f' ^ "_toFromInterp.lem") in (Pretty_print.pp_defs_lem (o,["Pervasives_extra";"Sail_impl_base";"Sail_values"]) (o',["Pervasives_extra";"Sail_impl_base";"Prompt"; "Sail_values";String.capitalize types_module;lib]) (o'',["Pervasives_extra";"Sail_impl_base";"State"; "Sail_values";String.capitalize types_module;lib ^ "_sequential"]) + (o''',["Pervasives_extra";"Sail_impl_base"; + "Sail_values";String.capitalize types_module;lib]) defs generated_line); close_output_with_check ext_o; close_output_with_check ext_o'; - close_output_with_check ext_o'' + close_output_with_check ext_o''; + close_output_with_check ext_o''' | Ocaml_out None -> let ((o,temp_file_name, _) as ext_o) = open_output_with_check_unformatted (f' ^ ".ml") in begin Pretty_print.pp_defs_ocaml o defs (generated_line filename) ["Big_int_Z";"Sail_values"]; -- cgit v1.2.3 From 3a4358d34cca39d61da4a21953be2a55f0a0a89e Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 15 Sep 2017 18:26:16 +0100 Subject: x86: implement regfp analysis function (no control flow yet) --- etc/regfp.sail | 1 + src/lem_interp/interp_inter_imp.lem | 3 +- x86/x64.sail | 301 +++++++++++++++++++++++++++--------- 3 files changed, 227 insertions(+), 78 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index f7744e8c..c0792df0 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -77,6 +77,7 @@ typedef barrier_kind = enumerate { Barrier_RISCV_rw_w; Barrier_RISCV_w_w; Barrier_RISCV_i; + Barrier_x86_MFENCE; } typedef trans_kind = enumerate { diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index 411ad3fc..6ee13d60 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -587,7 +587,8 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis | "Barrier_DSB_ST" -> Barrier_DSB_ST | "Barrier_DSB_LD" -> Barrier_DSB_LD | "Barrier_ISB" -> Barrier_ISB - | "Barrier_MIPS_SYNC" -> Barrier_MIPS_SYNC + | "Barrier_MIPS_SYNC" -> Barrier_MIPS_SYNC + | "Barrier_x86_MFENCE" -> Barrier_x86_MFENCE end) | Interp_ast.V_ctor (Id_aux (Id "IK_mem_read") _) _ _ (Interp_ast.V_ctor (Id_aux (Id r) _) _ _ _) -> diff --git a/x86/x64.sail b/x86/x64.sail index 9630a873..deee01ad 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -321,7 +321,7 @@ function qword call_dest_from_ea ((ea) e) = case (Ea_m(_, a)) -> rMEM(a, 8) } -function qword get_ea_address ((ea) e) = +function qword get_ea_address ((ea) e) = (* XXX rmn30 looks broken *) switch e { case (Ea_i(_, i)) -> 0x0000000000000000 case (Ea_r(_, r)) -> 0x0000000000000000 @@ -494,9 +494,9 @@ function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, ( case Cmp -> let (w,c,x) = sub_with_borrow (sz, a, b) in write_arith_eflags (sz, w, c, x) case Test -> write_logical_eflags (sz, a & b) - case And -> write_logical_result (sz, a & b, e) + case And -> write_logical_result (sz, a & b, e) (* XXX rmn30 wrong flags? *) case Xor -> write_logical_result (sz, a ^ b, e) - case Or -> write_logical_result (sz, a | b, e) + case Or -> write_logical_result (sz, a | b, e) case Rol -> write_result_erase_eflags (rol (sz, a, b), e) case Ror -> write_result_erase_eflags (ror (sz, a, b), e) case Sar -> write_result_erase_eflags (sar (sz, a, b), e) @@ -528,8 +528,8 @@ function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, ( function unit write_monop ((wsize) sz, (monop_name) mop, (qword) a, (ea) e) = switch mop { case Not -> wEA(e) := ~(a) - case Dec -> write_arith_result_no_CF_OF (sz, a - 1, e) - case Inc -> write_arith_result_no_CF_OF (sz, a + 1, e) + case Dec -> write_arith_result_no_CF_OF (sz, a - 1, e) + case Inc -> write_arith_result_no_CF_OF (sz, a + 1, e)(* XXX rmn30 should set OF *) case Neg -> { write_arith_result_no_CF_OF (sz, 0 - a, e); CF := undefined; } @@ -636,7 +636,7 @@ function clause execute (CMPXCHG (sz,r,n)) = let val_dst = EA(dst) in let val_acc = EA(src) in { - write_binop (sz, Cmp, val_acc, val_dst, src); + write_binop (sz, Cmp, val_acc, val_dst, src); if val_acc == val_dst then wEA(dst) := EA (src) else @@ -1266,6 +1266,103 @@ function (byte_stream, ast, nat) decode ((byte_stream) strm) = let (vector <0, 16, inc, string >) GPRstr = ["RAX","RCX","RDX","RBX","RSP","RBP","RSI","RDI","R8","R9","R10","R11","R12","R13","R14","R15"] +function (regfps) regfp_base ((base) b) = + switch b { + case NoBase -> [|| ||] + case RipBase -> [|| RFull("RIP") ||] + case (RegBase(b)) -> [|| RFull(GPRstr[b]) ||] + } + +function (regfps) regfp_idx ((option) idx) = + switch idx { + case (None) -> [|| ||] + case (Some(scale, idx)) -> [|| RFull(GPRstr[idx]) ||] + } + +function (bool, regfps, regfps) regfp_rm ((rm) r) = + switch r { + case (Reg(n)) -> + (false, [|| RFull(GPRstr[n]) ||], [|| ||]) + case (Mem(idx, b, d)) -> { + (true, [|| ||], append(regfp_idx(idx), regfp_base(b))) + } + } + +function (instruction_kind, regfps, regfps, regfps) regfp_dest_src ((dest_src) ds) = + switch ds { + case (Rm_i (r_m, i)) -> + let (m,rd,ars) = regfp_rm(r_m) in + (if m then IK_mem_write(Write_plain) else IK_simple, ars, rd, ars) + case (Rm_r (r_m, r)) -> + let (m,rd,ars) = regfp_rm(r_m) in + (if m then IK_mem_write(Write_plain) else IK_simple, RFull(GPRstr[r]) :: ars, rd, ars) + case (R_rm (r, r_m)) -> + let (m,rs,ars) = regfp_rm(r_m) in + (if m then IK_mem_read(Read_plain) else IK_simple, append(rs, ars), [|| RFull(GPRstr[r]) ||], ars) + } + +(* as above but where destination is also a source operand *) +function (instruction_kind, regfps, regfps, regfps) regfp_dest_src_rmw ((dest_src) ds) = + switch ds { + case (Rm_i (r_m, i)) -> + let (m,rds, ars) = regfp_rm(r_m) in + (if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple, append(rds, ars), rds, ars) + case (Rm_r (r_m, r)) -> + let (m,rds, ars) = regfp_rm(r_m) in + (if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple, RFull(GPRstr[r]) :: append(rds, ars), rds, ars) + case (R_rm (r, r_m)) -> + let rds = [|| RFull(GPRstr[r]) ||] in + let (m,rs,ars) = regfp_rm(r_m) in + (if m then IK_mem_read(Read_plain) else IK_simple, append(rds, ars), rds, ars) + } + +function (bool, regfps, regfps) regfp_imm_rm ((imm_rm) i_rm) = + switch i_rm { + case (Rm (v)) -> regfp_rm (v) + case (Imm (v)) -> (false, [|| ||], [|| ||]) + } + +let all_flags_but_cf_of = [|| RFull("AF"), RFull("PF"), RFull("SF"), RFull("ZF") ||] +let all_flags = append([|| RFull("CF"), RFull("OF") ||], all_flags_but_cf_of) + +function (regfps) regfp_binop_flags ((binop_name) op) = + switch (op) { + case Add -> all_flags + case Sub -> all_flags + case Cmp -> all_flags + case Test -> all_flags_but_cf_of + case And -> all_flags_but_cf_of + case Xor -> all_flags_but_cf_of + case Or -> all_flags_but_cf_of + case Rol -> all_flags + case Ror -> all_flags + case Sar -> all_flags + case Shl -> all_flags + case Shr -> all_flags + case Adc -> all_flags + case Sbb -> all_flags + } +function (regfps) regfp_cond ((cond) c) = + switch c { + case A -> [|| RFull("CF"), RFull("ZF") ||] + case NB -> [|| RFull("CF") ||] + case B -> [|| RFull("CF") ||] + case NA -> [|| RFull("CF"), RFull("ZF") ||] + case E -> [|| RFull("ZF") ||] + case G -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] + case NL -> [|| RFull("SF"), RFull("OF") ||] + case L -> [|| RFull("SF"), RFull("OF") ||] + case NG -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] + case NE -> [|| RFull("ZF") ||] + case NO -> [|| RFull("OF") ||] + case NP -> [|| RFull("PF") ||] + case NS -> [|| RFull("SF") ||] + case O -> [|| RFull("OF") ||] + case P -> [|| RFull("PF") ||] + case S -> [|| RFull("SF") ||] + case ALWAYS -> [|| ||] + } + function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis (instr) = { iR := [|| ||]; oR := [|| ||]; @@ -1274,76 +1371,126 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( Nias := [|| NIAFP_successor ||]; Dia := DIAFP_none; x := (qword) RIP; - (*switch instr { - case (EBREAK) -> () - case (UTYPE ( imm, rd, op)) -> { - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (JAL ( imm, rd)) -> { - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - let (bit[64]) offset = EXTS(imm) in - Nias := [|| NIAFP_concrete_address (PC + offset) ||] - } - case (JALR ( imm, rs, rd)) -> { - if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - let (bit[64]) offset = EXTS(imm) in - Nias := [|| NIAFP_register (RFull(GPRstr[rs])) ||]; (* XXX this should br rs + offset... *) - } - case (BTYPE ( imm, rs2, rs1, op)) -> { - if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; - if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; - ik := IK_cond_branch; - let (bit[64]) offset = EXTS(imm) in - Nias := NIAFP_concrete_address(PC + offset) :: Nias; - } - case (ITYPE ( imm, rs, rd, op)) -> { - if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (SHIFTIOP ( imm, rs, rd, op)) -> { - if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (RTYPE ( rs2, rs1, rd, op)) -> { - if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; - if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (LOAD ( imm, rs, rd, unsign, width, aq)) -> { (* 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 := if aq then IK_mem_read (Read_RISCV_acquire) else IK_mem_read (Read_plain); - } - case (STORE( imm, rs2, rs1, width)) -> { - if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; - if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; - if (rs1 == 0) then () else aR := RFull(GPRstr[rs1]) :: aR; - ik := IK_mem_write (Write_plain); - } - case (ADDIW ( imm, rs, rd)) -> { - if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (SHIFTW ( imm, rs, rd, op)) -> { - if (rs == 0) then () else iR := RFull(GPRstr[rs]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (RTYPEW ( rs2, rs1, rd, op))-> { - if (rs2 == 0) then () else iR := RFull(GPRstr[rs2]) :: iR; - if (rs1 == 0) then () else iR := RFull(GPRstr[rs1]) :: iR; - if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; - } - case (FENCE(pred, succ)) -> { - ik := - switch(pred, succ) { - case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) - case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) - case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) - case _ -> exit "unsupported fence" - }; - } - };*) + switch instr { + case(Binop (binop, sz, ds)) -> { + let flags = regfp_binop_flags (binop) in + let (ik', iRs, oRs, aRs) = regfp_dest_src_rmw(ds) in { + ik := ik'; + iR := append(iRs, iR); + oR := append(flags, append(oRs, oR)); + aR := append(aRs, aR); + } + } + (*case(CALL (imm_rm) ) -> { + + }*) + case(CLC ) -> oR := RFull("CF") :: oR + case(CMC ) -> { + iR := RFull("CF") :: iR; + oR := RFull("CF") :: oR; + } + case(CMPXCHG (sz, r_m, reg) ) -> + let (m, rs, aRs) = regfp_rm (r_m) in { + iK := if m then IK_mem_rmw (Read_plain, Write_plain) else IK_simple; + iR := RFull("RAX") :: RFull(GPRstr[reg]) :: append(rs, aRs); + oR := RFull("RAX") :: append(regfp_binop_flags(Cmp), rs); + aR := aRs; + } + case(DIV (sz, r_m) ) -> + let (m, rs, ars) = regfp_rm (r_m) in { + iK := if m then IK_mem_read (Read_plain) else IK_simple; + iR := RFull("RAX") :: RFull("RDX") :: append(rs, ars); + oR := RFull("RAX") :: RFull("RDX") :: append(oR, all_flags); + aR := ars; + } + case(HLT ) -> () + (*case(Jcc (cond, imm64) ) -> `X86JCC (translate_out_cond cond, translate_out_imm64 imm64) + case(JMP (rm) ) -> `X86JMP (translate_out_rm rm)*) + case(LEA (sz, ds) ) -> + let (_, irs, ors, ars) = regfp_dest_src (ds) in { + iR := irs; + oR := ors; + aR := ars; + } + (*case(LEAVE ) -> `X86LEAVE*) + (*case(LOOP (cond, imm64) ) -> `X86LOOP (translate_out_cond cond, translate_out_imm64 imm64)*) + case(MFENCE ) -> iK := IK_barrier (Barrier_x86_MFENCE) + case(Monop (monop, sz, r_m) ) -> + let (m, rds, ars) = regfp_rm(r_m) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iR := append(rds, ars); + oR := append(all_flags_but_cf_of, rds); (* XXX fix flags *) + aR := ars; + } + case(MOV (c, sz, ds) ) -> + let (ik, irs, ors, ars) = regfp_dest_src (ds) in + let flags = regfp_cond(c) in + { + iK := ik; + iR := append(irs, flags); + oR := ors; + aR := ars; + } + case(MOVSX (sz1, ds, sz2) ) -> + let (ik, irs, ors, ars) = regfp_dest_src (ds) in { + iK := ik; + iR := irs; + oR := ors; + aR := ars; + } + case(MOVZX (sz1, ds, sz2) ) -> + let (ik, irs, ors, ars) = regfp_dest_src (ds) in { + iK := ik; + iR := irs; + oR := ors; + aR := ars; + } + case(MUL (sz, r_m) ) -> + let (m, rs, ars) = regfp_rm (r_m) in { + iK := if m then IK_mem_read (Read_plain) else IK_simple; + iR := RFull("RAX") :: append(rs, ars); + oR := RFull("RAX") :: RFull("RDX") :: append(oR, all_flags); + aR := ars; + } + case(NOP (_) ) -> () + case(POP (r_m) ) -> + let (m, rd, ars) = regfp_rm (r_m) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + iR := RFull("RSP") :: ars; + oR := RFull("RSP") :: rd; + aR := RFull("RSP") :: ars; + } + case(PUSH (irm) ) -> + let (m, rs, ars) = regfp_imm_rm (irm) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + iR := RFull("RSP") :: append(rs, ars); + oR := RFull("RSP") :: oR; + aR := RFull("RSP") :: ars; + } + (*case(RET (imm64) ) -> `X86RET (translate_out_imm64 imm64)*) + case(SET (c, b, r_m) ) -> + let flags = regfp_cond(c) in + let (m, rs, ars) = regfp_rm(r_m) in { + iK := if m then IK_mem_write(Write_plain) else IK_simple; + iR := append(flags, ars); + oR := rs; + aR := ars; + } + case(STC ) -> oR := [|| RFull("CF") ||] + case(XADD (sz, r_m, reg) ) -> + let (m, rs, ars) = regfp_rm(r_m) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iR := RFull(GPRstr[reg]) :: append(rs, ars); + oR := RFull(GPRstr[reg]) :: append(rs, all_flags); + aR := ars; + } + case(XCHG (sz, r_m, reg) ) -> + let (m, rs, ars) = regfp_rm(r_m) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iR := RFull(GPRstr[reg]) :: append(rs, ars); + oR := RFull(GPRstr[reg]) :: rs; + aR := ars; + } + }; (iR,oR,aR,Nias,Dia,ik) } -- cgit v1.2.3 From 1722a7eeedb68d65c732cc1e5808d9434340fd11 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 18 Sep 2017 15:35:04 +0100 Subject: add regfp for x86 control flow instrucitons. Need more support for memory indirect jumps. --- x86/x64.sail | 48 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 40 insertions(+), 8 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index deee01ad..ba9f26a7 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -1381,9 +1381,13 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := append(aRs, aR); } } - (*case(CALL (imm_rm) ) -> { - - }*) + case(CALL (irm) ) -> + let (m, rs, ars) = regfp_imm_rm (irm) in { + iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + iR := RFull("RIP") :: RFull("RSP") :: rs; + oR := RFull("RSP") :: oR; + (* nias := XXX rmn30 help *) + } case(CLC ) -> oR := RFull("CF") :: oR case(CMC ) -> { iR := RFull("CF") :: iR; @@ -1404,16 +1408,38 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := ars; } case(HLT ) -> () - (*case(Jcc (cond, imm64) ) -> `X86JCC (translate_out_cond cond, translate_out_imm64 imm64) - case(JMP (rm) ) -> `X86JMP (translate_out_rm rm)*) + case(Jcc (c, imm64) ) -> + let flags = regfp_cond(c) in { + iK := IK_cond_branch; + iR := RFull("RIP") :: flags; + Nias := NIAFP_concrete_address(RIP + imm64) :: Nias; + } + case(JMP (r_m) ) -> + let (m, rs, ars) = regfp_rm (r_m) in { + iK := if m then IK_mem_read(Read_plain) else IK_simple; + iR := RFull("RIP")::append(rs, ars); + aR := ars; + (* XXX rmn30 help Nias := *) + } case(LEA (sz, ds) ) -> let (_, irs, ors, ars) = regfp_dest_src (ds) in { iR := irs; oR := ors; aR := ars; } - (*case(LEAVE ) -> `X86LEAVE*) - (*case(LOOP (cond, imm64) ) -> `X86LOOP (translate_out_cond cond, translate_out_imm64 imm64)*) + case(LEAVE ) -> { + iK := IK_mem_read(Read_plain); + iR := RFull("RBP") :: iR; + oR := RFull("RBP") :: RFull("RSP") :: oR; + aR := RFull("RBP") :: aR; + } + case(LOOP (c, imm64) ) -> + let flags = regfp_cond(c) in { + iK := IK_cond_branch; + iR := RFull("RCX") :: flags; + oR := RFull("RCX") :: oR; + Nias := NIAFP_concrete_address(RIP + imm64) :: Nias; + } case(MFENCE ) -> iK := IK_barrier (Barrier_x86_MFENCE) case(Monop (monop, sz, r_m) ) -> let (m, rds, ars) = regfp_rm(r_m) in { @@ -1467,7 +1493,13 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( oR := RFull("RSP") :: oR; aR := RFull("RSP") :: ars; } - (*case(RET (imm64) ) -> `X86RET (translate_out_imm64 imm64)*) + case(RET (imm64) ) -> { + iK := IK_mem_read(Read_plain); + iR := RFull("RSP") :: iR; + oR := RFull("RSP") :: oR; + aR := RFull("RSP") :: aR; + (* Nias := XXX rmn30 help *) + } case(SET (c, b, r_m) ) -> let flags = regfp_cond(c) in let (m, rs, ars) = regfp_rm(r_m) in { -- cgit v1.2.3 From 0ad438b129de243fd573bbf2472858bf853d44c2 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 19 Sep 2017 15:15:48 +0100 Subject: According to Shaked NIAFP_register can be used to indicate that we don't know the possible destination of an instruction for memory indirect jumps (the register name is not used). --- x86/x64.sail | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index ba9f26a7..7cce4262 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -1386,7 +1386,12 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); iR := RFull("RIP") :: RFull("RSP") :: rs; oR := RFull("RSP") :: oR; - (* nias := XXX rmn30 help *) + aR := ars; + Nias := switch irm { + (* XXX register name is not important here -- just indicates we don't know the destination yet. *) + case (Rm (v)) -> NIAFP_register(RFull("RAX")) + case (Imm (v)) -> NIAFP_concrete_address(RIP + v) + } :: Nias; } case(CLC ) -> oR := RFull("CF") :: oR case(CMC ) -> { @@ -1419,7 +1424,8 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( iK := if m then IK_mem_read(Read_plain) else IK_simple; iR := RFull("RIP")::append(rs, ars); aR := ars; - (* XXX rmn30 help Nias := *) + (* XXX register name is not important here -- just indicates we don't know the destination yet. *) + Nias := NIAFP_register(RFull("RAX")) :: Nias; } case(LEA (sz, ds) ) -> let (_, irs, ors, ars) = regfp_dest_src (ds) in { @@ -1498,7 +1504,8 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( iR := RFull("RSP") :: iR; oR := RFull("RSP") :: oR; aR := RFull("RSP") :: aR; - (* Nias := XXX rmn30 help *) + (* XXX register name is not important here -- just indicates we don't know the destination yet. *) + Nias := NIAFP_register(RFull("RAX")) :: Nias; } case(SET (c, b, r_m) ) -> let flags = regfp_cond(c) in -- cgit v1.2.3 From c3b5af179dde8d0b2c272eb851ebdb59764468d0 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Tue, 19 Sep 2017 19:45:36 +0300 Subject: fix --- src/gen_lib/deep_shallow_convert.lem | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/gen_lib/deep_shallow_convert.lem b/src/gen_lib/deep_shallow_convert.lem index 4af6eb2f..42a65c49 100644 --- a/src/gen_lib/deep_shallow_convert.lem +++ b/src/gen_lib/deep_shallow_convert.lem @@ -69,9 +69,9 @@ end let toInterpValueBitU = function - | I -> Interp_ast.V_lit (L_aux (L_one) Unknown) - | O -> Interp_ast.V_lit (L_aux (L_zero) Unknown) - | Undef -> Interp_ast.V_lit (L_aux (L_undef) Unknown) + | B1 -> Interp_ast.V_lit (L_aux (L_one) Unknown) + | B0 -> Interp_ast.V_lit (L_aux (L_zero) Unknown) + | BU -> Interp_ast.V_lit (L_aux (L_undef) Unknown) end let rec fromInterpValueBitU v = match v with | Interp_ast.V_lit (L_aux (L_one) _) -> B1 @@ -391,10 +391,10 @@ let read_kindToInterpValue = function | Read_exclusive_acquire -> V_ctor (Id_aux (Id "Read_exclusive_acquire") Unknown) (T_id "read_kind") (C_Enum 5) (toInterpValue ()) | Read_stream -> V_ctor (Id_aux (Id "Read_stream") Unknown) (T_id "read_kind") (C_Enum 6) (toInterpValue ()) | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_acquire") Unknown) (T_id "read_kind") (C_Enum 7) (toInterpValue ()) - | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ()) - | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ()) - | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) - | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) + | Read_RISCV_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ()) + | Read_RISCV_reserved -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ()) + | Read_RISCV_reserved_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) + | Read_RISCV_reserved_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) end let rec read_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Read_plain") _) _ _ v -> Read_plain -- cgit v1.2.3 From a02e52919de565fc3fba82723b48200fbf034ff9 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Wed, 20 Sep 2017 15:38:14 +0100 Subject: add support for x86 lock prefix (also remove unused Read/Write_tag kind in etc/regfp.sail. --- etc/regfp.sail | 4 +- src/lem_interp/sail_impl_base.lem | 6 ++ x86/x64.sail | 210 ++++++++++++++++++++------------------ 3 files changed, 119 insertions(+), 101 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index c0792df0..15d1a489 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -32,7 +32,6 @@ typedef diafp = const union { typedef read_kind = enumerate { Read_plain; - Read_tag; Read_reserve; Read_acquire; Read_exclusive; @@ -43,11 +42,11 @@ typedef read_kind = enumerate { Read_RISCV_reserved; Read_RISCV_reserved_acquire; Read_RISCV_reserved_strong_acquire; + Read_X86_locked; } typedef write_kind = enumerate { Write_plain; - Write_tag; Write_conditional; Write_release; Write_exclusive; @@ -57,6 +56,7 @@ typedef write_kind = enumerate { Write_RISCV_conditional; Write_RISCV_conditional_release; Write_RISCV_conditional_strong_release; + Write_X86_locked; } typedef barrier_kind = enumerate { diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index e6169762..e39c4421 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -441,6 +441,7 @@ type read_kind = | Read_RISCV_acquire | Read_RISCV_strong_acquire | Read_RISCV_reserved | Read_RISCV_reserved_acquire | Read_RISCV_reserved_strong_acquire + | Read_X86_locked instance (Show read_kind) let show = function @@ -455,6 +456,7 @@ instance (Show read_kind) | Read_RISCV_reserved -> "Read_RISCV_reserved" | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire" | Read_RISCV_reserved_strong_acquire -> "Read_RISCV_reserved_strong_acquire" + | Read_X86_locked -> "Read_X86_locked" end end @@ -469,6 +471,7 @@ type write_kind = | Write_RISCV_release | Write_RISCV_strong_release | Write_RISCV_conditional | Write_RISCV_conditional_release | Write_RISCV_conditional_strong_release + | Write_X86_locked instance (Show write_kind) let show = function @@ -482,6 +485,7 @@ instance (Show write_kind) | Write_RISCV_conditional -> "Write_RISCV_conditional" | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release" | Write_RISCV_conditional_strong_release -> "Write_RISCV_conditional_strong_release" + | Write_X86_locked -> "Write_X86_locked" end end @@ -580,6 +584,7 @@ instance (EnumerationType read_kind) | Read_RISCV_reserved -> 8 | Read_RISCV_reserved_acquire -> 9 | Read_RISCV_reserved_strong_acquire -> 10 + | Read_X86_locked -> 11 end end @@ -595,6 +600,7 @@ instance (EnumerationType write_kind) | Write_RISCV_conditional -> 7 | Write_RISCV_conditional_release -> 8 | Write_RISCV_conditional_strong_release -> 9 + | Write_X86_locked -> 10 end end diff --git a/x86/x64.sail b/x86/x64.sail index 7cce4262..0b0d2230 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -103,15 +103,17 @@ register bit[1] OF -------------------------------------------------------------------------- *) val extern forall Nat 'n. (qword, [|'n|]) -> (bit[8 * 'n]) effect { rmem } rMEM - - +val extern forall Nat 'n. (qword, [|'n|]) -> (bit[8 * 'n]) effect { rmem } rMEM_locked +function forall Nat 'n. (bit[8 * 'n]) effect { rmem } rMEMl ((bool) locked, (qword) addr, ([|'n|]) size) = + if locked then rMEM_locked(addr, size) else rMEM(addr, size) val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_locked val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval val extern unit -> unit effect { barr } X86_MFENCE -function forall Nat 'n. unit effect {eamem, wmv} wMEM ((qword) addr, ([|'n|]) len, (bit[8 * 'n]) data) = { - MEMea(addr, len); +function forall Nat 'n. unit effect {eamem, wmv} wMEM ((bool) locked, (qword) addr, ([|'n|]) len, (bit[8 * 'n]) data) = { + if locked then MEMea_locked(addr, len) else MEMea(addr, len); MEMval(addr, len, data); } @@ -265,7 +267,7 @@ function qword restrict_size ((wsize) sz, (qword) imm) = function regn sub4 ((regn) r) = negative_to_zero (r - 4) -function qword effect { rreg, rmem } EA ((ea) e) = +function qword effect { rreg, rmem } EA ((bool) locked, (ea) e) = switch e { case (Ea_i(sz,i)) -> restrict_size(sz,i) case (Ea_r((Sz8(have_rex)),r)) -> @@ -274,13 +276,13 @@ function qword effect { rreg, rmem } EA ((ea) e) = else (REG[sub4 (r)] >> 8) & 0x00000000000000FF case (Ea_r(sz,r)) -> restrict_size(sz, REG[r]) - case (Ea_m((Sz8(_)),a)) -> EXTZ (rMEM(a, 1)) - case (Ea_m(Sz16,a)) -> EXTZ (rMEM(a, 2)) - case (Ea_m(Sz32,a)) -> EXTZ (rMEM(a, 4)) - case (Ea_m(Sz64,a)) -> rMEM(a, 8) + case (Ea_m((Sz8(_)),a)) -> EXTZ (rMEMl(locked, a, 1)) + case (Ea_m(Sz16,a)) -> EXTZ (rMEMl(locked, a, 2)) + case (Ea_m(Sz32,a)) -> EXTZ (rMEMl(locked, a, 4)) + case (Ea_m(Sz64,a)) -> rMEMl(locked, a, 8) } -function unit effect { wmem, wreg, escape } wEA ((ea) e, (qword) w) = +function unit effect { wmem, wreg, escape } wEA ((bool) locked, (ea) e, (qword) w) = switch e { case (Ea_i(_,_)) -> exit () case (Ea_r((Sz8(have_rex)),r)) -> @@ -304,15 +306,15 @@ function unit effect { wmem, wreg, escape } wEA ((ea) e, (qword) w) = } case (Ea_r(Sz32,r)) -> REG[r] := (qword) (EXTZ (w[31 .. 0])) case (Ea_r(Sz64,r)) -> REG[r] := w - case (Ea_m((Sz8(_)),a)) -> wMEM(a, 1, w[7 .. 0]) - case (Ea_m(Sz16,a)) -> wMEM(a, 2, w[15 .. 0]) - case (Ea_m(Sz32,a)) -> wMEM(a, 4, w[31 .. 0]) - case (Ea_m(Sz64,a)) -> wMEM(a, 8, w) + case (Ea_m((Sz8(_)),a)) -> wMEM(locked, a, 1, w[7 .. 0]) + case (Ea_m(Sz16,a)) -> wMEM(locked, a, 2, w[15 .. 0]) + case (Ea_m(Sz32,a)) -> wMEM(locked, a, 4, w[31 .. 0]) + case (Ea_m(Sz64,a)) -> wMEM(locked, a, 8, w) } -function (ea, qword, qword) read_dest_src_ea ((wsize) sz, (dest_src) ds) = +function (ea, qword, qword) read_dest_src_ea ((bool) locked, (wsize) sz, (dest_src) ds) = let e = ea_dest (sz, ds) in - (e, EA(e), EA(ea_src(sz, ds))) + (e, EA(locked, e), EA(locked, ea_src(sz, ds))) function qword call_dest_from_ea ((ea) e) = switch e { @@ -419,28 +421,28 @@ function (qword, bit, bit) add_with_carry_out ((wsize) sz, (qword) a, (qword) b) function (qword, bit, bit) sub_with_borrow ((wsize) sz, (qword) a, (qword) b) = (a - b, (bit) (a < b), word_signed_overflow_sub (sz, a, b)) -function unit write_arith_result ((wsize) sz, (qword) w, (bit) c, (bit) x, (ea) e) = +function unit write_arith_result ((bool) locked, (wsize) sz, (qword) w, (bit) c, (bit) x, (ea) e) = { write_arith_eflags (sz, w, c, x); - wEA (e) := w; + wEA (locked, e) := w; } -function unit write_arith_result_no_CF_OF ((wsize) sz, (qword) w, (ea) e) = +function unit write_arith_result_no_CF_OF ((bool) locked, (wsize) sz, (qword) w, (ea) e) = { write_arith_eflags_except_CF_OF (sz, w); - wEA (e) := w; + wEA (locked, e) := w; } -function unit write_logical_result ((wsize) sz, (qword) w, (ea) e) = +function unit write_logical_result ((bool) locked, (wsize) sz, (qword) w, (ea) e) = { write_arith_eflags_except_CF_OF (sz, w); - wEA (e) := w; + wEA (locked, e) := w; } -function unit write_result_erase_eflags ((qword) w, (ea) e) = +function unit write_result_erase_eflags ((bool) locked, (qword) w, (ea) e) = { erase_eflags (); - wEA (e) := w; + wEA (locked, e) := w; } function qword effect { escape } sign_extension ((qword) w, (wsize) size1, (wsize) size2) = @@ -485,23 +487,23 @@ function qword sar ((wsize) sz, (qword) a, (qword) b) = case Sz64 -> ASR64 (a, b[5 .. 0]) } -function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = +function unit write_binop ((bool) locked, (wsize) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = switch bop { case Add -> let (w,c,x) = add_with_carry_out (sz, a, b) in - write_arith_result (sz, w, c, x, e) + write_arith_result (locked, sz, w, c, x, e) case Sub -> let (w,c,x) = sub_with_borrow (sz, a, b) in - write_arith_result (sz, w, c, x, e) + write_arith_result (locked, sz, w, c, x, e) case Cmp -> let (w,c,x) = sub_with_borrow (sz, a, b) in write_arith_eflags (sz, w, c, x) case Test -> write_logical_eflags (sz, a & b) - case And -> write_logical_result (sz, a & b, e) (* XXX rmn30 wrong flags? *) - case Xor -> write_logical_result (sz, a ^ b, e) - case Or -> write_logical_result (sz, a | b, e) - case Rol -> write_result_erase_eflags (rol (sz, a, b), e) - case Ror -> write_result_erase_eflags (ror (sz, a, b), e) - case Sar -> write_result_erase_eflags (sar (sz, a, b), e) - case Shl -> write_result_erase_eflags (a << mask_shift (sz, b), e) - case Shr -> write_result_erase_eflags (a >> mask_shift (sz, b), e) + case And -> write_logical_result (locked, sz, a & b, e) (* XXX rmn30 wrong flags? *) + case Xor -> write_logical_result (locked, sz, a ^ b, e) + case Or -> write_logical_result (locked, sz, a | b, e) + case Rol -> write_result_erase_eflags (locked, rol (sz, a, b), e) + case Ror -> write_result_erase_eflags (locked, ror (sz, a, b), e) + case Sar -> write_result_erase_eflags (locked, sar (sz, a, b), e) + case Shl -> write_result_erase_eflags (locked, a << mask_shift (sz, b), e) + case Shr -> write_result_erase_eflags (locked, a >> mask_shift (sz, b), e) case Adc -> { let carry = (bit) CF in @@ -509,7 +511,7 @@ function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, ( { CF := (bit) ((int) (value_width (sz)) <= unsigned(a) + unsigned(b)); OF := undefined; - write_arith_result_no_CF_OF (sz, result, e); + write_arith_result_no_CF_OF (locked, sz, result, e); } } case Sbb -> @@ -519,18 +521,18 @@ function unit write_binop ((wsize) sz, (binop_name) bop, (qword) a, (qword) b, ( { CF := (bit) (unsigned(a) < unsigned(b) + (int) carry); OF := undefined; - write_arith_result_no_CF_OF (sz, result, e); + write_arith_result_no_CF_OF (locked, sz, result, e); } } case _ -> exit () } -function unit write_monop ((wsize) sz, (monop_name) mop, (qword) a, (ea) e) = +function unit write_monop ((bool) locked, (wsize) sz, (monop_name) mop, (qword) a, (ea) e) = switch mop { - case Not -> wEA(e) := ~(a) - case Dec -> write_arith_result_no_CF_OF (sz, a - 1, e) - case Inc -> write_arith_result_no_CF_OF (sz, a + 1, e)(* XXX rmn30 should set OF *) - case Neg -> { write_arith_result_no_CF_OF (sz, 0 - a, e); + case Not -> wEA(locked, e) := ~(a) + case Dec -> write_arith_result_no_CF_OF (locked, sz, a - 1, e) + case Inc -> write_arith_result_no_CF_OF (locked, sz, a + 1, e)(* XXX rmn30 should set OF *) + case Neg -> { write_arith_result_no_CF_OF (locked, sz, 0 - a, e); CF := undefined; } } @@ -566,12 +568,12 @@ function qword pop_aux () = function unit push_aux ((qword) w) = { RSP := RSP - 8; - wMEM(RSP, 8) := w; + wMEM(false, RSP, 8) := w; } -function unit pop ((rm) r) = wEA (ea_rm (Sz64,r)) := pop_aux() +function unit pop ((rm) r) = wEA (false, ea_rm (Sz64,r)) := pop_aux() function unit pop_rip () = RIP := pop_aux() -function unit push ((imm_rm) i) = push_aux (EA (ea_imm_rm (i))) +function unit push ((imm_rm) i) = push_aux (EA (false, ea_imm_rm (i))) function unit push_rip () = push_aux (RIP) function unit drop ((qword) i) = if i[7 ..0] != 0 then () else RSP := RSP + i @@ -589,11 +591,11 @@ val ast -> unit effect {escape, rmem, rreg, undef, eamem, wmv, wreg, barr} execu Binop ========================================================================== *) -union ast member (binop_name,wsize,dest_src) Binop +union ast member (bool,binop_name,wsize,dest_src) Binop -function clause execute (Binop (bop,sz,ds)) = - let (e, val_dst, val_src) = read_dest_src_ea (sz, ds) in - write_binop (sz, bop, val_dst, val_src, e) +function clause execute (Binop (locked,bop,sz,ds)) = + let (e, val_dst, val_src) = read_dest_src_ea (locked, sz, ds) in + write_binop (locked, sz, bop, val_dst, val_src, e) (* ========================================================================== CALL @@ -627,20 +629,20 @@ function clause execute CMC = CF := ~(CF) CMPXCHG ========================================================================== *) -union ast member (wsize,rm,regn) CMPXCHG +union ast member (bool, wsize,rm,regn) CMPXCHG -function clause execute (CMPXCHG (sz,r,n)) = +function clause execute (CMPXCHG (locked, sz,r,n)) = let src = Ea_r(sz, n) in let acc = Ea_r(sz, 0) in (* RAX *) let dst = ea_rm(sz, r) in - let val_dst = EA(dst) in - let val_acc = EA(src) in + let val_dst = EA(locked, dst) in + let val_acc = EA(false, acc) in { - write_binop (sz, Cmp, val_acc, val_dst, src); + write_binop (locked, sz, Cmp, val_acc, val_dst, src); if val_acc == val_dst then - wEA(dst) := EA (src) + wEA(locked, dst) := EA (false, src) else - wEA(acc) := val_dst; + wEA(false, acc) := val_dst; } (* ========================================================================== @@ -653,15 +655,15 @@ function clause execute (DIV (sz,r)) = let w = (int) (value_width(sz)) in let eax = Ea_r(sz, 0) in (* RAX *) let edx = Ea_r(sz, 2) in (* RDX *) - let n = unsigned(EA(edx)) * w + unsigned(EA(eax)) in - let d = unsigned(EA(ea_rm(sz, r))) in + let n = unsigned(EA(false, edx)) * w + unsigned(EA(false, eax)) in + let d = unsigned(EA(false, ea_rm(sz, r))) in let q = n quot d in let m = n mod d in if d == 0 | w < q then exit () else { - wEA(eax) := (qword) q; - wEA(edx) := (qword) m; + wEA(false, eax) := (qword) q; + wEA(false, edx) := (qword) m; erase_eflags(); } @@ -689,7 +691,7 @@ function clause execute (Jcc (c,i)) = union ast member rm JMP -function clause execute (JMP (r)) = RIP := EA (ea_rm (Sz64, r)) +function clause execute (JMP (r)) = RIP := EA (false, ea_rm (Sz64, r)) (* ========================================================================== LEA @@ -700,7 +702,7 @@ union ast member (wsize,dest_src) LEA function clause execute (LEA (sz,ds)) = let src = ea_src (sz, ds) in let dst = ea_dest (sz, ds) in - wEA(dst) := get_ea_address (src) + wEA(false, dst) := get_ea_address (src) (* ========================================================================== LEAVE @@ -739,10 +741,10 @@ function clause execute (MFENCE) = Monop ========================================================================== *) -union ast member (monop_name,wsize,rm) Monop +union ast member (bool,monop_name,wsize,rm) Monop -function clause execute (Monop (mop,sz,r)) = - let e = ea_rm (sz, r) in write_monop (sz, mop, EA(e), e) +function clause execute (Monop (locked,mop,sz,r)) = + let e = ea_rm (sz, r) in write_monop (locked, sz, mop, EA(locked, e), e) (* ========================================================================== MOV @@ -754,7 +756,7 @@ function clause execute (MOV (c,sz,ds)) = if read_cond (c) then let src = ea_src (sz, ds) in let dst = ea_dest (sz, ds) in - wEA(dst) := EA(src) + wEA(false, dst) := EA(false, src) else () (* ========================================================================== @@ -766,7 +768,7 @@ union ast member (wsize,dest_src,wsize) MOVSX function clause execute (MOVSX (sz1,ds,sz2)) = let src = ea_src (sz1, ds) in let dst = ea_dest (sz2, ds) in - wEA(dst) := sign_extension (EA(src), sz1, sz2) + wEA(false, dst) := sign_extension (EA(false, src), sz1, sz2) (* ========================================================================== MOVZX @@ -777,7 +779,7 @@ union ast member (wsize,dest_src,wsize) MOVZX function clause execute (MOVZX (sz1,ds,sz2)) = let src = ea_src (sz1, ds) in let dst = ea_dest (sz2, ds) in - wEA(dst) := EA(src) + wEA(false, dst) := EA(false, src) (* ========================================================================== MUL @@ -787,16 +789,16 @@ union ast member (wsize,rm) MUL function clause execute (MUL (sz,r)) = let eax = Ea_r (sz, 0) in (* RAX *) - let val_eax = EA(eax) in - let val_src = EA(ea_rm (sz, r)) in + let val_eax = EA(false, eax) in + let val_src = EA(false, ea_rm (sz, r)) in switch sz { - case (Sz8(_)) -> wEA(Ea_r(Sz16,0)) := (val_eax * val_src)[63 .. 0] + case (Sz8(_)) -> wEA(false, Ea_r(Sz16,0)) := (val_eax * val_src)[63 .. 0] case _ -> let m = val_eax * val_src in let edx = Ea_r (sz, 2) in (* RDX *) { - wEA(eax) := m[63 .. 0]; - wEA(edx) := (m >> size_width(sz))[63 .. 0] + wEA(false, eax) := m[63 .. 0]; + wEA(false, edx) := (m >> size_width(sz))[63 .. 0] } } @@ -843,7 +845,7 @@ function clause execute (RET (i)) = union ast member (cond,bool,rm) SET function clause execute (SET (c,b,r)) = - wEA(ea_rm(Sz8(b),r)) := if read_cond (c) then 1 else 0 + wEA(false, ea_rm(Sz8(b),r)) := if read_cond (c) then 1 else 0 (* ========================================================================== STC @@ -857,32 +859,32 @@ function clause execute STC = CF := true XADD ========================================================================== *) -union ast member (wsize,rm,regn) XADD +union ast member (bool, wsize,rm,regn) XADD -function clause execute (XADD (sz,r,n)) = +function clause execute (XADD (locked,sz,r,n)) = let src = Ea_r (sz, n) in let dst = ea_rm (sz, r) in - let val_src = EA(src) in - let val_dst = EA(dst) in + let val_src = EA(false, src) in + let val_dst = EA(locked, dst) in { - wEA(src) := val_dst; - write_binop (sz, Add, val_src, val_dst, dst); + wEA(false, src) := val_dst; + write_binop (locked, sz, Add, val_src, val_dst, dst); } (* ========================================================================== XCHG ========================================================================== *) -union ast member (wsize,rm,regn) XCHG +union ast member (bool,wsize,rm,regn) XCHG -function clause execute (XCHG (sz,r,n)) = +function clause execute (XCHG (locked,sz,r,n)) = let src = Ea_r (sz, n) in let dst = ea_rm (sz, r) in - let val_src = EA(src) in - let val_dst = EA(dst) in + let val_src = EA(false, src) in + let val_dst = EA(locked, dst) in { - wEA(src) := val_dst; - wEA(dst) := val_src; + wEA(false, src) := val_dst; + wEA(locked, dst) := val_src; } end ast @@ -1302,14 +1304,16 @@ function (instruction_kind, regfps, regfps, regfps) regfp_dest_src ((dest_src) d } (* as above but where destination is also a source operand *) -function (instruction_kind, regfps, regfps, regfps) regfp_dest_src_rmw ((dest_src) ds) = +function (instruction_kind, regfps, regfps, regfps) regfp_dest_src_rmw (locked, (dest_src) ds) = + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in switch ds { case (Rm_i (r_m, i)) -> let (m,rds, ars) = regfp_rm(r_m) in - (if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple, append(rds, ars), rds, ars) + (if m then IK_mem_rmw(rk, wk) else IK_simple, append(rds, ars), rds, ars) case (Rm_r (r_m, r)) -> let (m,rds, ars) = regfp_rm(r_m) in - (if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple, RFull(GPRstr[r]) :: append(rds, ars), rds, ars) + (if m then IK_mem_rmw(rk, wk) else IK_simple, RFull(GPRstr[r]) :: append(rds, ars), rds, ars) case (R_rm (r, r_m)) -> let rds = [|| RFull(GPRstr[r]) ||] in let (m,rs,ars) = regfp_rm(r_m) in @@ -1372,9 +1376,9 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( Dia := DIAFP_none; x := (qword) RIP; switch instr { - case(Binop (binop, sz, ds)) -> { + case(Binop (locked, binop, sz, ds)) -> { let flags = regfp_binop_flags (binop) in - let (ik', iRs, oRs, aRs) = regfp_dest_src_rmw(ds) in { + let (ik', iRs, oRs, aRs) = regfp_dest_src_rmw(locked, ds) in { ik := ik'; iR := append(iRs, iR); oR := append(flags, append(oRs, oR)); @@ -1398,9 +1402,11 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( iR := RFull("CF") :: iR; oR := RFull("CF") :: oR; } - case(CMPXCHG (sz, r_m, reg) ) -> + case(CMPXCHG (locked, sz, r_m, reg) ) -> + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, aRs) = regfp_rm (r_m) in { - iK := if m then IK_mem_rmw (Read_plain, Write_plain) else IK_simple; + iK := if m then IK_mem_rmw (rk, wk) else IK_simple; iR := RFull("RAX") :: RFull(GPRstr[reg]) :: append(rs, aRs); oR := RFull("RAX") :: append(regfp_binop_flags(Cmp), rs); aR := aRs; @@ -1447,9 +1453,11 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( Nias := NIAFP_concrete_address(RIP + imm64) :: Nias; } case(MFENCE ) -> iK := IK_barrier (Barrier_x86_MFENCE) - case(Monop (monop, sz, r_m) ) -> + case(Monop (locked, monop, sz, r_m) ) -> + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in let (m, rds, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iK := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := append(rds, ars); oR := append(all_flags_but_cf_of, rds); (* XXX fix flags *) aR := ars; @@ -1516,16 +1524,20 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := ars; } case(STC ) -> oR := [|| RFull("CF") ||] - case(XADD (sz, r_m, reg) ) -> + case(XADD (locked, sz, r_m, reg) ) -> + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iK := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := RFull(GPRstr[reg]) :: append(rs, ars); oR := RFull(GPRstr[reg]) :: append(rs, all_flags); aR := ars; } - case(XCHG (sz, r_m, reg) ) -> + case(XCHG (locked, sz, r_m, reg) ) -> + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_simple; + iK := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := RFull(GPRstr[reg]) :: append(rs, ars); oR := RFull(GPRstr[reg]) :: rs; aR := ars; -- cgit v1.2.3 From 83adaea79d0ae53ff898985fdd359fbca7773de3 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 21 Sep 2017 09:51:41 +0100 Subject: added a comment to the x86 lock'd read and write --- src/lem_interp/sail_impl_base.lem | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index e39c4421..6957bb95 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -441,7 +441,8 @@ type read_kind = | Read_RISCV_acquire | Read_RISCV_strong_acquire | Read_RISCV_reserved | Read_RISCV_reserved_acquire | Read_RISCV_reserved_strong_acquire - | Read_X86_locked + (* x86 reads *) + | Read_X86_locked (* the read part of a lock'd instruction (rmw) *) instance (Show read_kind) let show = function @@ -471,7 +472,8 @@ type write_kind = | Write_RISCV_release | Write_RISCV_strong_release | Write_RISCV_conditional | Write_RISCV_conditional_release | Write_RISCV_conditional_strong_release - | Write_X86_locked + (* x86 writes *) + | Write_X86_locked (* the write part of a lock'd instruction (rmw) *) instance (Show write_kind) let show = function -- cgit v1.2.3 From 2148a88c9e9d16e07be1439ddc36ed69c31ee74c Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 21 Sep 2017 10:52:23 +0100 Subject: wib --- src/gen_lib/state.lem | 1 + 1 file changed, 1 insertion(+) diff --git a/src/gen_lib/state.lem b/src/gen_lib/state.lem index ac5cb869..88e29522 100644 --- a/src/gen_lib/state.lem +++ b/src/gen_lib/state.lem @@ -59,6 +59,7 @@ let is_exclusive = function | Sail_impl_base.Read_RISCV_reserved -> true | Sail_impl_base.Read_RISCV_reserved_acquire -> true | Sail_impl_base.Read_RISCV_reserved_strong_acquire -> true + | Sail_impl_base.Read_X86_locked -> true end -- cgit v1.2.3 From 44ade2212a4c7fe68d6c2c2bddc0f57a0d0ca5c7 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 22 Sep 2017 10:55:30 +0100 Subject: fix typo where Sz16 write to register was only writing 8 bits. --- x86/x64.sail | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/x86/x64.sail b/x86/x64.sail index 0b0d2230..a54b35a4 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -301,7 +301,7 @@ function unit effect { wmem, wreg, escape } wEA ((bool) locked, (ea) e, (qword) case (Ea_r(Sz16,r)) -> { (qword) regr := REG[r]; - regr[15 .. 8] := w[15 .. 8]; + regr[15 .. 0] := w[15 .. 0]; REG[r] := regr } case (Ea_r(Sz32,r)) -> REG[r] := (qword) (EXTZ (w[31 .. 0])) -- cgit v1.2.3 From 433063a6b229748599dde8f4374765c7d538fd22 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 22 Sep 2017 11:34:04 +0100 Subject: x86: remove unnecessary? read modify write of registers. --- x86/x64.sail | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index a54b35a4..99da122f 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -287,23 +287,10 @@ function unit effect { wmem, wreg, escape } wEA ((bool) locked, (ea) e, (qword) case (Ea_i(_,_)) -> exit () case (Ea_r((Sz8(have_rex)),r)) -> if have_rex | r < 4 (* RSP *) | r > 7 (* RDI *) then - { - (qword) regr := REG[r]; - regr[7 .. 0] := w[7 .. 0]; - REG[r] := regr - } + (REG[r])[7 .. 0] := w[7 .. 0] else - { - (qword) regr := REG[sub4(r)]; - regr[15 .. 8] := (vector<15,8,dec,bit>) (w[7 .. 0]); - REG[sub4(r)] := regr - } - case (Ea_r(Sz16,r)) -> - { - (qword) regr := REG[r]; - regr[15 .. 0] := w[15 .. 0]; - REG[r] := regr - } + (REG[sub4(r)])[15 .. 8] := (vector<15,8,dec,bit>) (w[7 .. 0]) + case (Ea_r(Sz16,r)) ->(REG[r])[15 .. 0] := w[15 .. 0] case (Ea_r(Sz32,r)) -> REG[r] := (qword) (EXTZ (w[31 .. 0])) case (Ea_r(Sz64,r)) -> REG[r] := w case (Ea_m((Sz8(_)),a)) -> wMEM(locked, a, 1, w[7 .. 0]) -- cgit v1.2.3 From 963d4fef5b9c75939b744f1a2e09779859c7c643 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 22 Sep 2017 13:47:09 +0100 Subject: x86: implement get_ea_address function. --- x86/x64.sail | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index 99da122f..2f6f07ed 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -310,11 +310,11 @@ function qword call_dest_from_ea ((ea) e) = case (Ea_m(_, a)) -> rMEM(a, 8) } -function qword get_ea_address ((ea) e) = (* XXX rmn30 looks broken *) +function qword get_ea_address ((ea) e) = switch e { case (Ea_i(_, i)) -> 0x0000000000000000 case (Ea_r(_, r)) -> 0x0000000000000000 - case (Ea_m(_, a)) -> 0x0000000000000000 + case (Ea_m(_, a)) -> a } function unit jump_to_ea ((ea) e) = RIP := call_dest_from_ea(e) -- cgit v1.2.3 From 8ca00a2729ed477183afeeb1ad20b5a0fc23dc82 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 25 Sep 2017 12:28:26 +0100 Subject: x86: always perform write for cmpxchg by writing back original value if comparison fails. This is specified in manual and also helps RMEM with locked writes. --- x86/x64.sail | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/x86/x64.sail b/x86/x64.sail index 2f6f07ed..dfa92fd3 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -628,8 +628,12 @@ function clause execute (CMPXCHG (locked, sz,r,n)) = write_binop (locked, sz, Cmp, val_acc, val_dst, src); if val_acc == val_dst then wEA(locked, dst) := EA (false, src) - else + else { wEA(false, acc) := val_dst; + (* write back the original value in dst so that we always + perform locked write after locked read *) + wEA(locked, dst) := val_dst; + } } (* ========================================================================== -- cgit v1.2.3 From 5cb198d1f9e944a9a7f7c4c01640ff8136b0e0ab Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Tue, 26 Sep 2017 09:12:37 +0100 Subject: RISC-V: check alignment of atomic memory accesses (and escape when misaligned) --- risc-v/riscv.sail | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index c5b19d26..55a672ad 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -60,13 +60,24 @@ function forall 'a. 'a effect { escape } not_implemented((string) message) = exit message; } +function unit effect { escape } check_alignment( (bit[64]) addr, (nat) width) = +{ + if (unsigned(addr) quot width != 0) then + exit "misaligned memory access"; +} + + val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_acquire val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_strong_acquire val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_acquire val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_strong_acquire -function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) rl, (bool) res) = +function forall Nat 'n. (bit[8 * 'n]) effect { rmem, escape } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) rl, (bool) res) = +{ + if (aq | res) then + check_alignment(addr, width); + switch (aq, rl, res) { case (false, false, false) -> MEMr(addr, width) case (true, false, false) -> MEMr_acquire(addr, width) @@ -77,6 +88,7 @@ function forall Nat 'n. (bit[8 * 'n]) effect { rmem } mem_read( (bit[64]) addr, case (false, true, true) -> not_implemented("lr.rl is not implemented") case (true, true, true) -> MEMr_reserved_strong_acquire(addr, width) } +} val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release @@ -84,7 +96,11 @@ val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_str val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_strong_release -function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) aq, (bool) rl, (bool) con) = +function forall Nat 'n. unit effect { eamem, escape } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) aq, (bool) rl, (bool) con) = +{ + if (rl | con) then + check_alignment(addr, width); + switch (aq, rl, con) { case (false, false, false) -> MEMea(addr, width) case (false, true, false) -> MEMea_release(addr, width) @@ -95,6 +111,7 @@ function forall Nat 'n. unit effect { eamem } mem_write_ea( (bit[64]) addr , ([| case (true, false, true) -> not_implemented("sc.aq is not implemented") case (true, true , true) -> MEMea_conditional_strong_release(addr, width) } +} val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release @@ -102,7 +119,11 @@ val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_release val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_strong_release -function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) aq, (bool) rl, (bool) con) = +function forall Nat 'n. unit effect { wmv, escape } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) aq, (bool) rl, (bool) con) = +{ + if (rl | con) then + check_alignment(addr, width); + switch (aq, rl, con) { case (false, false, false) -> MEMval(addr, width, value) case (false, true, false) -> MEMval_release(addr, width, value) @@ -113,6 +134,7 @@ function forall Nat 'n. unit effect { wmv } mem_write_value( (bit[64]) addr , ([ case (true, false, true) -> not_implemented("sc.aq is not implemented") case (true, true, true) -> MEMval_conditional_strong_release(addr, width, value) } +} val extern unit -> bool effect {exmem} speculate_conditional_success @@ -427,6 +449,7 @@ function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b01 function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMINU, aq, rl, rs2, rs1, DOUBLE, rd)) function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, WORD, rd)) function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, DOUBLE, rd)) + function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { (bit[64]) addr := rGPR(rs1); -- cgit v1.2.3 From 72e597901e710f1549d387d9c1326b04be42e9d2 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Tue, 26 Sep 2017 12:23:46 +0100 Subject: fixes --- src/gen_lib/deep_shallow_convert.lem | 40 ++++++++++++++++++++---------------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/src/gen_lib/deep_shallow_convert.lem b/src/gen_lib/deep_shallow_convert.lem index 42a65c49..86365b78 100644 --- a/src/gen_lib/deep_shallow_convert.lem +++ b/src/gen_lib/deep_shallow_convert.lem @@ -385,16 +385,17 @@ end let read_kindToInterpValue = function | Read_plain -> V_ctor (Id_aux (Id "Read_plain") Unknown) (T_id "read_kind") (C_Enum 0) (toInterpValue ()) - | Read_reserve -> V_ctor (Id_aux (Id "Read_reserve") Unknown) (T_id "read_kind") (C_Enum 2) (toInterpValue ()) - | Read_acquire -> V_ctor (Id_aux (Id "Read_acquire") Unknown) (T_id "read_kind") (C_Enum 3) (toInterpValue ()) - | Read_exclusive -> V_ctor (Id_aux (Id "Read_exclusive") Unknown) (T_id "read_kind") (C_Enum 4) (toInterpValue ()) - | Read_exclusive_acquire -> V_ctor (Id_aux (Id "Read_exclusive_acquire") Unknown) (T_id "read_kind") (C_Enum 5) (toInterpValue ()) - | Read_stream -> V_ctor (Id_aux (Id "Read_stream") Unknown) (T_id "read_kind") (C_Enum 6) (toInterpValue ()) - | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_acquire") Unknown) (T_id "read_kind") (C_Enum 7) (toInterpValue ()) - | Read_RISCV_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ()) - | Read_RISCV_reserved -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ()) - | Read_RISCV_reserved_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) + | Read_reserve -> V_ctor (Id_aux (Id "Read_reserve") Unknown) (T_id "read_kind") (C_Enum 1) (toInterpValue ()) + | Read_acquire -> V_ctor (Id_aux (Id "Read_acquire") Unknown) (T_id "read_kind") (C_Enum 2) (toInterpValue ()) + | Read_exclusive -> V_ctor (Id_aux (Id "Read_exclusive") Unknown) (T_id "read_kind") (C_Enum 3) (toInterpValue ()) + | Read_exclusive_acquire -> V_ctor (Id_aux (Id "Read_exclusive_acquire") Unknown) (T_id "read_kind") (C_Enum 4) (toInterpValue ()) + | Read_stream -> V_ctor (Id_aux (Id "Read_stream") Unknown) (T_id "read_kind") (C_Enum 5) (toInterpValue ()) + | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_acquire") Unknown) (T_id "read_kind") (C_Enum 6) (toInterpValue ()) + | Read_RISCV_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 7) (toInterpValue ()) + | Read_RISCV_reserved -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ()) + | Read_RISCV_reserved_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ()) | Read_RISCV_reserved_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ()) + | Read_X86_locked -> V_ctor (Id_aux (Id "Read_X86_locked") Unknown) (T_id "read_kind") (C_Enum 11) (toInterpValue ()) end let rec read_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Read_plain") _) _ _ v -> Read_plain @@ -408,6 +409,7 @@ let rec read_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Read_RISCV_reserved") _) _ _ v -> Read_RISCV_reserved | V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") _) _ _ v -> Read_RISCV_reserved_acquire | V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") _) _ _ v -> Read_RISCV_reserved_strong_acquire + | V_ctor (Id_aux (Id "Read_X86_locked") _) _ _ v -> Read_X86_locked | V_tuple [v] -> read_kindFromInterpValue v | v -> failwith ("fromInterpValue read_kind: unexpected value. " ^ Interp.debug_print_value v) @@ -420,15 +422,16 @@ end let write_kindToInterpValue = function | Write_plain -> V_ctor (Id_aux (Id "Write_plain") Unknown) (T_id "write_kind") (C_Enum 0) (toInterpValue ()) - | Write_conditional -> V_ctor (Id_aux (Id "Write_conditional") Unknown) (T_id "write_kind") (C_Enum 2) (toInterpValue ()) - | Write_release -> V_ctor (Id_aux (Id "Write_release") Unknown) (T_id "write_kind") (C_Enum 3) (toInterpValue ()) - | Write_exclusive -> V_ctor (Id_aux (Id "Write_exclusive") Unknown) (T_id "write_kind") (C_Enum 4) (toInterpValue ()) - | Write_exclusive_release -> V_ctor (Id_aux (Id "Write_exclusive_release") Unknown) (T_id "write_kind") (C_Enum 5) (toInterpValue ()) - | Write_RISCV_release -> V_ctor (Id_aux (Id "Write_RISCV_release") Unknown) (T_id "write_kind") (C_Enum 6) (toInterpValue ()) - | Write_RISCV_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_strong_release") Unknown) (T_id "write_kind") (C_Enum 7) (toInterpValue ()) - | Write_RISCV_conditional -> V_ctor (Id_aux (Id "Write_RISCV_conditional") Unknown) (T_id "write_kind") (C_Enum 8) (toInterpValue ()) - | Write_RISCV_conditional_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_release") Unknown) (T_id "write_kind") (C_Enum 9) (toInterpValue ()) - | Write_RISCV_conditional_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") Unknown) (T_id "write_kind") (C_Enum 10) (toInterpValue ()) + | Write_conditional -> V_ctor (Id_aux (Id "Write_conditional") Unknown) (T_id "write_kind") (C_Enum 1) (toInterpValue ()) + | Write_release -> V_ctor (Id_aux (Id "Write_release") Unknown) (T_id "write_kind") (C_Enum 2) (toInterpValue ()) + | Write_exclusive -> V_ctor (Id_aux (Id "Write_exclusive") Unknown) (T_id "write_kind") (C_Enum 3) (toInterpValue ()) + | Write_exclusive_release -> V_ctor (Id_aux (Id "Write_exclusive_release") Unknown) (T_id "write_kind") (C_Enum 4) (toInterpValue ()) + | Write_RISCV_release -> V_ctor (Id_aux (Id "Write_RISCV_release") Unknown) (T_id "write_kind") (C_Enum 5) (toInterpValue ()) + | Write_RISCV_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_strong_release") Unknown) (T_id "write_kind") (C_Enum 6) (toInterpValue ()) + | Write_RISCV_conditional -> V_ctor (Id_aux (Id "Write_RISCV_conditional") Unknown) (T_id "write_kind") (C_Enum 7) (toInterpValue ()) + | Write_RISCV_conditional_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_release") Unknown) (T_id "write_kind") (C_Enum 8) (toInterpValue ()) + | Write_RISCV_conditional_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") Unknown) (T_id "write_kind") (C_Enum 9) (toInterpValue ()) + | Write_X86_locked -> V_ctor (Id_aux (Id "Write_X86_locked") Unknown) (T_id "write_kind") (C_Enum 10) (toInterpValue ()) end let rec write_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Write_plain") _) _ _ v -> Write_plain @@ -441,6 +444,7 @@ let rec write_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Write_RISCV_conditional") _) _ _ v -> Write_RISCV_conditional | V_ctor (Id_aux (Id "Write_RISCV_conditional_release") _) _ _ v -> Write_RISCV_conditional_release | V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") _) _ _ v -> Write_RISCV_conditional_strong_release + | V_ctor (Id_aux (Id "Write_X86_locked") _) _ _ v -> Write_X86_locked | V_tuple [v] -> write_kindFromInterpValue v | v -> failwith ("fromInterpValue write_kind: unexpected value " ^ Interp.debug_print_value v) -- cgit v1.2.3 From f5322fa262de3545d453891745e3c1cdaaceb5f5 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Wed, 27 Sep 2017 09:04:30 +0100 Subject: oops --- risc-v/riscv.sail | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 55a672ad..ea885d90 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -62,7 +62,7 @@ function forall 'a. 'a effect { escape } not_implemented((string) message) = function unit effect { escape } check_alignment( (bit[64]) addr, (nat) width) = { - if (unsigned(addr) quot width != 0) then + if (unsigned(addr) mod width != 0) then exit "misaligned memory access"; } -- cgit v1.2.3 From a66b55639fddc862b7a3864afb0e3dc7b4ac0e34 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Wed, 27 Sep 2017 14:13:01 +0100 Subject: split RISC-V to two Sail files to make it more readable --- risc-v/Makefile | 2 +- risc-v/riscv.sail | 311 +++++++++++++++++------------------------------- risc-v/riscv_types.sail | 165 +++++++++++++++++++++++++ 3 files changed, 277 insertions(+), 201 deletions(-) create mode 100644 risc-v/riscv_types.sail diff --git a/risc-v/Makefile b/risc-v/Makefile index 856a48eb..d027556e 100644 --- a/risc-v/Makefile +++ b/risc-v/Makefile @@ -1,6 +1,6 @@ SAIL:=../src/sail.native -SOURCES:=riscv.sail ../etc/regfp.sail riscv_regfp.sail +SOURCES:=riscv_types.sail riscv.sail ../etc/regfp.sail riscv_regfp.sail all: lem_ast shallow lem_ast: $(SOURCES) $(SAIL) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index ea885d90..8658ae96 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -1,177 +1,11 @@ -default Order dec - -typedef regval = bit[64] -typedef regno = bit[5] - -register (regval) x0 -register (regval) x1 -register (regval) x2 -register (regval) x3 -register (regval) x4 -register (regval) x5 -register (regval) x6 -register (regval) x7 -register (regval) x8 -register (regval) x9 -register (regval) x10 -register (regval) x11 -register (regval) x12 -register (regval) x13 -register (regval) x14 -register (regval) x15 -register (regval) x16 -register (regval) x17 -register (regval) x18 -register (regval) x19 -register (regval) x20 -register (regval) x21 -register (regval) x22 -register (regval) x23 -register (regval) x24 -register (regval) x25 -register (regval) x26 -register (regval) x27 -register (regval) x28 -register (regval) x29 -register (regval) x30 -register (regval) x31 - -register (bit[64]) PC -register (bit[64]) nextPC - -let (vector <0, 32, inc, (register<(regval)>)>) GPRs = - [ x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, - x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, - x28, x29, x30, x31 - ] - -function (regval) rGPR ((regno) r) = - if (r == 0) then - 0 - else - GPRs[r] - -function unit wGPR((regno) r, (regval) v) = - if (r != 0) then - GPRs[r] := v - -function forall 'a. 'a effect { escape } not_implemented((string) message) = -{ - exit message; -} - -function unit effect { escape } check_alignment( (bit[64]) addr, (nat) width) = -{ - if (unsigned(addr) mod width != 0) then - exit "misaligned memory access"; -} - - -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_acquire -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_strong_acquire -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_acquire -val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_strong_acquire -function forall Nat 'n. (bit[8 * 'n]) effect { rmem, escape } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) rl, (bool) res) = -{ - if (aq | res) then - check_alignment(addr, width); - - switch (aq, rl, res) { - case (false, false, false) -> MEMr(addr, width) - case (true, false, false) -> MEMr_acquire(addr, width) - case (false, false, true) -> MEMr_reserved(addr, width) - case (true, false, true) -> MEMr_reserved_acquire(addr, width) - case (false, true, false) -> not_implemented("load.rl is not implemented") - case (true, true, false) -> MEMr_strong_acquire(addr, width) - case (false, true, true) -> not_implemented("lr.rl is not implemented") - case (true, true, true) -> MEMr_reserved_strong_acquire(addr, width) - } -} - -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_strong_release -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release -val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_strong_release -function forall Nat 'n. unit effect { eamem, escape } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) aq, (bool) rl, (bool) con) = -{ - if (rl | con) then - check_alignment(addr, width); - - switch (aq, rl, con) { - case (false, false, false) -> MEMea(addr, width) - case (false, true, false) -> MEMea_release(addr, width) - case (false, false, true) -> MEMea_conditional(addr, width) - case (false, true , true) -> MEMea_conditional_release(addr, width) - case (true, false, false) -> not_implemented("store.aq is not implemented") - case (true, true, false) -> MEMea_strong_release(addr, width) - case (true, false, true) -> not_implemented("sc.aq is not implemented") - case (true, true , true) -> MEMea_conditional_strong_release(addr, width) - } -} - -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_strong_release -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_release -val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_strong_release -function forall Nat 'n. unit effect { wmv, escape } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) aq, (bool) rl, (bool) con) = -{ - if (rl | con) then - check_alignment(addr, width); - - switch (aq, rl, con) { - case (false, false, false) -> MEMval(addr, width, value) - case (false, true, false) -> MEMval_release(addr, width, value) - case (false, false, true) -> MEMval_conditional(addr, width, value) - case (false, true, true) -> MEMval_conditional_release(addr, width, value) - case (true, false, false) -> not_implemented("store.aq is not implemented") - case (true, true, false) -> MEMval_strong_release(addr, width, value) - case (true, false, true) -> not_implemented("sc.aq is not implemented") - case (true, true, true) -> MEMval_conditional_strong_release(addr, width, value) - } -} - -val extern unit -> bool effect {exmem} speculate_conditional_success - -val extern unit -> unit effect { barr } MEM_fence_rw_rw -val extern unit -> unit effect { barr } MEM_fence_r_rw -val extern unit -> unit effect { barr } MEM_fence_rw_w -val extern unit -> unit effect { barr } MEM_fence_w_w -val extern unit -> unit effect { barr } MEM_fence_i - -(* Ideally these would be sail builtin *) -function (bit[64]) shift_right_arith64 ((bit[64]) v, (bit[6]) shift) = - let (bit[128]) v128 = EXTS(v) in - (v128 >> shift)[63..0] - -function (bit[32]) shift_right_arith32 ((bit[32]) v, (bit[5]) shift) = - let (bit[64]) v64 = EXTS(v) in - (v64 >> shift)[31..0] - -typedef uop = enumerate {LUI; AUIPC} (* upper immediate ops *) -typedef bop = enumerate {BEQ; BNE; BLT; BGE; BLTU; BGEU} (* branch ops *) -typedef iop = enumerate {ADDI; SLTI; SLTIU; XORI; ORI; ANDI} (* immediate ops *) -typedef sop = enumerate {SLLI; SRLI; SRAI} (* shift ops *) -typedef rop = enumerate {ADD; SUB; SLL; SLT; SLTU; XOR; SRL; SRA; OR; AND} (* reg-reg ops *) -typedef ropw = enumerate {ADDW; SUBW; SLLW; SRLW; SRAW} (* reg-reg 32-bit ops *) -typedef amoop = enumerate {AMOSWAP; AMOADD; AMOXOR; AMOAND; AMOOR; - AMOMIN; AMOMAX; AMOMINU; AMOMAXU} (* AMO ops *) - - -typedef word_width = enumerate {BYTE; HALF; WORD; DOUBLE} - -scattered function unit execute scattered typedef ast = const union val bit[32] -> option effect pure decode - scattered function option decode +scattered function unit execute + +(********************************************************************) union ast member ((bit[20]), regno, uop) UTYPE function clause decode ((bit[20]) imm : (regno) rd : 0b0110111) = Some(UTYPE(imm, rd, LUI)) @@ -185,30 +19,44 @@ function clause execute (UTYPE(imm, rd, op)) = } in wGPR(rd, ret) +(********************************************************************) union ast member ((bit[21]), regno) JAL + function clause decode ((bit[20]) imm : (regno) rd : 0b1101111) = Some (JAL(imm[19] : imm[7..0] : imm[8] : imm[18..13] : imm[12..9] : 0b0, rd)) + function clause execute (JAL(imm, rd)) = let (bit[64]) offset = EXTS(imm) in { nextPC := PC + offset; wGPR(rd, PC + 4); } +(********************************************************************) union ast member((bit[12]), regno, regno) JALR + function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b1100111) = Some(JALR(imm, rs1, rd)) + function clause execute (JALR(imm, rs1, rd)) = let (bit[64]) newPC = rGPR(rs1) + EXTS(imm) in { nextPC := newPC[63..1] : 0b0; wGPR(rd, PC + 4); } +(********************************************************************) union ast member ((bit[13]), regno, regno, bop) BTYPE -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BEQ)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BNE)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b100 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLT)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b101 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGE)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b110 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLTU)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b111 : (bit[5]) imm5 : 0b1100011) = Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGEU)) + +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BEQ)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BNE)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b100 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLT)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b101 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGE)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b110 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLTU)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b111 : (bit[5]) imm5 : 0b1100011) = + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGEU)) function clause execute (BTYPE(imm, rs2, rs1, op)) = let rs1_val = rGPR(rs1) in @@ -224,13 +72,16 @@ function clause execute (BTYPE(imm, rs2, rs1, op)) = if (taken) then nextPC := PC + EXTS(imm) +(********************************************************************) union ast member ((bit[12]), regno, regno, iop) ITYPE + function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ADDI)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, SLTI)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, SLTIU)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, XORI)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ORI)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b111 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ANDI)) + function clause execute (ITYPE (imm, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let imm64 = (bit[64]) (EXTS(imm)) in @@ -244,10 +95,13 @@ function clause execute (ITYPE (imm, rs1, rd, op)) = } in wGPR(rd, result) +(********************************************************************) union ast member ((bit[6]), regno, regno, sop) SHIFTIOP + function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SLLI)) function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SRLI)) function clause decode (0b010000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SRAI)) + function clause execute (SHIFTIOP(shamt, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let result = switch(op) { @@ -257,7 +111,9 @@ function clause execute (SHIFTIOP(shamt, rs1, rd, op)) = } in wGPR(rd, result) +(********************************************************************) union ast member (regno, regno, regno, rop) RTYPE + function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, ADD)) function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SUB)) function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SLL)) @@ -268,6 +124,7 @@ function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SRA)) function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b110 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, OR)) function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b111 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, AND)) + function clause execute (RTYPE(rs2, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let rs2_val = rGPR(rs2) in @@ -285,7 +142,9 @@ function clause execute (RTYPE(rs2, rs1, rd, op)) = } in wGPR(rd, result) +(********************************************************************) union ast member ((bit[12]), regno, regno, bool, word_width, bool, bool) LOAD + function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, BYTE, false, false)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b001 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, HALF, false, false)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, false, WORD, false, false)) @@ -293,6 +152,7 @@ function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b000 function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, BYTE, false, false)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b101 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, HALF, false, false)) function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0000011) = Some(LOAD(imm, rs1, rd, true, WORD, false, false)) + function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in let (bit[64]) result = if unsigned then @@ -311,11 +171,18 @@ function clause execute(LOAD(imm, rs1, rd, unsigned, width, aq, rl)) = } in wGPR(rd, result) +(********************************************************************) union ast member ((bit[12]), regno, regno, word_width, bool, bool) STORE -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, BYTE, false, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, HALF, false, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, WORD, false, false)) -function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE, false, false)) + +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b0100011) = + Some(STORE(imm7 : imm5, rs2, rs1, BYTE, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b0100011) = + Some(STORE(imm7 : imm5, rs2, rs1, HALF, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b010 : (bit[5]) imm5 : 0b0100011) = + Some(STORE(imm7 : imm5, rs2, rs1, WORD, false, false)) +function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b011 : (bit[5]) imm5 : 0b0100011) = + Some(STORE(imm7 : imm5, rs2, rs1, DOUBLE, false, false)) + function clause execute (STORE(imm, rs2, rs1, width, aq, rl)) = let (bit[64]) addr = rGPR(rs1) + EXTS(imm) in { switch (width) { @@ -333,18 +200,25 @@ function clause execute (STORE(imm, rs2, rs1, width, aq, rl)) = } } +(********************************************************************) union ast member ((bit[12]), regno, regno) ADDIW -function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0011011) = Some(ADDIW(imm, rs1, rd)) + +function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0011011) = + Some(ADDIW(imm, rs1, rd)) + function clause execute (ADDIW(imm, rs1, rd)) = let (bit[64]) imm64 = EXTS(imm) in let (bit[64]) result64 = imm64 + rGPR(rs1) in let (bit[64]) result32 = EXTS(result64[31..0]) in wGPR(rd, result32) +(********************************************************************) union ast member ((bit[5]), regno, regno, sop) SHIFTW + function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SLLI)) function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SRLI)) function clause decode (0b0100000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SRAI)) + function clause execute (SHIFTW(shamt, rs1, rd, op)) = let rs1_val = (rGPR(rs1))[31..0] in let result = switch(op) { @@ -354,12 +228,15 @@ function clause execute (SHIFTW(shamt, rs1, rd, op)) = } in wGPR(rd, EXTS(result)) +(********************************************************************) union ast member (regno, regno, regno, ropw) RTYPEW + function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, ADDW)) function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SUBW)) function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SLLW)) function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SRLW)) function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SRAW)) + function clause execute (RTYPEW(rs2, rs1, rd, op)) = let rs1_val = (rGPR(rs1))[31..0] in let rs2_val = (rGPR(rs2))[31..0] in @@ -372,8 +249,11 @@ function clause execute (RTYPEW(rs2, rs1, rd, op)) = } in wGPR(rd, EXTS(result)) +(********************************************************************) union ast member (bit[4], bit[4]) FENCE + function clause decode (0b0000 : (bit[4]) pred : (bit[4]) succ : 0b00000 : 0b000 : 0b00000 : 0b0001111) = Some(FENCE (pred, succ)) + function clause execute (FENCE(pred, succ)) = { switch(pred, succ) { case (0b0011, 0b0011) -> MEM_fence_rw_rw() @@ -384,19 +264,24 @@ function clause execute (FENCE(pred, succ)) = { } } +(********************************************************************) union ast member unit FENCEI function clause decode (0b000000000000 : 0b00000 : 0b001 : 0b00000 : 0b0001111) = Some(FENCEI) function clause execute FENCEI = MEM_fence_i() +(********************************************************************) union ast member unit ECALL function clause decode (0b000000000000 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(ECALL ()) function clause execute ECALL = not_implemented("ECALL is not implemented") +(********************************************************************) union ast member unit EBREAK function clause decode (0b000000000001 : 0b00000 : 0b000 : 0b00000 : 0b1110011) = Some(EBREAK ()) function clause execute EBREAK = { exit () } +(********************************************************************) union ast member (bool, bool, regno, word_width, regno) LOADRES + function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, WORD, rd)) function clause decode (0b00010 : [aq] : [rl] : 0b00000 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(LOADRES(aq, rl, rs1, DOUBLE, rd)) function clause execute(LOADRES(aq, rl, rs1, width, rd)) = @@ -408,9 +293,14 @@ function clause execute(LOADRES(aq, rl, rs1, width, rd)) = } in wGPR(rd, result) +(********************************************************************) union ast member (bool, bool, regno, regno, word_width, regno) STORECON -function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(STORECON(aq, rl, rs2, rs1, DOUBLE, rd)) + +function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(STORECON(aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00011 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(STORECON(aq, rl, rs2, rs1, DOUBLE, rd)) + function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { (*(bit)*) status := if speculate_conditional_success() then 0 else 1; wGPR(rd) := (bit[64]) (EXTZ([status])); @@ -429,26 +319,45 @@ function clause execute (STORECON(aq, rl, rs2, rs1, width, rd)) = { }; } +(********************************************************************) union ast member (amoop, bool, bool, regno, regno, word_width, regno) AMO -function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOSWAP, aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOSWAP, aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOADD , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOADD , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOXOR , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOXOR , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOAND , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOAND , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOOR , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOOR , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMIN , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMIN , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMAX , aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMAX , aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMINU, aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMINU, aq, rl, rs2, rs1, DOUBLE, rd)) -function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, WORD, rd)) -function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = Some(AMO(AMOMAXU, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOSWAP, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00001 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOSWAP, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOADD , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOADD , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOXOR , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b00100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOXOR , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOAND , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b01100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOAND , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOOR , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b01000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOOR , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOMIN , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b10000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOMIN , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOMAX , aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b10100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOMAX , aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOMINU, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b11000 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOMINU, aq, rl, rs2, rs1, DOUBLE, rd)) +function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0101111) = + Some(AMO(AMOMAXU, aq, rl, rs2, rs1, WORD, rd)) +function clause decode (0b11100 : [aq] : [rl] : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0101111) = + Some(AMO(AMOMAXU, aq, rl, rs2, rs1, DOUBLE, rd)) function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { (bit[64]) addr := rGPR(rs1); @@ -486,6 +395,8 @@ function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { }; } +(********************************************************************) + function clause decode _ = None end ast diff --git a/risc-v/riscv_types.sail b/risc-v/riscv_types.sail new file mode 100644 index 00000000..a11d5561 --- /dev/null +++ b/risc-v/riscv_types.sail @@ -0,0 +1,165 @@ +default Order dec + +function forall 'a. 'a effect { escape } not_implemented((string) message) = + exit message + +typedef regval = bit[64] +typedef regno = bit[5] + +(* register (regval) x0 is hard-wired zero *) +register (regval) x1 +register (regval) x2 +register (regval) x3 +register (regval) x4 +register (regval) x5 +register (regval) x6 +register (regval) x7 +register (regval) x8 +register (regval) x9 +register (regval) x10 +register (regval) x11 +register (regval) x12 +register (regval) x13 +register (regval) x14 +register (regval) x15 +register (regval) x16 +register (regval) x17 +register (regval) x18 +register (regval) x19 +register (regval) x20 +register (regval) x21 +register (regval) x22 +register (regval) x23 +register (regval) x24 +register (regval) x25 +register (regval) x26 +register (regval) x27 +register (regval) x28 +register (regval) x29 +register (regval) x30 +register (regval) x31 + +register (bit[64]) PC +register (bit[64]) nextPC + +let (vector <1, 31, inc, (register<(regval)>)>) GPRs = + [ (* x0, *) x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, + x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, + x28, x29, x30, x31 + ] + +function (regval) rGPR ((regno) r) = + if (r == 0) then + 0 + else + GPRs[r] + +function unit wGPR((regno) r, (regval) v) = + if (r != 0) then + GPRs[r] := v + +function unit effect { escape } check_alignment( (bit[64]) addr, (nat) width) = + if (unsigned(addr) mod width != 0) then + exit "misaligned memory access" + +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_acquire +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_strong_acquire +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_acquire +val extern forall Nat 'n. ( bit[64] , [|'n|] ) -> (bit[8 * 'n]) effect { rmem } MEMr_reserved_strong_acquire + +function forall Nat 'n. (bit[8 * 'n]) effect { rmem, escape } mem_read( (bit[64]) addr, ([|'n|]) width, (bool) aq, (bool) rl, (bool) res) = +{ + if (aq | res) then + check_alignment(addr, width); + + switch (aq, rl, res) { + case (false, false, false) -> MEMr(addr, width) + case (true, false, false) -> MEMr_acquire(addr, width) + case (false, false, true) -> MEMr_reserved(addr, width) + case (true, false, true) -> MEMr_reserved_acquire(addr, width) + case (false, true, false) -> not_implemented("load.rl is not implemented") + case (true, true, false) -> MEMr_strong_acquire(addr, width) + case (false, true, true) -> not_implemented("lr.rl is not implemented") + case (true, true, true) -> MEMr_reserved_strong_acquire(addr, width) + } +} + +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_release +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_strong_release +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_release +val extern forall Nat 'n. ( bit[64] , [|'n|]) -> unit effect { eamem } MEMea_conditional_strong_release + +function forall Nat 'n. unit effect { eamem, escape } mem_write_ea( (bit[64]) addr , ([|'n|]) width, (bool) aq, (bool) rl, (bool) con) = +{ + if (rl | con) then + check_alignment(addr, width); + + switch (aq, rl, con) { + case (false, false, false) -> MEMea(addr, width) + case (false, true, false) -> MEMea_release(addr, width) + case (false, false, true) -> MEMea_conditional(addr, width) + case (false, true , true) -> MEMea_conditional_release(addr, width) + case (true, false, false) -> not_implemented("store.aq is not implemented") + case (true, true, false) -> MEMea_strong_release(addr, width) + case (true, false, true) -> not_implemented("sc.aq is not implemented") + case (true, true , true) -> MEMea_conditional_strong_release(addr, width) + } +} + +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_release +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_strong_release +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_release +val extern forall Nat 'n. ( bit[64] , [|'n|] , bit[8*'n]) -> unit effect { wmv } MEMval_conditional_strong_release + +function forall Nat 'n. unit effect { wmv, escape } mem_write_value( (bit[64]) addr , ([|'n|]) width , (bit[8*'n]) value, (bool) aq, (bool) rl, (bool) con) = +{ + if (rl | con) then + check_alignment(addr, width); + + switch (aq, rl, con) { + case (false, false, false) -> MEMval(addr, width, value) + case (false, true, false) -> MEMval_release(addr, width, value) + case (false, false, true) -> MEMval_conditional(addr, width, value) + case (false, true, true) -> MEMval_conditional_release(addr, width, value) + case (true, false, false) -> not_implemented("store.aq is not implemented") + case (true, true, false) -> MEMval_strong_release(addr, width, value) + case (true, false, true) -> not_implemented("sc.aq is not implemented") + case (true, true, true) -> MEMval_conditional_strong_release(addr, width, value) + } +} + +val extern unit -> bool effect {exmem} speculate_conditional_success + +val extern unit -> unit effect { barr } MEM_fence_rw_rw +val extern unit -> unit effect { barr } MEM_fence_r_rw +val extern unit -> unit effect { barr } MEM_fence_rw_w +val extern unit -> unit effect { barr } MEM_fence_w_w +val extern unit -> unit effect { barr } MEM_fence_i + +typedef uop = enumerate {LUI; AUIPC} (* upper immediate ops *) +typedef bop = enumerate {BEQ; BNE; BLT; BGE; BLTU; BGEU} (* branch ops *) +typedef iop = enumerate {ADDI; SLTI; SLTIU; XORI; ORI; ANDI} (* immediate ops *) +typedef sop = enumerate {SLLI; SRLI; SRAI} (* shift ops *) +typedef rop = enumerate {ADD; SUB; SLL; SLT; SLTU; XOR; SRL; SRA; OR; AND} (* reg-reg ops *) +typedef ropw = enumerate {ADDW; SUBW; SLLW; SRLW; SRAW} (* reg-reg 32-bit ops *) +typedef amoop = enumerate {AMOSWAP; AMOADD; AMOXOR; AMOAND; AMOOR; + AMOMIN; AMOMAX; AMOMINU; AMOMAXU} (* AMO ops *) + +typedef word_width = enumerate {BYTE; HALF; WORD; DOUBLE} + +(********************************************************************) + +(* Ideally these would be sail builtin *) +function (bit[64]) shift_right_arith64 ((bit[64]) v, (bit[6]) shift) = + let (bit[128]) v128 = EXTS(v) in + (v128 >> shift)[63..0] + +function (bit[32]) shift_right_arith32 ((bit[32]) v, (bit[5]) shift) = + let (bit[64]) v64 = EXTS(v) in + (v64 >> shift)[31..0] -- cgit v1.2.3 From 4c0d3acebf8fd37b3ef1481ac282f5c47464310f Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Wed, 27 Sep 2017 14:34:18 +0100 Subject: fixed the RISC-V Makefile --- risc-v/Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/risc-v/Makefile b/risc-v/Makefile index d027556e..8449c7c4 100644 --- a/risc-v/Makefile +++ b/risc-v/Makefile @@ -4,10 +4,11 @@ SOURCES:=riscv_types.sail riscv.sail ../etc/regfp.sail riscv_regfp.sail all: lem_ast shallow lem_ast: $(SOURCES) $(SAIL) - $(SAIL) -lem_ast $(SOURCES) + $(SAIL) -lem_ast $(SOURCES) -o riscv shallow: $(SOURCES) $(SAIL) - $(SAIL) -lem_lib Riscv_extras_embed -lem $(SOURCES) + $(SAIL) -lem_lib Riscv_extras_embed -lem $(SOURCES) -o riscv clean: - rm -f riscv.lem riscv_embed*.lem + rm -f riscv.lem riscv_embed*.lem riscv_toFromInterp.lem + rm -f riscv_type*.lem -- cgit v1.2.3 From fd06b634ae814a28644eabe93880eb7f4967a9c0 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 29 Sep 2017 15:40:56 +0100 Subject: x86: add bit set, reset, complement operations. --- x86/x64.sail | 73 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/x86/x64.sail b/x86/x64.sail index dfa92fd3..ae867747 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -130,6 +130,14 @@ typedef wsize = const union { unit Sz64; } +function ([|8:64|]) size_to_int((wsize) s) = + switch(s) { + case (Sz8(_)) -> 8 + case Sz16 -> 16 + case Sz32 -> 32 + case Sz64 -> 64 + } + typedef base = const union { unit NoBase; unit RipBase; @@ -154,12 +162,19 @@ typedef imm_rm = const union { qword Imm; } +typedef bit_offset = const union { + (rm, qword) Bit_rm_imm; + (rm, regn) Bit_rm_r; +} + typedef monop_name = enumerate { Dec; Inc; Not; Neg } typedef binop_name = enumerate { Add; Or; Adc; Sbb; And; Sub; Xor; Cmp; Rol; Ror; Rcl; Rcr; Shl; Shr; Test; Sar } +typedef bitop_name = enumerate { Bts; Btc; Btr } + function binop_name opc_to_binop_name ((bit[4]) opc) = switch opc { @@ -319,6 +334,24 @@ function qword get_ea_address ((ea) e) = function unit jump_to_ea ((ea) e) = RIP := call_dest_from_ea(e) +function (ea, nat) bit_offset_ea ((wsize) sz, (bit_offset) bo) = + let s = size_to_int (sz) in + switch bo { + case (Bit_rm_imm (r_m, imm)) -> + let base_ea = ea_rm (sz, r_m) in + switch (base_ea) { + case (Ea_r(_, r)) -> (Ea_r(sz, r), imm mod s) + case (Ea_m(_, a)) -> (Ea_m(sz, a), imm mod s) + } + case (Bit_rm_r (r_m, r)) -> + let base_ea = ea_rm (sz, r_m) in + let offset = REG[r] in + switch (base_ea) { + case (Ea_r(_, r)) -> (Ea_r(sz, r), offset mod s) + case (Ea_m(_, a)) -> (Ea_m(Sz64, a + (offset div 8)), offset mod 64) + } + } + (* EFLAG updates *) function bit byte_parity ((byte) b) = @@ -584,6 +617,25 @@ function clause execute (Binop (locked,bop,sz,ds)) = let (e, val_dst, val_src) = read_dest_src_ea (locked, sz, ds) in write_binop (locked, sz, bop, val_dst, val_src, e) +(* ========================================================================== + Bitop + ========================================================================== *) + +union ast member (bool,bitop_name,wsize,bit_offset) Bitop + +function clause execute (Bitop (locked,bop,sz,boffset)) = + let (base_ea, offset) = bit_offset_ea (sz, boffset) in { + word := EA(locked, base_ea); + bitval := word[offset]; + word[offset] := switch(bop) { + case Bts -> bitone + case Btc -> (~ (bitval)) + case Btr -> bitzero + }; + CF := bitval; + wEA(locked, base_ea) := word; + } + (* ========================================================================== CALL ========================================================================== *) @@ -1376,6 +1428,27 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := append(aRs, aR); } } + case(Bitop (locked, bitop, sz, bitoff)) -> { + let rk = if locked then Read_X86_locked else Read_plain in + let wk = if locked then Write_X86_locked else Write_plain in + let (ik', iRs, oRs, aRs) = switch(bitoff) { + case (Bit_rm_imm (r_m, imm)) -> + let (m, rs, ars) = regfp_rm(r_m) in + (if m then IK_mem_rmw(rk, wk) else IK_simple, + append(rs, ars), rs, ars) + case (Bit_rm_r (r_m, r)) -> + let rfp = RFull(GPRstr[r]) in + let (m, rs, ars) = regfp_rm(r_m) in + (if m then IK_mem_rmw(rk, wk) else IK_simple, + rfp::append(rs, ars), rs, + if m then (rfp::ars) else ars) (* in memory case r is a third input to address! *) + } in { + ik := ik'; + iR := append(iRs, iR); + oR := RFull("CF")::append(oRs, oR); + aR := append(aRs, aR); + } + } case(CALL (irm) ) -> let (m, rs, ars) = regfp_imm_rm (irm) in { iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); -- cgit v1.2.3 From efa98fb796fdab5486193f792adf999826fde7b4 Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Fri, 29 Sep 2017 17:02:38 +0100 Subject: fix deep_shallow_convert, stop using interp_interface.instruction for most things, SF and CP bugfixing --- src/gen_lib/deep_shallow_convert.lem | 29 ++++++++++++++++++-- src/lem_interp/interp.lem | 4 +-- src/lem_interp/interp_inter_imp.lem | 53 ++++++++++++++++++------------------ src/lem_interp/interp_interface.lem | 10 +++++-- src/lem_interp/sail_impl_base.lem | 2 -- 5 files changed, 62 insertions(+), 36 deletions(-) diff --git a/src/gen_lib/deep_shallow_convert.lem b/src/gen_lib/deep_shallow_convert.lem index 86365b78..5a0dd99e 100644 --- a/src/gen_lib/deep_shallow_convert.lem +++ b/src/gen_lib/deep_shallow_convert.lem @@ -15,10 +15,10 @@ let toInterValueBool = function | false -> Interp_ast.V_lit (L_aux (L_zero) Unknown) end let rec fromInterpValueBool v = match v with - | Interp_ast.V_lit (L_aux (L_true) _) -> true - | Interp_ast.V_lit (L_aux (L_false) _) -> false | Interp_ast.V_lit (L_aux (L_one) _) -> true + | Interp_ast.V_lit (L_aux (L_true) _) -> true | Interp_ast.V_lit (L_aux (L_zero) _) -> false + | Interp_ast.V_lit (L_aux (L_false) _) -> false | Interp_ast.V_tuple [v] -> fromInterpValueBool v | v -> failwith ("fromInterpValue bool: unexpected value. " ^ Interp.debug_print_value v) @@ -78,7 +78,7 @@ let rec fromInterpValueBitU v = match v with | Interp_ast.V_lit (L_aux (L_zero) _) -> B0 | Interp_ast.V_lit (L_aux (L_undef) _) -> BU | Interp_ast.V_lit (L_aux (L_true) _) -> B1 - | Interp_ast.V_lit (L_aux (L_false) _) -> B0 + | Interp_ast.V_lit (L_aux (L_false) _) -> B0 | Interp_ast.V_tuple [v] -> fromInterpValueBitU v | v -> failwith ("fromInterpValue bitU: unexpected value. " ^ Interp.debug_print_value v) @@ -506,18 +506,41 @@ instance (ToFromInterpValue barrier_kind) end +let trans_kindToInterpValue = function + | Transaction_start -> V_ctor (Id_aux (Id "Transaction_start") Unknown) (T_id "trans_kind") (C_Enum 0) (toInterpValue ()) + | Transaction_commit -> V_ctor (Id_aux (Id "Transaction_commit") Unknown) (T_id "trans_kind") (C_Enum 1) (toInterpValue ()) + | Transaction_abort -> V_ctor (Id_aux (Id "Transaction_abort") Unknown) (T_id "trans_kind") (C_Enum 2) (toInterpValue ()) + end +let rec trans_kindFromInterpValue v = match v with + | V_ctor (Id_aux (Id "Transaction_start") _) _ _ v -> Transaction_start + | V_ctor (Id_aux (Id "Transaction_commit") _) _ _ v -> Transaction_commit + | V_ctor (Id_aux (Id "Transaction_abort") _) _ _ v -> Transaction_abort + | V_tuple [v] -> trans_kindFromInterpValue v + | v -> failwith ("fromInterpValue trans_kind: unexpected value. " ^ + Interp.debug_print_value v) + end +instance (ToFromInterpValue trans_kind) + let toInterpValue = trans_kindToInterpValue + let fromInterpValue = trans_kindFromInterpValue +end + + let instruction_kindToInterpValue = function | IK_barrier v -> V_ctor (Id_aux (Id "IK_barrier") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v) | IK_mem_read v -> V_ctor (Id_aux (Id "IK_mem_read") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v) | IK_mem_write v -> V_ctor (Id_aux (Id "IK_mem_write") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v) + | IK_mem_rmw v -> V_ctor (Id_aux (Id "IK_mem_rmw") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v) | IK_cond_branch -> V_ctor (Id_aux (Id "IK_cond_branch") Unknown) (T_id "instruction_kind") C_Union (toInterpValue ()) + | IK_trans v -> V_ctor (Id_aux (Id "IK_trans") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v) | IK_simple -> V_ctor (Id_aux (Id "IK_simple") Unknown) (T_id "instruction_kind") C_Union (toInterpValue ()) end let rec instruction_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "IK_barrier") _) _ _ v -> IK_barrier (fromInterpValue v) | V_ctor (Id_aux (Id "IK_mem_read") _) _ _ v -> IK_mem_read (fromInterpValue v) | V_ctor (Id_aux (Id "IK_mem_write") _) _ _ v -> IK_mem_write (fromInterpValue v) + | V_ctor (Id_aux (Id "IK_mem_rmw") _) _ _ v -> IK_mem_rmw (fromInterpValue v) | V_ctor (Id_aux (Id "IK_cond_branch") _) _ _ v -> IK_cond_branch + | V_ctor (Id_aux (Id "IK_trans") _) _ _ v -> IK_trans (fromInterpValue v) | V_ctor (Id_aux (Id "IK_simple") _) _ _ v -> IK_simple | V_tuple [v] -> instruction_kindFromInterpValue v | v -> failwith ("fromInterpValue instruction_kind: unexpected value. " ^ diff --git a/src/lem_interp/interp.lem b/src/lem_interp/interp.lem index 58874fa6..f00458b7 100644 --- a/src/lem_interp/interp.lem +++ b/src/lem_interp/interp.lem @@ -1424,8 +1424,8 @@ let rec match_pattern t_level (P_aux p (_, annot)) value_whole = | V_ctor (Id_aux cid _) t ckind v -> if id = cid then (match (pats,detaint v) with - | ([],(V_lit (L_aux L_unit _))) -> (true,true,eenv) - | ([P_aux (P_lit (L_aux L_unit _)) _],(V_lit (L_aux L_unit _))) -> (true,true,eenv) + | ([],(V_lit (L_aux L_unit _))) -> (true,false,eenv) + | ([P_aux (P_lit (L_aux L_unit _)) _],(V_lit (L_aux L_unit _))) -> (true,false,eenv) | ([p],_) -> match_pattern t_level p v | _ -> (false,false,eenv) end) else (false,false,eenv) diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index 6ee13d60..52acae1e 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -469,7 +469,7 @@ let translate_address top_level end_flag thunk_name registers address = let (arg,_) = Interp.to_exp int_mode Interp.eenv intern_val in let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in let (address_error,events) = - interp_to_value_helper debug (Just (Opcode bytes)) Ivh_translate val_str ("",[]) internal_direction + interp_to_value_helper debug (Just (Opcode bytes)) Ivh_translate val_str (V_list []) internal_direction registers [] false (fun _ -> Interp.resume int_mode @@ -504,17 +504,16 @@ let intern_instruction direction (name,parms) = Interp_ast.V_ctor (Interp.id_of_string name) (T_id "ast") Interp_ast.C_Union (Interp_ast.V_tuple (List.map (value_of_instruction_param direction) parms)) -let instruction_analysis top_level end_flag thunk_name regn_to_reg_details registers instruction = +let instruction_analysis top_level end_flag thunk_name regn_to_reg_details registers (instruction : Interp_ast.value) = let (Context top_env direction _ _ _ _ _ _ _ _ _) = top_level in let (Interp.Env _ _ _ _ _ _ _ _ debug) = top_env in let mode = make_mode true false debug in let int_mode = mode.internal_mode in - let intern_val = intern_instruction direction instruction in - let val_str = Interp.string_of_value intern_val in - let (arg,_) = Interp.to_exp int_mode Interp.eenv intern_val in + let val_str = Interp.string_of_value instruction in + let (arg,_) = Interp.to_exp int_mode Interp.eenv instruction in let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in let (analysis_or_error,events) = - interp_to_value_helper debug Nothing Ivh_analysis val_str ("",[]) internal_direction + interp_to_value_helper debug Nothing Ivh_analysis val_str (V_list []) internal_direction registers [] false (fun _ -> Interp.resume int_mode @@ -680,7 +679,7 @@ let decode_to_instruction top_level registers value : instruction_or_decode_erro let (arg,_) = Interp.to_exp mode Interp.eenv intern_val in let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in let (instr_decoded_error,events) = - interp_to_value_helper debug (Just value) Ivh_decode val_str ("",[]) internal_direction registers [] false + interp_to_value_helper debug (Just value) Ivh_decode val_str (V_list []) internal_direction registers [] false (fun _ -> Interp.resume mode (Interp.Thunk_frame @@ -688,9 +687,9 @@ let decode_to_instruction top_level registers value : instruction_or_decode_erro top_env Interp.eenv (Interp.emem "decode top level") Interp.Top) Nothing) in match (instr_decoded_error) with | Ivh_value instr -> - let instr_external = interp_value_to_instr_external top_level instr in + (* let instr_external = interp_value_to_instr_external top_level instr in*) let (instr_decoded_error,events) = - interp_to_value_helper debug (Just value) Ivh_unsupported val_str instr_external internal_direction + interp_to_value_helper debug (Just value) Ivh_unsupported val_str instr (*instr_external*) internal_direction registers [] false (fun _ -> Interp.resume mode @@ -699,7 +698,7 @@ let decode_to_instruction top_level registers value : instruction_or_decode_erro (Interp_ast.Unknown, Nothing)) top_env Interp.eenv (Interp.emem "decode second top level") Interp.Top) Nothing) in match (instr_decoded_error) with - | Ivh_value _ -> IDE_instr instr_external instr + | Ivh_value _ -> IDE_instr instr (*instr_external*) | Ivh_value_after_exn v -> Assert_extra.failwith "supported_instructions called exit, so support will be needed for that now" | Ivh_error err -> IDE_decode_error err @@ -713,9 +712,9 @@ end let decode_to_istate (top_level:context) registers (value:opcode) : i_state_or_error = let (Context top_env _ _ _ _ _ _ _ _ _ _) = top_level in match decode_to_instruction top_level registers value with - | IDE_instr instr instrv -> + | IDE_instr instr -> let mode = make_interpreter_mode true false in - let (arg,_) = Interp.to_exp mode Interp.eenv instrv in + let (arg,_) = Interp.to_exp mode Interp.eenv instr in Instr instr (IState (Interp.Thunk_frame (E_aux (E_app (Id_aux (Id "execute") Interp_ast.Unknown) [arg]) (Interp_ast.Unknown,Nothing)) @@ -750,11 +749,11 @@ let instr_external_to_interp_value top_level instr = Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id name) Interp_ast.Unknown) (T_id "ast") Interp_ast.C_Union parmsV -val instruction_to_istate : context -> instruction -> instruction_state -let instruction_to_istate (top_level:context) (((name, parms) as instr):instruction) : instruction_state = +val instruction_to_istate : context -> Interp_ast.value -> instruction_state +let instruction_to_istate (top_level:context) (instr:Interp_ast.value) : instruction_state = let mode = make_interpreter_mode true false in let (Context top_env _ _ _ _ _ _ _ _ _ _) = top_level in - let ast_node = fst (Interp.to_exp mode Interp.eenv (instr_external_to_interp_value top_level instr)) in + let ast_node = fst (Interp.to_exp mode Interp.eenv instr) in (IState (Interp.Thunk_frame (E_aux (E_app (Id_aux (Id "execute") Interp_ast.Unknown) [ast_node]) @@ -1092,7 +1091,7 @@ and state_to_outcome_s pp_instruction_state mode state = (fun env -> interp_exhaustive mode.internal_mode.Interp.debug (Just env) state)) ) -val initial_outcome_s_of_instruction : (instruction_state -> unit -> (string * string)) -> context -> interp_mode -> instruction -> Sail_impl_base.outcome_s unit +val initial_outcome_s_of_instruction : (instruction_state -> unit -> (string * string)) -> context -> interp_mode -> Interp_ast.value -> Sail_impl_base.outcome_s unit let initial_outcome_s_of_instruction pp_instruction_state context mode instruction = let state = instruction_to_istate context instruction in state_to_outcome_s pp_instruction_state mode state @@ -1222,14 +1221,15 @@ let nia_address_of_event nia_reg (event: event) : maybe (maybe address) = | _ -> Nothing end -let nias_of_instruction +let nias_of_instruction + top_level thread_ism (nia_address: list (maybe address)) (* Nothing for unknown/undef*) (regs_in: list reg_name) - (instruction: instruction) + (instruction: Interp_ast.value) : list nia = - let (instruction_name, instruction_fields) = instruction in + let (instruction_name, instruction_fields) = interp_value_to_instr_external top_level instruction in let unknown_nia_address = List.elem Nothing nia_address in @@ -1390,7 +1390,9 @@ let nias_of_instruction | (s1, s2) -> failwith ("unexpected (thread_ism, instruction_name): (" ^ s1 ^ ", " ^ s2 ^ ")") end + let interp_instruction_analysis + top_level (interp_exhaustive : ((list (reg_name * register_value)) -> list event)) instruction nia_reg ism environment = @@ -1403,7 +1405,7 @@ let interp_instruction_analysis let nia_address = List.mapMaybe (nia_address_of_event nia_reg) es in - let nias = nias_of_instruction ism nia_address regs_in instruction in + let nias = nias_of_instruction top_level ism nia_address regs_in instruction in let dia = DIA_none in (* FIX THIS! *) @@ -1478,29 +1480,28 @@ val print_and_fail_of_inequal : forall 'a. Show 'a => (instruction -> string) -> (string * 'a) -> (string * 'a) -> unit let print_and_fail_if_inequal - (print_endline,pp_instruction,instruction) + (print_endline,instruction) (name1,xs1) (name2,xs2) = if xs1 = xs2 then () else let () = print_endline (name1^": "^show xs1) in let () = print_endline (name2^": "^show xs2) in - failwith (name1^" and "^ name2^" inequal for instruction " ^ pp_instruction instruction) + failwith (name1^" and "^ name2^" inequal for instruction: \n" ^ Interp.string_of_value instruction) let interp_compare_analyses print_endline - pp_instruction (non_pseudo_registers : set reg_name -> set reg_name) context endianness interp_exhaustive - instruction + (instruction : Interp_ast.value) nia_reg ism environment analysis_function reg_info = let (regs_in1,regs_out1,regs_feeding_address1,nias1,dia1,inst_kind1) = - interp_instruction_analysis interp_exhaustive instruction nia_reg ism + interp_instruction_analysis context interp_exhaustive instruction nia_reg ism environment in let (regs_in1S,regs_out1S,regs_feeding_address1S,nias1S) = (Set.fromList regs_in1, @@ -1525,7 +1526,7 @@ let interp_compare_analyses non_pseudo_registers regs_out2S, non_pseudo_registers regs_feeding_address2S) in - let aux = (print_endline,pp_instruction,instruction) in + let aux = (print_endline,instruction) in let () = (print_and_fail_if_inequal aux) ("regs_in exhaustive",regs_in1S) ("regs_in hand",regs_in2S) in diff --git a/src/lem_interp/interp_interface.lem b/src/lem_interp/interp_interface.lem index dcc9f537..07d9e2b3 100644 --- a/src/lem_interp/interp_interface.lem +++ b/src/lem_interp/interp_interface.lem @@ -104,6 +104,10 @@ end and the potential static effects from the funcl clause for this instruction Follows the form of the instruction in instruction_extractor, but populates the parameters with actual values *) + + +type instruction_field_value = list bit + type instruction = (string * list (string * instr_parm_typ * instruction_field_value)) let {coq} instructionEqual i1 i2 = match (i1,i2) with @@ -117,7 +121,7 @@ let inline ~{coq} instructionInequal = unsafe_structural_inequality type v_kind = Bitv | Bytev type decode_error = - | Unsupported_instruction_error of instruction + | Unsupported_instruction_error of Interp_ast.value | Not_an_instruction_error of opcode | Internal_error of string @@ -264,12 +268,12 @@ val initial_instruction_state : context -> string -> list register_value -> inst (* string is a function name, list of value are the parameters to that function *) type instruction_or_decode_error = - | IDE_instr of instruction * Interp_ast.value + | IDE_instr of Interp_ast.value | IDE_decode_error of decode_error (** propose to remove the following type and use the above instead *) type i_state_or_error = - | Instr of instruction * instruction_state + | Instr of Interp_ast.value * instruction_state | Decode_error of decode_error diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 6957bb95..4f07f574 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -106,8 +106,6 @@ type register_value = <| type byte_lifted = Byte_lifted of list bit_lifted (* of length 8 *) (*MSB first everywhere*) -type instruction_field_value = list bit - type byte = Byte of list bit (* of length 8 *) (*MSB first everywhere*) type address_lifted = Address_lifted of list byte_lifted (* of length 8 for 64bit machines*) * maybe integer -- cgit v1.2.3 From 9f58a1bbaadd0a679413a8cb424acfb6255f8eca Mon Sep 17 00:00:00 2001 From: Christopher Pulte Date: Fri, 29 Sep 2017 17:55:48 +0100 Subject: fix those build errors --- src/lem_interp/run_with_elf.ml | 10 +++++++--- src/lem_interp/run_with_elf_cheri.ml | 6 ++++-- src/lem_interp/run_with_elf_cheri128.ml | 6 ++++-- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/lem_interp/run_with_elf.ml b/src/lem_interp/run_with_elf.ml index 2a1783db..98b98a03 100644 --- a/src/lem_interp/run_with_elf.ml +++ b/src/lem_interp/run_with_elf.ml @@ -1198,12 +1198,16 @@ let rec fde_loop count context model mode track_dependencies addr_trans = let opcode = Opcode (get_opcode pc) in let (instruction,istate) = match Interp_inter_imp.decode_to_istate context None opcode with | Instr(instruction,istate) -> - interactf "\n**** Running: %s ****\n" (Printing_functions.instruction_to_string instruction); + let instruction = interp_value_to_instr_external context instruction in + interactf "\n**** Running: %s ****\n" + (Printing_functions.instruction_to_string instruction); (instruction,istate) | Decode_error d -> (match d with - | Interp_interface.Unsupported_instruction_error instr -> - errorf "\n**** Encountered unsupported instruction %s ****\n" (Printing_functions.instruction_to_string instr) + | Interp_interface.Unsupported_instruction_error instruction -> + let instruction = interp_value_to_instr_external context instruction in + errorf "\n**** Encountered unsupported instruction %s ****\n" + (Printing_functions.instruction_to_string instruction) | Interp_interface.Not_an_instruction_error op -> (match op with | Opcode bytes -> diff --git a/src/lem_interp/run_with_elf_cheri.ml b/src/lem_interp/run_with_elf_cheri.ml index e773bf5b..b879f702 100644 --- a/src/lem_interp/run_with_elf_cheri.ml +++ b/src/lem_interp/run_with_elf_cheri.ml @@ -1290,12 +1290,14 @@ let rec fde_loop count context model mode track_dependencies addr_trans = let opcode = Opcode (get_opcode pc) in let (instruction,istate) = match Interp_inter_imp.decode_to_istate context None opcode with | Instr(instruction,istate) -> + let instruction = interp_value_to_instr_external context instruction in interactf "\n**** Running: %s ****\n" (Printing_functions.instruction_to_string instruction); (instruction,istate) | Decode_error d -> (match d with - | Interp_interface.Unsupported_instruction_error instr -> - errorf "\n**** Encountered unsupported instruction %s ****\n" (Printing_functions.instruction_to_string instr) + | Interp_interface.Unsupported_instruction_error instruction -> + let instruction = interp_value_to_instr_external context instruction in + errorf "\n**** Encountered unsupported instruction %s ****\n" (Printing_functions.instruction_to_string instruction) | Interp_interface.Not_an_instruction_error op -> (match op with | Opcode bytes -> diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml index cd2e7312..3ad507bc 100644 --- a/src/lem_interp/run_with_elf_cheri128.ml +++ b/src/lem_interp/run_with_elf_cheri128.ml @@ -1290,12 +1290,14 @@ let rec fde_loop count context model mode track_dependencies addr_trans = let opcode = Opcode (get_opcode pc) in let (instruction,istate) = match Interp_inter_imp.decode_to_istate context None opcode with | Instr(instruction,istate) -> + let instruction = interp_value_to_instr_external context instruction in interactf "\n**** Running: %s ****\n" (Printing_functions.instruction_to_string instruction); (instruction,istate) | Decode_error d -> (match d with - | Interp_interface.Unsupported_instruction_error instr -> - errorf "\n**** Encountered unsupported instruction %s ****\n" (Printing_functions.instruction_to_string instr) + | Interp_interface.Unsupported_instruction_error instruction -> + let instruction = interp_value_to_instr_external context instruction in + errorf "\n**** Encountered unsupported instruction %s ****\n" (Printing_functions.instruction_to_string instruction) | Interp_interface.Not_an_instruction_error op -> (match op with | Opcode bytes -> -- cgit v1.2.3 From fcf8270b4f46b4cd92534807292694bfd6d14457 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Sun, 1 Oct 2017 12:02:07 +0100 Subject: fixed JALR: do the register write first to allow po-later reads --- risc-v/riscv.sail | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 8658ae96..f36dba57 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -24,11 +24,12 @@ union ast member ((bit[21]), regno) JAL function clause decode ((bit[20]) imm : (regno) rd : 0b1101111) = Some (JAL(imm[19] : imm[7..0] : imm[8] : imm[18..13] : imm[12..9] : 0b0, rd)) -function clause execute (JAL(imm, rd)) = - let (bit[64]) offset = EXTS(imm) in { - nextPC := PC + offset; - wGPR(rd, PC + 4); - } +function clause execute (JAL(imm, rd)) = { + (bit[64]) pc := PC; + wGPR(rd, pc + 4); + (bit[64]) offset := EXTS(imm); + nextPC := pc + offset; +} (********************************************************************) union ast member((bit[12]), regno, regno) JALR @@ -36,11 +37,12 @@ union ast member((bit[12]), regno, regno) JALR function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b1100111) = Some(JALR(imm, rs1, rd)) -function clause execute (JALR(imm, rs1, rd)) = - let (bit[64]) newPC = rGPR(rs1) + EXTS(imm) in { - nextPC := newPC[63..1] : 0b0; - wGPR(rd, PC + 4); - } +function clause execute (JALR(imm, rs1, rd)) = { + (* write rd before anything else to prevent unintended strength *) + wGPR(rd, PC + 4); + (bit[64]) newPC := rGPR(rs1) + EXTS(imm); + nextPC := newPC[63..1] : 0b0; +} (********************************************************************) union ast member ((bit[13]), regno, regno, bop) BTYPE -- cgit v1.2.3 From 4d3e8058659d32e0b2668950fb1bb9d2a80cd7a1 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 2 Oct 2017 15:49:35 +0100 Subject: cheri: fix swapped cmovz and cmovn. --- cheri/cheri_insts.sail | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index 8b5d9dd0..caa87e55 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -468,9 +468,9 @@ function clause execute (CClearTag(cd, cb)) = } union ast member (regno,regno,regno,bool) CMOVX -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011100) = Some(CMOVX(cd, cb, rt, false)) (* CMOVN *) -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011011) = Some(CMOVX(cd, cb, rt, true)) (* CMOVZ *) -function clause execute (CMOVX(cd, cb, rt, ismovz)) = +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011100) = Some(CMOVX(cd, cb, rt, true)) (* CMOVN *) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011011) = Some(CMOVX(cd, cb, rt, false)) (* CMOVZ *) +function clause execute (CMOVX(cd, cb, rt, ismovn)) = { (* START_CMOVX *) checkCP2usable(); @@ -478,7 +478,7 @@ function clause execute (CMOVX(cd, cb, rt, ismovz)) = raise_c2_exception(CapEx_AccessSystemRegsViolation, cd) else if (register_inaccessible(cb)) then raise_c2_exception(CapEx_AccessSystemRegsViolation, cb) - else if ((rGPR(rt) == 0) ^ ismovz) then + else if ((rGPR(rt) == 0) ^ ismovn) then writeCapReg(cd) := readCapReg(cb); (* END_CMOVX *) } -- cgit v1.2.3 From dd733219d795bd59516c54717e798ced9c378d33 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 6 Oct 2017 14:47:23 +0100 Subject: move nias_of_instruction into RMEM so that it can use shallow embedding ast and not obsolete interp_interface one. --- src/lem_interp/interp_inter_imp.lem | 180 ++---------------------------------- 1 file changed, 7 insertions(+), 173 deletions(-) diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index 52acae1e..c0d2ea4a 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -1221,180 +1221,13 @@ let nia_address_of_event nia_reg (event: event) : maybe (maybe address) = | _ -> Nothing end -let nias_of_instruction - top_level - thread_ism - (nia_address: list (maybe address)) (* Nothing for unknown/undef*) - (regs_in: list reg_name) - (instruction: Interp_ast.value) - : list nia - = - let (instruction_name, instruction_fields) = interp_value_to_instr_external top_level instruction in - - let unknown_nia_address = List.elem Nothing nia_address in - - let nias = [NIA_concrete_address addr | forall (addr MEM (List.mapMaybe id nia_address)) | true] in - - (* it's a fact of the Power2.06B instruction pseudocode that in the B and Bc - cases there should be no Unknown values in nia_values, while in the Bclr - and Bcctr cases nia_values will just be Unknown and the semantics should - match the comments in the machineDefTypes definition of nia *) - (* All our other analysis is on the pseudocode directly, which is arguably - pleasingly robust. We could replace the nias pattern match on - instruction_name with something in that style if the exhaustive interpreter - announced register dependencies to register writes (easy) and if it could - check the form of the register writes to LR and CTR matches the - machineDefTypes nia definition *) - match (thread_ism, instruction_name) with - | ("PPCGEN_ism", "B") -> - let () = ensure (not unknown_nia_address) - "unexpected unknown/undefined address in nia_values 1" in - nias - | ("PPCGEN_ism", "Bc") -> - let () = ensure (not unknown_nia_address) - "unexpected unknown/undefined address in nia_values 2" in - NIA_successor :: nias - | ("PPCGEN_ism", "Bclr") -> [ NIA_successor; NIA_LR ] - | ("PPCGEN_ism", "Bcctr") -> [ NIA_successor; NIA_CTR ] - | ("PPCGEN_ism", "Sc") -> - let () = ensure (not unknown_nia_address) - "unexpected unknown/undefined address in nia_values 3" in - match instruction_fields with - | [(_, _, lev)] -> - (* LEV field is 7 bits long, pad it with false at beginning *) - if lev = [Bitc_zero;Bitc_one;Bitc_one;Bitc_one;Bitc_one;Bitc_one;Bitc_one] - (* (Interp_inter_imp.integer_of_byte_list (Interp_inter_imp.to_bytes (false :: bl))) = 63 *) - then [] - else [NIA_successor] - | _ -> [ NIA_successor ] - end - | ("PPCGEN_ism", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"PPCGEN_ism\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - (* AARch64 label branch (i.e. address must be known) although - these instructions take the address as an offset from PC, in here - we see the absolute address as it was extracted from the micro ops - just before write to PC *) - | ("AArch64HandSail", "BranchImmediate") -> nias - | ("AArch64HandSail", "BranchConditional") -> NIA_successor :: nias - | ("AArch64HandSail", "CompareAndBranch") -> NIA_successor :: nias - | ("AArch64HandSail", "TestBitAndBranch") -> NIA_successor :: nias - - (* AArch64 calculated address branch *) - | ("AArch64HandSail", "BranchRegister") -> - (* do some parsing of the ast fields to figure out which register holds - the branching address i.e. find n in "BR ". The ast constructor - from armV8.sail: (reg_index,BranchType) BranchRegister; *) - let n_integer = - match instruction_fields with - | [(_, _, n); _] -> integer_of_bit_list n - | _ -> fail - end - in - let () = ensure (0 <= n_integer && n_integer <= 31) - "expected register number from 0 to 31" - in - if n_integer = 31 then - nias (* BR XZR *) - else - (* look for Xn (which we actually call Rn) in regs_in *) - let n_reg = "R" ^ (String_extra.stringFromInteger n_integer) in - [NIA_register r | forall (r MEM regs_in) - | match r with - | (Reg name _ _ _) -> name = n_reg - | _ -> false - end] - | ("AArch64HandSail", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"AArch64HandSail\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - (** hacky cut-and-paste for AArch64Gen, duplicating code just to see if this suffices *) - - | ("AArch64GenSail", "BranchImmediate") -> nias - | ("AArch64GenSail", "BranchConditional") -> NIA_successor :: nias - | ("AArch64GenSail", "CompareAndBranch") -> NIA_successor :: nias - | ("AArch64GenSail", "TestBitAndBranch") -> NIA_successor :: nias - - (* AArch64 calculated address branch *) - | ("AArch64GenSail", "branch_unconditional_register") -> - (* do some parsing of the ast fields to figure out which register holds - the branching address i.e. find n in "BR ". The ast constructor - from armV8.sail: (reg_index,BranchType) BranchRegister; *) - let n_integer = - match instruction_fields with - | [(_, _, n); _] -> integer_of_bit_list n - | _ -> fail - end - in - let () = ensure (0 <= n_integer && n_integer <= 31) - "expected register number from 0 to 31" - in - if n_integer = 31 then - nias (* BR XZR *) - else - (* look for Xn (which we actually call Rn) in regs_in *) - let n_reg = "R" ^ (String_extra.stringFromInteger n_integer) in - [NIA_register r | forall (r MEM regs_in) - | match r with - | (Reg name _ _ _) -> name = n_reg - | _ -> false - end] - | ("AArch64GenSail", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"AArch64GenSail\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - (** end of hacky *) - - | ("AArch64LitmusSail", "CtrlDep") -> NIA_successor :: nias - | ("AArch64LitmusSail", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"AArch64LitmusSail\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - - | ("MIPS_ism", "B") -> fail - | ("MIPS_ism", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"MIPS_ism\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - | ("RISCV_ism", "JAL") -> nias - | ("RISCV_ism", "JALR") -> - let rs1_integer = - match instruction_fields with - | [_; (_, _, rs1); _] -> integer_of_bit_list rs1 - | _ -> fail - end - in - let () = ensure (0 <= rs1_integer && rs1_integer <= 31) - "expected register number from 0 to 31" - in - if rs1_integer = 0 then nias - else - let rs1_reg = "x" ^ (String_extra.stringFromInteger rs1_integer) in - [NIA_register r | forall (r MEM regs_in) - | match r with - | (Reg name _ _ _) -> name = rs1_reg - | _ -> false - end] - | ("RISCV_ism", "BTYPE") -> NIA_successor :: nias - | ("RISCV_ism", s) -> - let () = ensure (not unknown_nia_address) - ("unexpected unknown/undefined address in nia_values 4 (\"RISCV_ism\", \"" ^ s ^ "\")") in - [ NIA_successor ] - - | (s1, s2) -> failwith ("unexpected (thread_ism, instruction_name): (" ^ s1 ^ ", " ^ s2 ^ ")") - end - - let interp_instruction_analysis top_level (interp_exhaustive : ((list (reg_name * register_value)) -> list event)) - instruction nia_reg ism environment = + instruction + nia_reg + (nias_function : (list (maybe address) -> list reg_name -> list nia)) + ism environment = let es = interp_exhaustive environment in @@ -1405,7 +1238,7 @@ let interp_instruction_analysis let nia_address = List.mapMaybe (nia_address_of_event nia_reg) es in - let nias = nias_of_instruction top_level ism nia_address regs_in instruction in + let nias = nias_function nia_address regs_in in let dia = DIA_none in (* FIX THIS! *) @@ -1496,12 +1329,13 @@ let interp_compare_analyses interp_exhaustive (instruction : Interp_ast.value) nia_reg + (nias_function : (list (maybe address) -> list reg_name -> list nia)) ism environment analysis_function reg_info = let (regs_in1,regs_out1,regs_feeding_address1,nias1,dia1,inst_kind1) = - interp_instruction_analysis context interp_exhaustive instruction nia_reg ism + interp_instruction_analysis context interp_exhaustive instruction nia_reg nias_function ism environment in let (regs_in1S,regs_out1S,regs_feeding_address1S,nias1S) = (Set.fromList regs_in1, -- cgit v1.2.3 From 100d8fd2fd591b2dcbf550e8d3b8cf476d17516f Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 9 Oct 2017 14:49:09 +0100 Subject: X86: Fix bug in register footprint caused by imperative variable update with wrong variable name (iK vs. ik). Spotted via compare_analyses. --- x86/x64.sail | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/x86/x64.sail b/x86/x64.sail index ae867747..16ba0f41 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -1417,7 +1417,6 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( ik := IK_simple; Nias := [|| NIAFP_successor ||]; Dia := DIAFP_none; - x := (qword) RIP; switch instr { case(Binop (locked, binop, sz, ds)) -> { let flags = regfp_binop_flags (binop) in @@ -1451,7 +1450,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( } case(CALL (irm) ) -> let (m, rs, ars) = regfp_imm_rm (irm) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + ik := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); iR := RFull("RIP") :: RFull("RSP") :: rs; oR := RFull("RSP") :: oR; aR := ars; @@ -1470,14 +1469,14 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( let rk = if locked then Read_X86_locked else Read_plain in let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, aRs) = regfp_rm (r_m) in { - iK := if m then IK_mem_rmw (rk, wk) else IK_simple; + ik := if m then IK_mem_rmw (rk, wk) else IK_simple; iR := RFull("RAX") :: RFull(GPRstr[reg]) :: append(rs, aRs); oR := RFull("RAX") :: append(regfp_binop_flags(Cmp), rs); aR := aRs; } case(DIV (sz, r_m) ) -> let (m, rs, ars) = regfp_rm (r_m) in { - iK := if m then IK_mem_read (Read_plain) else IK_simple; + ik := if m then IK_mem_read (Read_plain) else IK_simple; iR := RFull("RAX") :: RFull("RDX") :: append(rs, ars); oR := RFull("RAX") :: RFull("RDX") :: append(oR, all_flags); aR := ars; @@ -1485,13 +1484,13 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( case(HLT ) -> () case(Jcc (c, imm64) ) -> let flags = regfp_cond(c) in { - iK := IK_cond_branch; + ik := IK_cond_branch; iR := RFull("RIP") :: flags; Nias := NIAFP_concrete_address(RIP + imm64) :: Nias; } case(JMP (r_m) ) -> let (m, rs, ars) = regfp_rm (r_m) in { - iK := if m then IK_mem_read(Read_plain) else IK_simple; + ik := if m then IK_mem_read(Read_plain) else IK_simple; iR := RFull("RIP")::append(rs, ars); aR := ars; (* XXX register name is not important here -- just indicates we don't know the destination yet. *) @@ -1504,54 +1503,55 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( aR := ars; } case(LEAVE ) -> { - iK := IK_mem_read(Read_plain); + ik := IK_mem_read(Read_plain); iR := RFull("RBP") :: iR; oR := RFull("RBP") :: RFull("RSP") :: oR; aR := RFull("RBP") :: aR; } case(LOOP (c, imm64) ) -> let flags = regfp_cond(c) in { - iK := IK_cond_branch; + ik := IK_cond_branch; iR := RFull("RCX") :: flags; oR := RFull("RCX") :: oR; Nias := NIAFP_concrete_address(RIP + imm64) :: Nias; } - case(MFENCE ) -> iK := IK_barrier (Barrier_x86_MFENCE) + case(MFENCE ) -> + ik := IK_barrier (Barrier_x86_MFENCE) case(Monop (locked, monop, sz, r_m) ) -> let rk = if locked then Read_X86_locked else Read_plain in let wk = if locked then Write_X86_locked else Write_plain in let (m, rds, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(rk, wk) else IK_simple; + ik := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := append(rds, ars); oR := append(all_flags_but_cf_of, rds); (* XXX fix flags *) aR := ars; } case(MOV (c, sz, ds) ) -> - let (ik, irs, ors, ars) = regfp_dest_src (ds) in + let (ik', irs, ors, ars) = regfp_dest_src (ds) in let flags = regfp_cond(c) in { - iK := ik; + ik := ik'; iR := append(irs, flags); oR := ors; aR := ars; } case(MOVSX (sz1, ds, sz2) ) -> - let (ik, irs, ors, ars) = regfp_dest_src (ds) in { - iK := ik; + let (ik', irs, ors, ars) = regfp_dest_src (ds) in { + ik := ik'; iR := irs; oR := ors; aR := ars; } case(MOVZX (sz1, ds, sz2) ) -> - let (ik, irs, ors, ars) = regfp_dest_src (ds) in { - iK := ik; + let (ik', irs, ors, ars) = regfp_dest_src (ds) in { + ik := ik'; iR := irs; oR := ors; aR := ars; } case(MUL (sz, r_m) ) -> let (m, rs, ars) = regfp_rm (r_m) in { - iK := if m then IK_mem_read (Read_plain) else IK_simple; + ik := if m then IK_mem_read (Read_plain) else IK_simple; iR := RFull("RAX") :: append(rs, ars); oR := RFull("RAX") :: RFull("RDX") :: append(oR, all_flags); aR := ars; @@ -1559,20 +1559,20 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( case(NOP (_) ) -> () case(POP (r_m) ) -> let (m, rd, ars) = regfp_rm (r_m) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + ik := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); iR := RFull("RSP") :: ars; oR := RFull("RSP") :: rd; aR := RFull("RSP") :: ars; } case(PUSH (irm) ) -> let (m, rs, ars) = regfp_imm_rm (irm) in { - iK := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); + ik := if m then IK_mem_rmw(Read_plain, Write_plain) else IK_mem_write(Write_plain); iR := RFull("RSP") :: append(rs, ars); oR := RFull("RSP") :: oR; aR := RFull("RSP") :: ars; } case(RET (imm64) ) -> { - iK := IK_mem_read(Read_plain); + ik := IK_mem_read(Read_plain); iR := RFull("RSP") :: iR; oR := RFull("RSP") :: oR; aR := RFull("RSP") :: aR; @@ -1582,7 +1582,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( case(SET (c, b, r_m) ) -> let flags = regfp_cond(c) in let (m, rs, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_write(Write_plain) else IK_simple; + ik := if m then IK_mem_write(Write_plain) else IK_simple; iR := append(flags, ars); oR := rs; aR := ars; @@ -1592,7 +1592,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( let rk = if locked then Read_X86_locked else Read_plain in let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(rk, wk) else IK_simple; + ik := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := RFull(GPRstr[reg]) :: append(rs, ars); oR := RFull(GPRstr[reg]) :: append(rs, all_flags); aR := ars; @@ -1601,7 +1601,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( let rk = if locked then Read_X86_locked else Read_plain in let wk = if locked then Write_X86_locked else Write_plain in let (m, rs, ars) = regfp_rm(r_m) in { - iK := if m then IK_mem_rmw(rk, wk) else IK_simple; + ik := if m then IK_mem_rmw(rk, wk) else IK_simple; iR := RFull(GPRstr[reg]) :: append(rs, ars); oR := RFull(GPRstr[reg]) :: rs; aR := ars; -- cgit v1.2.3 From 97b808681f951a962cdb3c087d79aee5556a7089 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 9 Oct 2017 16:14:08 +0100 Subject: add translation of IK_mem_rmw interp_inter_imp. TODO: could we get rid of this and use shallow embedding conversion? --- src/lem_interp/interp_inter_imp.lem | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index c0d2ea4a..1c993ba0 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -571,6 +571,21 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis | Interp_ast.V_ctor (Id_aux (Id "NIAFP_register") _) _ _ reg -> NIA_register (reg_to_reg_name reg) | _ -> failwith "Register footprint analysis did not return nia of expected type" end in + let readk_to_readk = function + | "Read_plain" -> Read_plain + | "Read_reserve" -> Read_reserve + | "Read_acquire" -> Read_acquire + | "Read_exclusive" -> Read_exclusive + | "Read_exclusive_acquire" -> Read_exclusive_acquire + | "Read_stream" -> Read_stream + | r -> failwith ("unknown read kind: " ^ r) end in + let writek_to_writek = function + | "Write_plain" -> Write_plain + | "Write_conditional" -> Write_conditional + | "Write_release" -> Write_release + | "Write_exclusive" -> Write_exclusive + | "Write_exclusive_release" -> Write_exclusive_release + | w -> failwith ("unknown write kind: " ^ w) end in let ik_to_ik = function | Interp_ast.V_ctor (Id_aux (Id "IK_barrier") _) _ _ (Interp_ast.V_ctor (Id_aux (Id b) _) _ _ _) -> @@ -591,23 +606,14 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis end) | Interp_ast.V_ctor (Id_aux (Id "IK_mem_read") _) _ _ (Interp_ast.V_ctor (Id_aux (Id r) _) _ _ _) -> - IK_mem_read (match r with - | "Read_plain" -> Read_plain - | "Read_reserve" -> Read_reserve - | "Read_acquire" -> Read_acquire - | "Read_exclusive" -> Read_exclusive - | "Read_exclusive_acquire" -> Read_exclusive_acquire - | "Read_stream" -> Read_stream - end) + IK_mem_read(readk_to_readk r) | Interp_ast.V_ctor (Id_aux (Id "IK_mem_write") _) _ _ (Interp_ast.V_ctor (Id_aux (Id w) _) _ _ _) -> - IK_mem_write (match w with - | "Write_plain" -> Write_plain - | "Write_conditional" -> Write_conditional - | "Write_release" -> Write_release - | "Write_exclusive" -> Write_exclusive - | "Write_exclusive_release" -> Write_exclusive_release - end) + IK_mem_write(writek_to_writek w) + | Interp_ast.V_ctor (Id_aux (Id "IK_mem_rmw") _) _ _ + (Interp_ast.V_tuple [(Interp_ast.V_ctor (Id_aux (Id readk) _) _ _ _) ; + (Interp_ast.V_ctor (Id_aux (Id writek) _) _ _ _)]) -> + IK_mem_rmw(readk_to_readk readk, writek_to_writek writek) | Interp_ast.V_ctor (Id_aux (Id "IK_cond_branch") _) _ _ _ -> IK_cond_branch | Interp_ast.V_ctor (Id_aux (Id "IK_simple") _) _ _ _ -> -- cgit v1.2.3 From 93dfd61038583eac852e5e3ea66c46817a610bbe Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 9 Oct 2017 16:38:03 +0100 Subject: add translations for missing read/write kinds. --- src/lem_interp/interp_inter_imp.lem | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem index 1c993ba0..8199f271 100644 --- a/src/lem_interp/interp_inter_imp.lem +++ b/src/lem_interp/interp_inter_imp.lem @@ -578,6 +578,12 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis | "Read_exclusive" -> Read_exclusive | "Read_exclusive_acquire" -> Read_exclusive_acquire | "Read_stream" -> Read_stream + | "Read_RISCV_acquire" -> Read_RISCV_acquire + | "Read_RISCV_strong_acquire" -> Read_RISCV_strong_acquire + | "Read_RISCV_reserved" -> Read_RISCV_reserved + | "Read_RISCV_reserved_acquire" -> Read_RISCV_reserved_acquire + | "Read_RISCV_reserved_strong_acquire" -> Read_RISCV_reserved_strong_acquire + | "Read_X86_locked" -> Read_X86_locked | r -> failwith ("unknown read kind: " ^ r) end in let writek_to_writek = function | "Write_plain" -> Write_plain @@ -585,6 +591,12 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis | "Write_release" -> Write_release | "Write_exclusive" -> Write_exclusive | "Write_exclusive_release" -> Write_exclusive_release + | "Write_RISCV_release" -> Write_RISCV_release + | "Write_RISCV_strong_release" -> Write_RISCV_strong_release + | "Write_RISCV_conditional" -> Write_RISCV_conditional + | "Write_RISCV_conditional_release" -> Write_RISCV_conditional_release + | "Write_RISCV_conditional_strong_release" -> Write_RISCV_conditional_strong_release + | "Write_X86_locked" -> Write_X86_locked | w -> failwith ("unknown write kind: " ^ w) end in let ik_to_ik = function | Interp_ast.V_ctor (Id_aux (Id "IK_barrier") _) _ _ -- cgit v1.2.3 From 64468eda2bc40c874cddd4a6d9972af5ec224dc2 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Thu, 12 Oct 2017 17:14:40 +0100 Subject: Work around warning in ocaml shallow embedding of mips caused by buggy code generation for dubious casting enumeration to int. --- mips/mips_prelude.sail | 7 +++++++ mips/mips_tlb.sail | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/mips/mips_prelude.sail b/mips/mips_prelude.sail index a4098486..382e4d7f 100644 --- a/mips/mips_prelude.sail +++ b/mips/mips_prelude.sail @@ -472,6 +472,13 @@ function AccessLevel getAccessLevel() = case _ -> User (* behaviour undefined, assume user *) } +function ([|2|]) int_of_accessLevel((AccessLevel)x) = + switch (x) { + case User -> 0 + case Supervisor -> 1 + case Kernel -> 2 + } + function unit checkCP0Access () = { let accessLevel = getAccessLevel() in diff --git a/mips/mips_tlb.sail b/mips/mips_tlb.sail index 2e40deed..d72e0e75 100644 --- a/mips/mips_tlb.sail +++ b/mips/mips_tlb.sail @@ -108,7 +108,7 @@ function (bit[64], bool) TLBTranslateC ((bit[64]) vAddr, (MemAccessType) accessT case 0b01 -> (Supervisor, None) (* xsseg - supervisor mapped *) case 0b00 -> (User, None) (* xuseg - user mapped *) } in - if (((nat)currentAccessLevel) < ((nat)requiredLevel)) then + if ((int_of_accessLevel(currentAccessLevel)) < (int_of_accessLevel(requiredLevel))) then (SignalExceptionBadAddr(if (accessType == StoreData) then AdES else AdEL, vAddr)) else let (pa, c) = switch(addr) { -- cgit v1.2.3 From 6e2cd26a769b7cce9b9e4dcd15515c3f42ed63cf Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Fri, 13 Oct 2017 15:45:46 +0100 Subject: Add support for new cheri instruction encodings. The order of pattern matching is now significant because register no. fields are re-used as additional function codes in operations with fewer operands so I pulled out all decode clauses to the beginning of file for easier rearranging. Old encodings can co-exist with new encodings as the only overlap is for recently added instructions which already use the new scheme. Eventually the old encodings will go away, however, and the opcode space may be reclaimed." --- cheri/cheri_insts.sail | 232 ++++++++++++++++++++++++++++++++----------------- 1 file changed, 151 insertions(+), 81 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index caa87e55..e126ef64 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -32,6 +32,157 @@ (* SUCH DAMAGE. *) (*========================================================================*) +(* Old encodings *) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b000) = Some(CGetPerm(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b001) = Some(CGetType(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b010) = Some(CGetBase(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b011) = Some(CGetLen(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b101) = Some(CGetTag(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b110) = Some(CGetSealed(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : 0b00000 : 0b00000000 : 0b100) = Some(CGetCause(rd)) + +function clause decode (0b010010 : 0b00110 : 0b000000000000000000000) = Some(CReturn) + +function clause decode (0b010010 : 0b01101 : (regno) rd : (regno) cb : 0b00000000 : 0b010) = Some(CGetOffset(rd, cb)) (* NB encoding does not follow pattern *) +function clause decode (0b010010 : 0b00100 : 0b00000 : 0b00000 : (regno) rt : 0b000 : 0b100) = Some(CSetCause(rt)) +function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b000) = Some(CAndPerm(cd, cb, rt)) +function clause decode (0b010010 : 0b01100 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b000) = Some(CToPtr(rd, cb, ct)) + +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b000) = Some(CPtrCmp(rd, cb, ct, CEQ)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b001) = Some(CPtrCmp(rd, cb, ct, CNE)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b010) = Some(CPtrCmp(rd, cb, ct, CLT)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b011) = Some(CPtrCmp(rd, cb, ct, CLE)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b100) = Some(CPtrCmp(rd, cb, ct, CLTU)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b101) = Some(CPtrCmp(rd, cb, ct, CLEU)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b110) = Some(CPtrCmp(rd, cb, ct, CEXEQ)) +function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b111) = Some(CPtrCmp(rd, cb, ct, CNEXEQ)) +function clause decode (0b010010 : 0b01101 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b000) = Some(CIncOffset(cd, cb, rt)) +function clause decode (0b010010 : 0b01101 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b001) = Some(CSetOffset(cd, cb, rt)) +function clause decode (0b010010 : 0b00001 : (regno) cd : (regno) cb : (regno) rt : 0b000000) = Some(CSetBounds(cd, cb, rt)) + +function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : 0b00000 : 0b000: 0b101) = Some(CClearTag(cd, cb)) +function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : (regno) rt : 0b000: 0b111) = Some(CFromPtr(cd, cb, rt)) +function clause decode (0b010010 : 0b01011 : (regno) cs : 0b00000 : (regno) rt : 0b000: 0b000) = Some(CCheckPerm(cs, rt)) +function clause decode (0b010010 : 0b01011 : (regno) cs : (regno) cb : 0b00000 : 0b000: 0b001) = Some(CCheckType(cs, cb)) +function clause decode (0b010010 : 0b00010 : (regno) cd : (regno) cs : (regno) ct : 0b000: 0b000) = Some(CSeal(cd, cs, ct)) +function clause decode (0b010010 : 0b00011 : (regno) cd : (regno) cs : (regno) ct : 0b000: 0b000) = Some(CUnseal(cd, cs, ct)) +function clause decode (0b010010 : 0b00111 : (regno) cd : (regno) cb : 0b00000 : 0b000000) = Some(CJALR(cd, cb, true)) (* CJALR *) +function clause decode (0b010010 : 0b01000 : 0b00000 : (regno) cb : 0b00000 : 0b000000) = Some(CJALR(0b00000, cb, false)) (* CJR *) + + +(* +New encodings as per CHERI ISA Appendix B.2. + +NB: Must be careful about order of matching because unused register +fields are re-used as additional function codes. +*) + +(* One arg *) +function clause decode (0b010010 : 0b00000 : (regno) rd : 0b00001 : 0b11111 : 0b111111) = Some(CGetCause(rd)) +function clause decode (0b010010 : 0b00000 : (regno) rs : 0b00010 : 0b11111 : 0b111111) = Some(CSetCause(rs)) +function clause decode (0b010010 : 0b00000 : (regno) cd : 0b00000 : 0b11111 : 0b111111) = Some(CGetPCC(cd)) + +(* Two arg *) +function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) rt : 0b01000 : 0b111111) = Some(CCheckPerm(cs, rt)) +function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) cb : 0b01001 : 0b111111) = Some(CCheckType(cs, cb)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : 0b01011 : 0b111111) = Some(CClearTag(cd, cb)) + +(* Capability Inspection *) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000 : 0b111111) = Some(CGetPerm(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00001 : 0b111111) = Some(CGetType(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00010 : 0b111111) = Some(CGetBase(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00011 : 0b111111) = Some(CGetLen(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00100 : 0b111111) = Some(CGetTag(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00101 : 0b111111) = Some(CGetSealed(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00110 : 0b111111) = Some(CGetOffset(rd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) rs : 0b00111 : 0b111111) = Some(CGetPCCSetOffset(cd, rs)) + +(* Three operand *) + +(* Capability Modification *) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) ct : 0b001011) = Some(CSeal(cd, cs, ct)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) ct : 0b001100) = Some(CUnseal(cd, cs, ct)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rt : 0b001101) = Some(CAndPerm(cd, cs, rt)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rt : 0b001111) = Some(CSetOffset(cd, cs, rt)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rt : 0b001000) = Some(CSetBounds(cd, cs, rt)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rt : 0b001001) = Some(CSetBoundsExact(cd, cs, rt)) + + +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b010001) = Some(CIncOffset(cd, cb, rt)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) ct : 0b011101) = Some(CBuildCap(cd, cb, ct)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) ct : 0b011110) = Some(CCopyType(cd, cb, ct)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) ct : 0b011111) = Some(CCSeal(cd, cs, ct)) + +(* Pointer Arithmetic *) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b010010) = Some(CToPtr(rd, cb, ct)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rs : 0b010011) = Some(CFromPtr(cd, cb, rs)) +function clause decode (0b010010 : 0b00000 : (regno) rt : (regno) cb : (regno) cs : 0b001010) = Some(CSub(rt, cb, cs)) +(* XXX function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : 0b01010 : 0b111111) = Some(CMove(cd, cs)) *) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rs : 0b011011) = Some(CMOVX(cd, cs, rs, false)) (* CMOVZ *) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rs : 0b011100) = Some(CMOVX(cd, cs, rs, true)) (* CMOVN *) + +(* Pointer Comparison *) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b010100) = Some(CPtrCmp(rd, cb, cs, CEQ)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b010101) = Some(CPtrCmp(rd, cb, cs, CNE)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b010110) = Some(CPtrCmp(rd, cb, cs, CLT)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b010111) = Some(CPtrCmp(rd, cb, cs, CLE)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b011000) = Some(CPtrCmp(rd, cb, cs, CLTU)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b011001) = Some(CPtrCmp(rd, cb, cs, CLEU)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b011010) = Some(CPtrCmp(rd, cb, cs, CEXEQ)) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b100001) = Some(CPtrCmp(rd, cb, cs, CNEXEQ)) + +(* function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b100000) = Some(CTestSubset(rd, cb, ct)) *) + +function clause decode (0b010010 : 0b01001 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, true)) (* CBTU *) +function clause decode (0b010010 : 0b01010 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, false)) (* CBTS *) +(* function clause decode (0b010010 : 0b10001 : (regno) cd : (bit[16]) imm) = Some(CBEZ(cd, imm)) XXX *) +(* function clause decode (0b010010 : 0b10010 : (regno) cd : (bit[16]) imm) = Some(CBNZ(cd, imm)) XXX *) + +function clause decode (0b010010 : 0b00101 : 0b00000 : 0b00000 : 0b11111111111) = Some(CReturn) +function clause decode (0b010010 : 0b00101 : (regno) cs : (regno) cb : (bit[11]) selector) = Some(CCall(cs, cb, selector)) + +function clause decode (0b010010 : 0b01111 : 0b00000 : (bit[16]) imm) = Some(ClearRegs(GPLo, imm)) +function clause decode (0b010010 : 0b01111 : 0b00001 : (bit[16]) imm) = Some(ClearRegs(GPHi, imm)) +function clause decode (0b010010 : 0b01111 : 0b00010 : (bit[16]) imm) = Some(ClearRegs(CLo, imm)) +function clause decode (0b010010 : 0b01111 : 0b00011 : (bit[16]) imm) = Some(ClearRegs(CHi, imm)) + +(* XXX CSetBoundsImmediate *) +(* XXX CIncOffsetImmediate *) + +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b00) = Some(CLoad(rd, cb, rt, offset, false, B, false)) (* CLBU *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b00) = Some(CLoad(rd, cb, rt, offset, true, B, false)) (* CLB *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b01) = Some(CLoad(rd, cb, rt, offset, false, H, false)) (* CLHU *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b01) = Some(CLoad(rd, cb, rt, offset, true, H, false)) (* CLH *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b10) = Some(CLoad(rd, cb, rt, offset, false, W, false)) (* CLWU *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b10) = Some(CLoad(rd, cb, rt, offset, true, W, false)) (* CLW *) +function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b11) = Some(CLoad(rd, cb, rt, offset, false, D, false)) (* CLD *) + +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b00) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, B, true)) (* CLLBU *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b00) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, B, true)) (* CLLB *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b01) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, H, true)) (* CLLHU *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b01) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, H, true)) (* CLLH *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b10) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, W, true)) (* CLLWU *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b10) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, W, true)) (* CLLW *) +function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b11) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, D, true)) (* CLLD *) + +function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b00) = Some(CStore(rs, cb, rt, 0b00000, offset, B, false)) (* CSB *) +function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b01) = Some(CStore(rs, cb, rt, 0b00000, offset, H, false)) (* CSH *) +function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b10) = Some(CStore(rs, cb, rt, 0b00000, offset, W, false)) (* CSW *) +function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b11) = Some(CStore(rs, cb, rt, 0b00000, offset, D, false)) (* CSD *) + +function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b00) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, B, true)) (* CSCB *) +function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b01) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, H, true)) (* CSCH *) +function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b10) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, W, true)) (* CSCW *) +function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b11) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, D, true)) (* CSCD *) + +function clause decode (0b111110 : (regno) cs : (regno) cb: (regno) rt : (bit[11]) offset) = Some(CSC(cs, cb, rt, 0b00000, offset, false)) +function clause decode (0b010010 : 0b10000 : (regno) cs : (regno) cb: (regno) rd : 0b00 : 0b0111) = Some(CSC(cs, cb, 0b00000, rd, 0b00000000000, true)) + +function clause decode (0b110110 : (regno) cd : (regno) cb: (regno) rt : (bit[11]) offset) = Some(CLC(cd, cb, rt, offset, false)) +function clause decode (0b010010 : 0b10000 : (regno) cd : (regno) cb: 0b0000000 : 0b1111) = Some(CLC(cd, cb, 0b00000, 0b00000000000, true)) + +function clause decode (0b010010 : 0b00100 : (regno) rt : 0x0006) = Some(C2Dump(rt)) + (* Operations that extract parts of a capability into GPR *) union ast member (regno, regno) CGetPerm @@ -42,15 +193,6 @@ union ast member (regno, regno) CGetTag union ast member (regno, regno) CGetSealed union ast member (regno, regno) CGetOffset -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b000) = Some(CGetPerm(rd, cb)) -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b001) = Some(CGetType(rd, cb)) -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b010) = Some(CGetBase(rd, cb)) -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b011) = Some(CGetLen(rd, cb)) -(* NB CGetCause Handled separately *) -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b101) = Some(CGetTag(rd, cb)) -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000000 : 0b110) = Some(CGetSealed(rd, cb)) -function clause decode (0b010010 : 0b01101 : (regno) rd : (regno) cb : 0b00000000 : 0b010) = Some(CGetOffset(rd, cb)) (* NB encoding does not follow pattern *) - function clause execute (CGetPerm(rd, cb)) = { (* START_CGetPerms *) @@ -140,7 +282,6 @@ function clause execute (CGetSealed(rd, cb)) = } union ast member regno CGetPCC -function clause decode (0b010010 : 0b00000 : (regno) cd : 0b00000 : 0b11111 : 0b111111) = Some(CGetPCC(cd)) function clause execute (CGetPCC(cd)) = { (* START_CGetPCC *) @@ -157,7 +298,6 @@ function clause execute (CGetPCC(cd)) = union ast member (regno, regno) CGetPCCSetOffset -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) rs : 0b00111 : 0b111111) = Some(CGetPCCSetOffset(cd, rs)) function clause execute (CGetPCCSetOffset(cd, rs)) = { (* START_CGetPCCSetOffset *) @@ -177,7 +317,6 @@ function clause execute (CGetPCCSetOffset(cd, rs)) = (* Get and Set CP2 cause register *) union ast member regno CGetCause -function clause decode (0b010010 : 0b00000 : (regno) rd : 0b00000 : 0b00000000 : 0b100) = Some(CGetCause(rd)) function clause execute (CGetCause(rd)) = { (* START_CGetCause *) @@ -190,7 +329,6 @@ function clause execute (CGetCause(rd)) = } union ast member (regno) CSetCause -function clause decode (0b010010 : 0b00100 : 0b00000 : 0b00000 : (regno) rt : 0b000 : 0b100) = Some(CSetCause(rt)) function clause execute (CSetCause((regno) rt)) = { (* START_CSetCause *) @@ -207,7 +345,6 @@ function clause execute (CSetCause((regno) rt)) = } union ast member regregreg CAndPerm -function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b000) = Some(CAndPerm(cd, cb, rt)) function clause execute(CAndPerm(cd, cb, rt)) = { (* START_CAndPerm *) @@ -232,7 +369,6 @@ function clause execute(CAndPerm(cd, cb, rt)) = union ast member regregreg CToPtr -function clause decode (0b010010 : 0b01100 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b000) = Some(CToPtr(rd, cb, ct)) function clause execute(CToPtr(rd, cb, ct)) = { (* START_CToPtr *) @@ -266,7 +402,6 @@ function clause execute(CToPtr(rd, cb, ct)) = union ast member regregreg CSub -function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b001010) = Some(CSub(rd, cb, ct)) function clause execute(CSub(rd, cb, ct)) = { (* START_CSub *) @@ -285,15 +420,6 @@ function clause execute(CSub(rd, cb, ct)) = } union ast member (regno, regno, regno, CPtrCmpOp) CPtrCmp -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b000) = Some(CPtrCmp(rd, cb, ct, CEQ)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b001) = Some(CPtrCmp(rd, cb, ct, CNE)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b010) = Some(CPtrCmp(rd, cb, ct, CLT)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b011) = Some(CPtrCmp(rd, cb, ct, CLE)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b100) = Some(CPtrCmp(rd, cb, ct, CLTU)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b101) = Some(CPtrCmp(rd, cb, ct, CLEU)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b110) = Some(CPtrCmp(rd, cb, ct, CEXEQ)) -function clause decode (0b010010 : 0b01110 : (regno) rd : (regno) cb : (regno) ct : 0b000 : 0b111) = Some(CPtrCmp(rd, cb, ct, CNEXEQ)) - function clause execute(CPtrCmp(rd, cb, ct, op)) = { (* START_CPtrCmp *) @@ -340,7 +466,6 @@ function clause execute(CPtrCmp(rd, cb, ct, op)) = } union ast member regregreg CIncOffset -function clause decode (0b010010 : 0b01101 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b000) = Some(CIncOffset(cd, cb, rt)) function clause execute (CIncOffset(cd, cb, rt)) = { (* START_CIncOffset *) @@ -363,7 +488,6 @@ function clause execute (CIncOffset(cd, cb, rt)) = } union ast member regregreg CSetOffset -function clause decode (0b010010 : 0b01101 : (regno) cd : (regno) cb : (regno) rt : 0b000 : 0b001) = Some(CSetOffset(cd, cb, rt)) function clause execute (CSetOffset(cd, cb, rt)) = { (* START_CSetOffset *) @@ -386,7 +510,6 @@ function clause execute (CSetOffset(cd, cb, rt)) = } union ast member regregreg CSetBounds -function clause decode (0b010010 : 0b00001 : (regno) cd : (regno) cb : (regno) rt : 0b000000) = Some(CSetBounds(cd, cb, rt)) function clause execute (CSetBounds(cd, cb, rt)) = { (* START_CSetBounds *) @@ -417,7 +540,6 @@ function clause execute (CSetBounds(cd, cb, rt)) = union ast member regregreg CSetBoundsExact -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b001001) = Some(CSetBoundsExact(cd, cb, rt)) function clause execute (CSetBoundsExact(cd, cb, rt)) = { (* START_CSetBoundsExact *) @@ -450,7 +572,6 @@ function clause execute (CSetBoundsExact(cd, cb, rt)) = } union ast member (regno, regno) CClearTag -function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : 0b00000 : 0b000: 0b101) = Some(CClearTag(cd, cb)) function clause execute (CClearTag(cd, cb)) = { (* START_CClearTag *) @@ -468,8 +589,6 @@ function clause execute (CClearTag(cd, cb)) = } union ast member (regno,regno,regno,bool) CMOVX -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011100) = Some(CMOVX(cd, cb, rt, true)) (* CMOVN *) -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rt : 0b011011) = Some(CMOVX(cd, cb, rt, false)) (* CMOVZ *) function clause execute (CMOVX(cd, cb, rt, ismovn)) = { (* START_CMOVX *) @@ -484,10 +603,6 @@ function clause execute (CMOVX(cd, cb, rt, ismovn)) = } union ast member (ClearRegSet, bit[16]) ClearRegs -function clause decode (0b010010 : 0b01111 : 0b00000 : (bit[16]) imm) = Some(ClearRegs(GPLo, imm)) (* ClearLo *) -function clause decode (0b010010 : 0b01111 : 0b00001 : (bit[16]) imm) = Some(ClearRegs(GPHi, imm)) (* ClearHi *) -function clause decode (0b010010 : 0b01111 : 0b00010 : (bit[16]) imm) = Some(ClearRegs(CLo, imm)) (* CClearLo *) -function clause decode (0b010010 : 0b01111 : 0b00011 : (bit[16]) imm) = Some(ClearRegs(CHi, imm)) (* CClearHi *) function clause execute (ClearRegs(regset, mask)) = { (* START_ClearRegs *) @@ -510,7 +625,6 @@ function clause execute (ClearRegs(regset, mask)) = } union ast member regregreg CFromPtr -function clause decode (0b010010 : 0b00100 : (regno) cd : (regno) cb : (regno) rt : 0b000: 0b111) = Some(CFromPtr(cd, cb, rt)) function clause execute (CFromPtr(cd, cb, rt)) = { (* START_CFromPtr *) @@ -537,7 +651,6 @@ function clause execute (CFromPtr(cd, cb, rt)) = } union ast member regregreg CBuildCap -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) ct : 0b011101) = Some(CBuildCap(cd, cb, ct)) function clause execute (CBuildCap(cd, cb, ct)) = { (* START_CBuildCap *) @@ -582,7 +695,6 @@ function clause execute (CBuildCap(cd, cb, ct)) = } union ast member regregreg CCopyType -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) ct : 0b011110) = Some(CCopyType(cd, cb, ct)) function clause execute (CCopyType(cd, cb, ct)) = { (* START_CCopyType *) @@ -618,7 +730,6 @@ function clause execute (CCopyType(cd, cb, ct)) = } union ast member (regno, regno) CCheckPerm -function clause decode (0b010010 : 0b01011 : (regno) cs : 0b00000 : (regno) rt : 0b000: 0b000) = Some(CCheckPerm(cs, rt)) function clause execute (CCheckPerm(cs, rt)) = { (* START_CCheckPerm *) @@ -638,7 +749,6 @@ function clause execute (CCheckPerm(cs, rt)) = } union ast member (regno, regno) CCheckType -function clause decode (0b010010 : 0b01011 : (regno) cs : (regno) cb : 0b00000 : 0b000: 0b001) = Some(CCheckType(cs, cb)) function clause execute (CCheckType(cs, cb)) = { (* START_CCheckType *) @@ -665,7 +775,6 @@ function clause execute (CCheckType(cs, cb)) = } union ast member regregreg CSeal -function clause decode (0b010010 : 0b00010 : (regno) cd : (regno) cs : (regno) ct : 0b000: 0b000) = Some(CSeal(cd, cs, ct)) function clause execute (CSeal(cd, cs, ct)) = { (* START_CSeal *) @@ -707,7 +816,6 @@ function clause execute (CSeal(cd, cs, ct)) = } union ast member regregreg CCSeal -function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) ct : 0b011111) = Some(CCSeal(cd, cs, ct)) function clause execute (CCSeal(cd, cs, ct)) = { (* START_CCSeal *) @@ -749,7 +857,6 @@ function clause execute (CCSeal(cd, cs, ct)) = } union ast member regregreg CUnseal -function clause decode (0b010010 : 0b00011 : (regno) cd : (regno) cs : (regno) ct : 0b000: 0b000) = Some(CUnseal(cd, cs, ct)) function clause execute (CUnseal(cd, cs, ct)) = { (* START_CUnseal *) @@ -789,7 +896,6 @@ function clause execute (CUnseal(cd, cs, ct)) = } union ast member (regno, regno, bit[11]) CCall -function clause decode (0b010010 : 0b00101 : (regno) cs : (regno) cb : (bit[11]) selector) = Some(CCall(cs, cb, selector)) function clause execute (CCall(cs, cb, 0b00000000000)) = (* selector=0 *) { (* Partial implementation of CCall with checks in hardware, but raising a trap to perform trusted stack manipulation *) @@ -876,7 +982,6 @@ function clause execute (CCall(cs, cb, 0b00000000001)) = (* selector=1 *) } union ast member unit CReturn -function clause decode (0b010010 : 0b00110 : 0b000000000000000000000) = Some(CReturn) function clause execute (CReturn) = { (* START_CReturn *) @@ -886,9 +991,6 @@ function clause execute (CReturn) = } union ast member (regno, bit[16], bool) CBX -function clause decode (0b010010 : 0b01001 : (regno) cb : (bit[16]) imm) = Some(CBX(cb, imm, true)) (* CBTU *) -function clause decode (0b010010 : 0b01010 : (regno) cb : (bit[16]) imm) = Some(CBX(cb, imm, false)) (* CBTS *) - function clause execute (CBX(cb, imm, invert)) = { (* START_CBx *) @@ -905,8 +1007,6 @@ function clause execute (CBX(cb, imm, invert)) = } union ast member (regno, regno, bool) CJALR -function clause decode (0b010010 : 0b00111 : (regno) cd : (regno) cb : 0b00000 : 0b000000) = Some(CJALR(cd, cb, true)) (* CJALR *) -function clause decode (0b010010 : 0b01000 : 0b00000 : (regno) cb : 0b00000 : 0b000000) = Some(CJALR(0b00000, cb, false)) (* CJR *) function clause execute(CJALR(cd, cb, link)) = { (* START_CJALR *) @@ -948,22 +1048,6 @@ function clause execute(CJALR(cd, cb, link)) = } union ast member (regno, regno, regno, bit[8], bool, WordType, bool) CLoad -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b00) = Some(CLoad(rd, cb, rt, offset, false, B, false)) (* CLBU *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b00) = Some(CLoad(rd, cb, rt, offset, true, B, false)) (* CLB *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b01) = Some(CLoad(rd, cb, rt, offset, false, H, false)) (* CLHU *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b01) = Some(CLoad(rd, cb, rt, offset, true, H, false)) (* CLH *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b10) = Some(CLoad(rd, cb, rt, offset, false, W, false)) (* CLWU *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b10) = Some(CLoad(rd, cb, rt, offset, true, W, false)) (* CLW *) -function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b11) = Some(CLoad(rd, cb, rt, offset, false, D, false)) (* CLD *) - -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b00) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, B, true)) (* CLLBU *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b00) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, B, true)) (* CLLB *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b01) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, H, true)) (* CLLHU *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b01) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, H, true)) (* CLLH *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b10) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, W, true)) (* CLLWU *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b1 : 0b10) = Some(CLoad(rd, cb, 0b00000, 0b00000000, true, W, true)) (* CLLW *) -function clause decode (0b010010 : 0b10000 : (regno) rd : (regno) cb : 0b00000001 : 0b0 : 0b11) = Some(CLoad(rd, cb, 0b00000, 0b00000000, false, D, true)) (* CLLD *) - function clause execute (CLoad(rd, cb, rt, offset, signext, width, linked)) = { (* START_CLoad *) @@ -1011,15 +1095,6 @@ function clause execute (CLoad(rd, cb, rt, offset, signext, width, linked)) = } union ast member (regno, regno, regno, regno, bit[8], WordType, bool) CStore -function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b00) = Some(CStore(rs, cb, rt, 0b00000, offset, B, false)) (* CSB *) -function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b01) = Some(CStore(rs, cb, rt, 0b00000, offset, H, false)) (* CSH *) -function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b10) = Some(CStore(rs, cb, rt, 0b00000, offset, W, false)) (* CSW *) -function clause decode (0b111010 : (regno) rs : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b11) = Some(CStore(rs, cb, rt, 0b00000, offset, D, false)) (* CSD *) - -function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b00) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, B, true)) (* CSCB *) -function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b01) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, H, true)) (* CSCH *) -function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b10) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, W, true)) (* CSCW *) -function clause decode (0b010010 : 0b10000 : (regno) rs : (regno) cb : (regno) rd : 0b0000 : 0b11) = Some(CStore(rs, cb, 0b00000, rd, 0b00000000, D, true)) (* CSCD *) function clause execute (CStore(rs, cb, rt, rd, offset, width, conditional)) = { @@ -1078,8 +1153,6 @@ function clause execute (CStore(rs, cb, rt, rd, offset, width, conditional)) = } union ast member (regno, regno, regno, regno, bit[11], bool) CSC -function clause decode (0b111110 : (regno) cs : (regno) cb: (regno) rt : (bit[11]) offset) = Some(CSC(cs, cb, rt, 0b00000, offset, false)) -function clause decode (0b010010 : 0b10000 : (regno) cs : (regno) cb: (regno) rd : 0b00 : 0b0111) = Some(CSC(cs, cb, 0b00000, rd, 0b00000000000, true)) function clause execute (CSC(cs, cb, rt, rd, offset, conditional)) = { (* START_CSC *) @@ -1130,8 +1203,6 @@ function clause execute (CSC(cs, cb, rt, rd, offset, conditional)) = } union ast member (regno, regno, regno, bit[11], bool) CLC -function clause decode (0b110110 : (regno) cd : (regno) cb: (regno) rt : (bit[11]) offset) = Some(CLC(cd, cb, rt, offset, false)) -function clause decode (0b010010 : 0b10000 : (regno) cd : (regno) cb: 0b0000000 : 0b1111) = Some(CLC(cd, cb, 0b00000, 0b00000000000, true)) function clause execute (CLC(cd, cb, rt, offset, linked)) = { (* START_CLC *) @@ -1176,6 +1247,5 @@ function clause execute (CLC(cd, cb, rt, offset, linked)) = } union ast member (regno) C2Dump -function clause decode (0b010010 : 0b00100 : (regno) rt : 0x0006) = Some(C2Dump(rt)) function clause execute (C2Dump (rt)) = () (* Currently a NOP *) -- cgit v1.2.3 From 91c90cba4b0580802b5c4610e1b3dc5d10e3b4ae Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 16 Oct 2017 11:09:13 +0100 Subject: add support for capability branch null instructions. --- cheri/cheri_insts.sail | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index e126ef64..d5ba8d06 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -133,10 +133,10 @@ function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) c (* function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b100000) = Some(CTestSubset(rd, cb, ct)) *) -function clause decode (0b010010 : 0b01001 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, true)) (* CBTU *) +function clause decode (0b010010 : 0b01001 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, true)) (* CBTU *) function clause decode (0b010010 : 0b01010 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, false)) (* CBTS *) -(* function clause decode (0b010010 : 0b10001 : (regno) cd : (bit[16]) imm) = Some(CBEZ(cd, imm)) XXX *) -(* function clause decode (0b010010 : 0b10010 : (regno) cd : (bit[16]) imm) = Some(CBNZ(cd, imm)) XXX *) +function clause decode (0b010010 : 0b10001 : (regno) cd : (bit[16]) imm) = Some(CBZ(cd, imm, false)) (* CBEZ *) +function clause decode (0b010010 : 0b10010 : (regno) cd : (bit[16]) imm) = Some(CBZ(cd, imm, true)) (* CBNZ *) function clause decode (0b010010 : 0b00101 : 0b00000 : 0b00000 : 0b11111111111) = Some(CReturn) function clause decode (0b010010 : 0b00101 : (regno) cs : (regno) cb : (bit[11]) selector) = Some(CCall(cs, cb, selector)) @@ -1006,6 +1006,22 @@ function clause execute (CBX(cb, imm, invert)) = (* END_CBx *) } +union ast member (regno, bit[16], bool) CBZ +function clause execute (CBZ(cb, imm, invert)) = +{ + (* START_CBz *) + checkCP2usable(); + if (register_inaccessible(cb)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cb) + else if (((readCapReg(cb)) == null_cap) ^ invert) then + { + let (bit[64]) offset = (EXTS(imm : 0b00) + 4) in + delayedPC := PC + offset; + branchPending := 1; + } + (* END_CBz *) +} + union ast member (regno, regno, bool) CJALR function clause execute(CJALR(cd, cb, link)) = { -- cgit v1.2.3 From 3c678570789fbbe37d25e2b6201b0eefb10fbae2 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 16 Oct 2017 12:17:07 +0100 Subject: add support for CIncOffsetImmediate and CSetBoundsImmediate. --- cheri/cheri_insts.sail | 54 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index d5ba8d06..7542e377 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -146,8 +146,8 @@ function clause decode (0b010010 : 0b01111 : 0b00001 : (bit[16]) imm) = Some(Cle function clause decode (0b010010 : 0b01111 : 0b00010 : (bit[16]) imm) = Some(ClearRegs(CLo, imm)) function clause decode (0b010010 : 0b01111 : 0b00011 : (bit[16]) imm) = Some(ClearRegs(CHi, imm)) -(* XXX CSetBoundsImmediate *) -(* XXX CIncOffsetImmediate *) +function clause decode (0b010010 : 0b10011 : (regno) cd : (regno) cb : (bit[11]) imm) = Some(CIncOffsetImmediate(cd, cb, imm)) +function clause decode (0b010010 : 0b10100 : (regno) cd : (regno) cb : (bit[11]) imm) = Some(CSetBoundsImmediate(cd, cb, imm)) function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b0 : 0b00) = Some(CLoad(rd, cb, rt, offset, false, B, false)) (* CLBU *) function clause decode (0b110010 : (regno) rd : (regno) cb: (regno) rt : (bit[8]) offset : 0b1 : 0b00) = Some(CLoad(rd, cb, rt, offset, true, B, false)) (* CLB *) @@ -487,6 +487,28 @@ function clause execute (CIncOffset(cd, cb, rt)) = (* END_CIncOffset *) } +union ast member (regno, regno, bit[11]) CIncOffsetImmediate +function clause execute (CIncOffsetImmediate(cd, cb, imm)) = +{ + (* START_CIncOffsetImmediate *) + checkCP2usable(); + cb_val := readCapReg(cb); + let (bit[64]) imm64 = EXTZ(imm) in + if (register_inaccessible(cd)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cd) + else if (register_inaccessible(cb)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cb) + else if ((cb_val.tag) & (cb_val.sealed)) then + raise_c2_exception(CapEx_SealViolation, cb) + else + let (success, newCap) = incCapOffset(cb_val, imm64) in + if (success) then + writeCapReg(cd, newCap) + else + writeCapReg(cd, int_to_cap(getCapBase(cb_val) + imm64)) + (* END_CIncOffsetImmediate *) +} + union ast member regregreg CSetOffset function clause execute (CSetOffset(cd, cb, rt)) = { @@ -538,6 +560,34 @@ function clause execute (CSetBounds(cd, cb, rt)) = (* END_CSetBounds *) } +union ast member (regno, regno, bit[11]) CSetBoundsImmediate +function clause execute (CSetBoundsImmediate(cd, cb, imm)) = +{ + (* START_CSetBoundsImmedate *) + checkCP2usable(); + cb_val := readCapReg(cb); + immU := unsigned(imm); + cursor := getCapCursor(cb_val); + base := getCapBase(cb_val); + top := getCapTop(cb_val); + newTop := cursor + immU; + if (register_inaccessible(cd)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cd) + else if (register_inaccessible(cb)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cb) + else if not (cb_val.tag) then + raise_c2_exception(CapEx_TagViolation, cb) + else if (cb_val.sealed) then + raise_c2_exception(CapEx_SealViolation, cb) + else if (cursor < base) then + raise_c2_exception(CapEx_LengthViolation, cb) + else if (newTop > top) then + raise_c2_exception(CapEx_LengthViolation, cb) + else + let (_, newCap) = setCapBounds(cb_val, (bit[64]) cursor, (bit[65]) newTop) in + writeCapReg(cd, newCap) (* ignore exact *) + (* END_CSetBoundsImmediate *) +} union ast member regregreg CSetBoundsExact function clause execute (CSetBoundsExact(cd, cb, rt)) = -- cgit v1.2.3 From 27816b955866bd5021cb8534f92480d83d76cc32 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 16 Oct 2017 14:46:50 +0100 Subject: implement CMove as an alias for cmovz with zero register. --- cheri/cheri_insts.sail | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index 7542e377..3b602d03 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -86,6 +86,7 @@ function clause decode (0b010010 : 0b00000 : (regno) cd : 0b00000 : 0b1111 function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) rt : 0b01000 : 0b111111) = Some(CCheckPerm(cs, rt)) function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) cb : 0b01001 : 0b111111) = Some(CCheckType(cs, cb)) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : 0b01011 : 0b111111) = Some(CClearTag(cd, cb)) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : 0b01010 : 0b111111) = Some(CMOVX(cd, cs, 0b00000, false)) (* CMOVE *) (* Capability Inspection *) function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000 : 0b111111) = Some(CGetPerm(rd, cb)) @@ -117,7 +118,6 @@ function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) c function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b010010) = Some(CToPtr(rd, cb, ct)) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : (regno) rs : 0b010011) = Some(CFromPtr(cd, cb, rs)) function clause decode (0b010010 : 0b00000 : (regno) rt : (regno) cb : (regno) cs : 0b001010) = Some(CSub(rt, cb, cs)) -(* XXX function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : 0b01010 : 0b111111) = Some(CMove(cd, cs)) *) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rs : 0b011011) = Some(CMOVX(cd, cs, rs, false)) (* CMOVZ *) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : (regno) rs : 0b011100) = Some(CMOVX(cd, cs, rs, true)) (* CMOVN *) -- cgit v1.2.3 From 1522c658263cb1f646e44489ba8a19764fe8f4c4 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 16 Oct 2017 16:21:07 +0100 Subject: add missing new encodings for CJR and CJALR. --- cheri/cheri_insts.sail | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index 3b602d03..1d6c4a13 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -81,12 +81,14 @@ fields are re-used as additional function codes. function clause decode (0b010010 : 0b00000 : (regno) rd : 0b00001 : 0b11111 : 0b111111) = Some(CGetCause(rd)) function clause decode (0b010010 : 0b00000 : (regno) rs : 0b00010 : 0b11111 : 0b111111) = Some(CSetCause(rs)) function clause decode (0b010010 : 0b00000 : (regno) cd : 0b00000 : 0b11111 : 0b111111) = Some(CGetPCC(cd)) +function clause decode (0b010010 : 0b00000 : (regno) cb : 0b00011 : 0b11111 : 0b111111) = Some(CJALR(0b00000, cb, false)) (* CJR *) (* Two arg *) function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) rt : 0b01000 : 0b111111) = Some(CCheckPerm(cs, rt)) function clause decode (0b010010 : 0b00000 : (regno) cs : (regno) cb : 0b01001 : 0b111111) = Some(CCheckType(cs, cb)) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : 0b01011 : 0b111111) = Some(CClearTag(cd, cb)) function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cs : 0b01010 : 0b111111) = Some(CMOVX(cd, cs, 0b00000, false)) (* CMOVE *) +function clause decode (0b010010 : 0b00000 : (regno) cd : (regno) cb : 0b01100 : 0b111111) = Some(CJALR(cd, cb, true)) (* CJALR *) (* Capability Inspection *) function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : 0b00000 : 0b111111) = Some(CGetPerm(rd, cb)) -- cgit v1.2.3 From 7bd52dedf93ccaf4811307e12b8402fad6ab2312 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 16 Oct 2017 16:24:59 +0100 Subject: add CTestSubset instruction. --- cheri/cheri_insts.sail | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index 1d6c4a13..c27f6dc7 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -133,7 +133,7 @@ function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) c function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b011010) = Some(CPtrCmp(rd, cb, cs, CEXEQ)) function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) cs : 0b100001) = Some(CPtrCmp(rd, cb, cs, CNEXEQ)) -(* function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b100000) = Some(CTestSubset(rd, cb, ct)) *) +function clause decode (0b010010 : 0b00000 : (regno) rd : (regno) cb : (regno) ct : 0b100000) = Some(CTestSubset(rd, cb, ct)) function clause decode (0b010010 : 0b01001 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, true)) (* CBTU *) function clause decode (0b010010 : 0b01010 : (regno) cd : (bit[16]) imm) = Some(CBX(cd, imm, false)) (* CBTS *) @@ -826,6 +826,41 @@ function clause execute (CCheckType(cs, cb)) = (* END_CCheckType *) } +union ast member regregreg CTestSubset +function clause execute (CTestSubset(rd, cb, ct)) = +{ + (* START_CTestSubset *) + checkCP2usable(); + cb_val := readCapReg(cb); + ct_val := readCapReg(ct); + ct_top := getCapTop(ct_val); + ct_base := getCapBase(ct_val); + ct_perms := getCapPerms(ct_val); + cb_top := getCapTop(cb_val); + cb_base := getCapBase(cb_val); + cb_perms := getCapPerms(cb_val); + if (register_inaccessible(cb)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, cb) + else if (register_inaccessible(ct)) then + raise_c2_exception(CapEx_AccessSystemRegsViolation, ct) + else { + (bit[64]) result := EXTZ(if (cb_val.tag != ct_val.tag) then + 0x0 + else if (cb_val.sealed != ct_val.sealed) then + 0x0 + else if (ct_base < cb_base) then + 0x0 + else if (ct_top > cb_top) then + 0x0 + else if ((ct_perms & cb_perms) != cb_perms) then + 0x0 + else + 0x1); + wGPR(rd) := result; + } + (* END_CTestSubset *) +} + union ast member regregreg CSeal function clause execute (CSeal(cd, cs, ct)) = { -- cgit v1.2.3 From 99a7462a88a186faf817e21c065e25f04d30aea7 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Mon, 23 Oct 2017 17:47:16 +0100 Subject: cheri: Null capability should have maximum length, because in cheri128 we want all offsets to be representable. To maintain all-zeros as the in-memory representation of the null capability we xor memory bits with null capability when loading and storing. --- cheri/cheri_prelude_128.sail | 26 +++++++++++++++++++------- cheri/cheri_prelude_256.sail | 18 +++++++++++++++--- 2 files changed, 34 insertions(+), 10 deletions(-) diff --git a/cheri/cheri_prelude_128.sail b/cheri/cheri_prelude_128.sail index 98b0a40c..9bc0e2d2 100644 --- a/cheri/cheri_prelude_128.sail +++ b/cheri/cheri_prelude_128.sail @@ -73,10 +73,10 @@ let (CapStruct) null_cap = { permit_execute = false; global = false; reserved = 0; - E = 48; (* encoded as 0 in memory due to xor *) + E = 48; sealed = false; B = 0; - T = 0; + T = 0x10000; otype = 0; address = 0; } @@ -104,7 +104,7 @@ function CapStruct capRegToCapStruct((CapReg) c) = permit_execute = c[114]; global = c[113]; reserved = c[112..111]; - E = c[110..105] ^ 0b110000; + E = c[110..105]; sealed = s; B = B; T = T; @@ -125,13 +125,13 @@ function (bit[11]) getCapHardPerms((CapStruct) cap) = : [cap.permit_execute] : [cap.global]) -function (bit[128]) capStructToMemBits((CapStruct) cap) = +function (bit[128]) capStructToMemBits128((CapStruct) cap) = let (bit[20]) b = if cap.sealed then (cap.B)[19..12] : (cap.otype)[23..12] else cap.B in let (bit[20]) t = if cap.sealed then (cap.T)[19..12] : (cap.otype)[11..0] else cap.T in ( cap.uperms : getCapHardPerms(cap) : cap.reserved - : (cap.E ^ 0b110000) (* XXX brackets required otherwise sail interpreter error *) + : (cap.E) : [cap.sealed] : b : t @@ -139,12 +139,24 @@ function (bit[128]) capStructToMemBits((CapStruct) cap) = ) function (CapReg) capStructToCapReg((CapStruct) cap) = - ([cap.tag] : capStructToMemBits(cap)) + ([cap.tag] : capStructToMemBits128(cap)) (* Reverse of above used when reading from memory *) -function (CapReg) memBitsToCapBits((bool) tag, (bit[128]) b) = +function (CapReg) memBitsToCapBits128((bool) tag, (bit[128]) b) = ([tag] : b) +(* When saving/restoring capabilities xor them with bits of null_cap -- + this ensures that canonical null_cap is always all-zeros in memory + even though it may have bits set logically (e.g. length or exponent *) + +let (bit[128]) null_cap_bits = capStructToMemBits128(null_cap) + +function (bit[128]) capStructToMemBits((CapStruct) cap) = + capStructToMemBits128(cap) ^ null_cap_bits + +function (bit[129]) memBitsToCapBits((bool) tag, (bit[128]) b) = + memBitsToCapBits128(tag, b ^ null_cap_bits) + function (bit[31]) getCapPerms((CapStruct) cap) = let (bit[15]) perms = EXTS(getCapHardPerms(cap)) in (* NB access_system copied into 14-11 *) (0x000 (* uperms 30-19 *) diff --git a/cheri/cheri_prelude_256.sail b/cheri/cheri_prelude_256.sail index f41d9c14..1b13e408 100644 --- a/cheri/cheri_prelude_256.sail +++ b/cheri/cheri_prelude_256.sail @@ -78,7 +78,7 @@ let (CapStruct) null_cap = { sealed = false; offset = 0; base = 0; - length = 0; + length = 0xffffffffffffffff; } def Nat cap_size_t = 32 (* cap size in bytes *) @@ -130,7 +130,7 @@ function (bit[31]) getCapPerms((CapStruct) cap) = - this is the same as register format except for the offset, field which is stored as an absolute cursor on CHERI due to uarch optimisation *) -function (bit[256]) capStructToMemBits((CapStruct) cap) = +function (bit[256]) capStructToMemBits256((CapStruct) cap) = ( cap.padding : cap.otype @@ -144,13 +144,25 @@ function (bit[256]) capStructToMemBits((CapStruct) cap) = (* Reverse of above used when reading from memory *) -function (bit[257]) memBitsToCapBits((bool) tag, (bit[256]) b) = +function (bit[257]) memBitsToCapBits256((bool) tag, (bit[256]) b) = ([tag] : b[255..192] : ((bit[64])(b[191..128] - b[127..64])) : b[127..0] ) +(* When saving/restoring capabilities xor them with bits of null_cap -- + this ensures that canonical null_cap is always all-zeros in memory + even though it may have bits set logically (e.g. length or exponent *) + +let (bit[256]) null_cap_bits = capStructToMemBits256(null_cap) + +function (bit[256]) capStructToMemBits((CapStruct) cap) = + capStructToMemBits256(cap) ^ null_cap_bits + +function (bit[257]) memBitsToCapBits((bool) tag, (bit[256]) b) = + memBitsToCapBits256(tag, b ^ null_cap_bits) + function (CapReg) capStructToCapReg((CapStruct) cap) = ( [cap.tag] -- cgit v1.2.3 From 29182cd14e228529b3e26ef901e927bde8d27345 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 24 Oct 2017 15:44:10 +0100 Subject: fix default cap value on cheri128 following previous changes -- E stored in registers is no longer xored with 48 so need to initialise it. Also use E and T values used by CHERI hw and adjust decoding functions appropriately. Fix shift functions for ocaml shallow embedding which failed to handle shifts greater than vector length. --- cheri/cheri_prelude_128.sail | 8 ++++---- mips/run_embed.ml | 2 +- src/gen_lib/sail_values.ml | 27 +++++++++++++++++---------- src/lem_interp/run_with_elf_cheri128.ml | 2 +- 4 files changed, 23 insertions(+), 16 deletions(-) diff --git a/cheri/cheri_prelude_128.sail b/cheri/cheri_prelude_128.sail index 9bc0e2d2..fbb4c21c 100644 --- a/cheri/cheri_prelude_128.sail +++ b/cheri/cheri_prelude_128.sail @@ -195,23 +195,23 @@ function [|-1:1|] a_top_correction((bit[20]) a_mid, (bit[20]) R, (bit[20]) bound } function uint64 getCapBase((CapStruct) c) = - let ([|45|]) E = min(unsigned(c.E), 45) in + let ([|48|]) E = min(unsigned(c.E), 48) in let (bit[20]) B = c.B in let (bit[65]) a = EXTZ(c.address) in let (bit[20]) R = B - 0x01000 in (* wraps *) - let (bit[20]) a_mid = a[(E + 19)..E] in + let (bit[20]) a_mid = mask(a >> E) in let correction = a_top_correction(a_mid, R, B) in let a_top = a >> (E+20) in let (bit[64]) base = EXTZ((a_top + correction) : B) << E in unsigned(base) function CapLen getCapTop ((CapStruct) c) = - let ([|45|]) E = min(unsigned(c.E), 45) in + let ([|48|]) E = min(unsigned(c.E), 48) in let (bit[20]) B = c.B in let (bit[20]) T = c.T in let (bit[65]) a = EXTZ(c.address) in let (bit[20]) R = B - 0x01000 in (* wraps *) - let (bit[20]) a_mid = a[(E + 19)..E] in + let (bit[20]) a_mid = mask(a >> E) in let correction = a_top_correction(a_mid, R, T) in let a_top = a >> (E+20) in let (bit[65]) top1 = EXTZ((a_top + correction) : T) in diff --git a/mips/run_embed.ml b/mips/run_embed.ml index 463caffd..9dd063b1 100644 --- a/mips/run_embed.ml +++ b/mips/run_embed.ml @@ -250,7 +250,7 @@ module CHERI128_model : ISA_model = struct let start_addr = (to_vec_dec_big (bi64, big_int_of_string "0x9000000040000000")) in set_register Cheri128_embed._nextPC start_addr; set_register_field_bit Cheri128_embed._CP0Status "BEV" Vone; - let initial_cap_val_int = big_int_of_string "0x1fffe0000000800000000000000000000" in (* hex((0x80000 << 64) + (0x7fff << 113) + (1 << 128)) *) + let initial_cap_val_int = big_int_of_string "0x1fffe6000000100000000000000000000" in (* hex((0x10000 << 64) + (48 << 105) + (0x7fff << 113) + (1 << 128)) T=0x10000 E=48 perms=0x7fff tag=1 *) let initial_cap_vec = to_vec_dec ((bi129), initial_cap_val_int) in set_register Cheri128_embed._PCC initial_cap_vec; set_register Cheri128_embed._nextPCC initial_cap_vec; diff --git a/src/gen_lib/sail_values.ml b/src/gen_lib/sail_values.ml index d160e84a..213acea1 100644 --- a/src/gen_lib/sail_values.ml +++ b/src/gen_lib/sail_values.ml @@ -889,18 +889,25 @@ let shift_op_vec_int op (l,r) = let len = Array.length array in (match op with | "<<" -> - let left = Array.sub array r (len - r) in - let right = Array.make r Vzero in - let result = Array.append left right in - Vvector(result, start, ord) + if (r <= len) then + let left = Array.sub array r (len - r) in + let right = Array.make r Vzero in + let result = Array.append left right in + Vvector(result, start, ord) + else + Vvector(Array.make len Vzero, start, ord) | ">>" -> - let left = Array.make r Vzero in - let right = Array.sub array 0 (len - r) in - let result = Array.append left right in - Vvector(result, start, ord) + if (r <= len) then + let left = Array.make r Vzero in + let right = Array.sub array 0 (len - r) in + let result = Array.append left right in + Vvector(result, start, ord) + else + Vvector(Array.make len Vzero, start, ord) | "<<<" -> - let left = Array.sub array r (len - r) in - let right = Array.sub array 0 r in + let rmod = r mod len in + let left = Array.sub array rmod (len - rmod) in + let right = Array.sub array 0 rmod in let result = Array.append left right in Vvector(result, start, ord) | _ -> assert false) diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml index 3ad507bc..f4f319ea 100644 --- a/src/lem_interp/run_with_elf_cheri128.ml +++ b/src/lem_interp/run_with_elf_cheri128.ml @@ -665,7 +665,7 @@ let cheri_register_data_all = mips_register_data_all @ [ let initial_stack_and_reg_data_of_MIPS_elf_file e_entry all_data_memory = let initial_stack_data = [] in - let initial_cap_val_int = Nat_big_num.of_string "0x1fffe0000000800000000000000000000" in (* hex((0x80000 << 64) + (0x7fff << 113) + (1 << 128)) *) + let initial_cap_val_int = Nat_big_num.of_string "0x1fffe6000000100000000000000000000" in (* hex((0x10000 << 64) + (48 << 105) + (0x7fff << 113) + (1 << 128)) T=0x10000 E=48 perms=0x7fff tag=1 *) let initial_cap_val_reg = Sail_impl_base.register_value_of_integer 129 128 D_decreasing initial_cap_val_int in let initial_register_abi_data : (string * Sail_impl_base.register_value) list = [ ("CP0Status", Sail_impl_base.register_value_of_integer 32 31 D_decreasing (Nat_big_num.of_string "0x00400000")); -- cgit v1.2.3 From dc62ae8cf283cdf71c0cd2001d57abc77bc52673 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 26 Oct 2017 11:40:35 +0100 Subject: fixed release acquire semantics of AMOs --- risc-v/riscv.sail | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index f36dba57..4938aaca 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -365,14 +365,14 @@ function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { (bit[64]) addr := rGPR(rs1); switch (width) { - case WORD -> mem_write_ea(addr, 4, aq, rl, true) - case DOUBLE -> mem_write_ea(addr, 8, aq, rl, true) + case WORD -> mem_write_ea(addr, 4, aq & rl, rl, true) + case DOUBLE -> mem_write_ea(addr, 8, aq & rl, rl, true) }; (bit[64]) loaded := switch (width) { - case WORD -> EXTS(mem_read(addr, 4, aq, rl, true)) - case DOUBLE -> mem_read(addr, 8, aq, rl, true) + case WORD -> EXTS(mem_read(addr, 4, aq, aq & rl, true)) + case DOUBLE -> mem_read(addr, 8, aq, aq & rl, true) }; wGPR(rd, loaded); @@ -392,8 +392,8 @@ function clause execute (AMO(op, aq, rl, rs2, rs1, width, rd)) = { }; switch (width) { - case WORD -> mem_write_value(addr, 4, result[31..0], aq, rl, true) - case DOUBLE -> mem_write_value(addr, 8, result, aq, rl, true) + case WORD -> mem_write_value(addr, 4, result[31..0], aq & rl, rl, true) + case DOUBLE -> mem_write_value(addr, 8, result, aq & rl, rl, true) }; } -- cgit v1.2.3 From b41ee79485e155f67099b007650d73f449db1961 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 31 Oct 2017 11:01:10 +0000 Subject: cheri: ccall selector 1 should have a branch delay slot. TODO we need to throw exception for access to IDC/C26 in branch delay slot. --- cheri/cheri_insts.sail | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index c27f6dc7..50399785 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -1057,9 +1057,9 @@ function clause execute (CCall(cs, cb, 0b00000000001)) = (* selector=1 *) sealed=false; otype=0; }) in { - nextPC := (bit[64]) (getCapOffset(cs_val)); - nextPCC := csUnsealed; + delayedPC := (bit[64]) (getCapOffset(cs_val)); delayedPCC := csUnsealed; + branchPending := true; C26 := capStructToCapReg({cb_val with sealed=false; otype=0; -- cgit v1.2.3 From a35692d69681683c2bffe7c824ad230b88679ed9 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 31 Oct 2017 16:09:46 +0000 Subject: cheri: throw an exception if there is an attempt to access C26/IDC in the delay slot of a ccall selector 1 call. --- cheri/cheri_insts.sail | 1 + cheri/cheri_prelude_common.sail | 12 ++++++++++-- mips/run_embed.ml | 10 ++++++++-- src/lem_interp/run_with_elf_cheri.ml | 2 ++ src/lem_interp/run_with_elf_cheri128.ml | 2 ++ 5 files changed, 23 insertions(+), 4 deletions(-) diff --git a/cheri/cheri_insts.sail b/cheri/cheri_insts.sail index 50399785..5687a275 100644 --- a/cheri/cheri_insts.sail +++ b/cheri/cheri_insts.sail @@ -1060,6 +1060,7 @@ function clause execute (CCall(cs, cb, 0b00000000001)) = (* selector=1 *) delayedPC := (bit[64]) (getCapOffset(cs_val)); delayedPCC := csUnsealed; branchPending := true; + inCCallDelay := true; C26 := capStructToCapReg({cb_val with sealed=false; otype=0; diff --git a/cheri/cheri_prelude_common.sail b/cheri/cheri_prelude_common.sail index dcb56d01..fa36decb 100644 --- a/cheri/cheri_prelude_common.sail +++ b/cheri/cheri_prelude_common.sail @@ -35,6 +35,7 @@ register CapReg PCC register CapReg nextPCC register CapReg delayedPCC +register (bit[1]) inCCallDelay register CapReg C00 (* aka default data capability, DDC *) register CapReg C01 register CapReg C02 @@ -105,6 +106,7 @@ typedef CapEx = enumerate { CapEx_PermitSealViolation; CapEx_AccessSystemRegsViolation; CapEx_PermitCCallViolation; + CapEx_AccessCCallIDCViolation; } typedef CPtrCmpOp = enumerate { @@ -148,6 +150,7 @@ function (bit[8]) CapExCode((CapEx) ex) = case CapEx_PermitSealViolation -> 0x17 case CapEx_AccessSystemRegsViolation -> 0x18 case CapEx_PermitCCallViolation -> 0x19 + case CapEx_AccessCCallIDCViolation -> 0x1a } typedef CapCauseReg = register bits [15:0] { @@ -194,7 +197,11 @@ function forall Type 'o . 'o raise_c2_exception8((CapEx) capEx, (bit[8]) regnum) } function forall Type 'o . 'o raise_c2_exception((CapEx) capEx, (regno) regnum) = - raise_c2_exception8(capEx, 0b000 : regnum) + let reg8 = 0b000 : regnum in + if ((capEx == CapEx_AccessSystemRegsViolation) & (regnum == 26 (* IDC *))) then + raise_c2_exception8(CapEx_AccessCCallIDCViolation, reg8) + else + raise_c2_exception8(capEx, reg8) function forall Type 'o . 'o raise_c2_exception_noreg((CapEx) capEx) = raise_c2_exception8(capEx, 0xff) @@ -203,7 +210,8 @@ function bool pcc_access_system_regs () = let pcc = capRegToCapStruct(PCC) in (pcc.access_system_regs) -function bool register_inaccessible((regno) r) = +function bool register_inaccessible((regno) r) = + if ((r == 26 (* IDC *)) & inCCallDelay) then true else let is_sys_reg = switch(r) { case 0b11011 -> true case 0b11100 -> true diff --git a/mips/run_embed.ml b/mips/run_embed.ml index 9dd063b1..1bb6d5f6 100644 --- a/mips/run_embed.ml +++ b/mips/run_embed.ml @@ -219,7 +219,10 @@ module CHERI_model : ISA_model = struct let pc_vaddr = unsigned_big(Cheri_embed._PC) in let npc_addr = add_int_big_int 4 pc_vaddr in let npc_vec = to_vec_dec_big (bi64, npc_addr) in - set_register Cheri_embed._nextPC npc_vec + begin + set_register Cheri_embed._nextPC npc_vec; + set_register Cheri_embed._inCCallDelay (to_vec_dec_int (1, 0)) + end let get_pc () = unsigned_big (Cheri_embed._PC) @@ -277,7 +280,10 @@ module CHERI128_model : ISA_model = struct let pc_vaddr = unsigned_big(Cheri128_embed._PC) in let npc_addr = add_int_big_int 4 pc_vaddr in let npc_vec = to_vec_dec_big (bi64, npc_addr) in - set_register Cheri128_embed._nextPC npc_vec + begin + set_register Cheri128_embed._nextPC npc_vec; + set_register Cheri128_embed._inCCallDelay (to_vec_dec_int (1, 0)) + end let get_pc () = unsigned_big (Cheri128_embed._PC) diff --git a/src/lem_interp/run_with_elf_cheri.ml b/src/lem_interp/run_with_elf_cheri.ml index b879f702..b50cb01d 100644 --- a/src/lem_interp/run_with_elf_cheri.ml +++ b/src/lem_interp/run_with_elf_cheri.ml @@ -493,6 +493,7 @@ let mips_register_data_all = [ ("PC", (D_decreasing, 64, 63)); ("branchPending", (D_decreasing, 1, 0)); ("inBranchDelay", (D_decreasing, 1, 0)); + ("inCCallDelay", (D_decreasing, 1, 0)); ("delayedPC", (D_decreasing, 64, 63)); ("nextPC", (D_decreasing, 64, 63)); (* General purpose registers *) @@ -1072,6 +1073,7 @@ let set_next_instruction_address model = begin reg := Reg.add "nextPC" n_pc !reg; reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; + reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; end | (Some pc_val, Some 1) -> (* delay slot -- branch to delayed PC and clear branchPending *) diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml index f4f319ea..148b29ae 100644 --- a/src/lem_interp/run_with_elf_cheri128.ml +++ b/src/lem_interp/run_with_elf_cheri128.ml @@ -493,6 +493,7 @@ let mips_register_data_all = [ ("PC", (D_decreasing, 64, 63)); ("branchPending", (D_decreasing, 1, 0)); ("inBranchDelay", (D_decreasing, 1, 0)); + ("inCCallDelay", (D_decreasing, 1, 0)); ("delayedPC", (D_decreasing, 64, 63)); ("nextPC", (D_decreasing, 64, 63)); (* General purpose registers *) @@ -1072,6 +1073,7 @@ let set_next_instruction_address model = begin reg := Reg.add "nextPC" n_pc !reg; reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; + reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; end | (Some pc_val, Some 1) -> (* delay slot -- branch to delayed PC and clear branchPending *) -- cgit v1.2.3 From 701d572adda905e6b2098a73c9af56f98212b4a3 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Tue, 31 Oct 2017 17:02:16 +0000 Subject: work around interpreter crash by adding cast. Likely this kind of thing will be resolved by merge of new_tc branch. --- cheri/cheri_prelude_common.sail | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cheri/cheri_prelude_common.sail b/cheri/cheri_prelude_common.sail index fa36decb..a84c118f 100644 --- a/cheri/cheri_prelude_common.sail +++ b/cheri/cheri_prelude_common.sail @@ -211,7 +211,7 @@ function bool pcc_access_system_regs () = (pcc.access_system_regs) function bool register_inaccessible((regno) r) = - if ((r == 26 (* IDC *)) & inCCallDelay) then true else + if ((r == 26 (* IDC *)) & ((bool)inCCallDelay)) then true else (* XXX interpreter crash without cast *) let is_sys_reg = switch(r) { case 0b11011 -> true case 0b11100 -> true -- cgit v1.2.3 From 8e5d44d17c71cf946e65e15de8df42de2af4c652 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Wed, 1 Nov 2017 14:17:08 +0000 Subject: added RISC-V "fence r,r" --- etc/regfp.sail | 1 + risc-v/hgen/parser.hgen | 2 +- risc-v/riscv.sail | 1 + risc-v/riscv_extras.lem | 1 + risc-v/riscv_extras_embed.lem | 2 ++ risc-v/riscv_extras_embed_sequential.lem | 2 ++ risc-v/riscv_regfp.sail | 1 + risc-v/riscv_types.sail | 1 + src/gen_lib/deep_shallow_convert.lem | 10 ++++++---- src/lem_interp/sail_impl_base.lem | 11 +++++++---- 10 files changed, 23 insertions(+), 9 deletions(-) diff --git a/etc/regfp.sail b/etc/regfp.sail index 15d1a489..cc057f2e 100644 --- a/etc/regfp.sail +++ b/etc/regfp.sail @@ -74,6 +74,7 @@ typedef barrier_kind = enumerate { Barrier_MIPS_SYNC; Barrier_RISCV_rw_rw; Barrier_RISCV_r_rw; + Barrier_RISCV_r_r; Barrier_RISCV_rw_w; Barrier_RISCV_w_w; Barrier_RISCV_i; diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index 82bb1d5b..cf0ca80b 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -26,10 +26,10 @@ { match ($2, $4) with | (Fence_RW, Fence_RW) -> `RISCVFENCE (0b0011, 0b0011) | (Fence_R, Fence_RW) -> `RISCVFENCE (0b0010, 0b0011) + | (Fence_R, Fence_R) -> `RISCVFENCE (0b0010, 0b0010) | (Fence_RW, Fence_W) -> `RISCVFENCE (0b0011, 0b0001) | (Fence_W, Fence_W) -> `RISCVFENCE (0b0001, 0b0001) | (Fence_RW, Fence_R) -> failwith "'fence rw,r' is not supported" - | (Fence_R, Fence_R) -> failwith "'fence r,r' is not supported" | (Fence_R, Fence_W) -> failwith "'fence r,w' is not supported" | (Fence_W, Fence_RW) -> failwith "'fence w,rw' is not supported" | (Fence_W, Fence_R) -> failwith "'fence w,r' is not supported" diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 4938aaca..e0a6efba 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -260,6 +260,7 @@ function clause execute (FENCE(pred, succ)) = { switch(pred, succ) { case (0b0011, 0b0011) -> MEM_fence_rw_rw() case (0b0010, 0b0011) -> MEM_fence_r_rw() + case (0b0010, 0b0010) -> MEM_fence_r_r() case (0b0011, 0b0001) -> MEM_fence_rw_w() case (0b0001, 0b0001) -> MEM_fence_w_w() case _ -> not_implemented("unsupported fence") diff --git a/risc-v/riscv_extras.lem b/risc-v/riscv_extras.lem index 280095e5..30043779 100644 --- a/risc-v/riscv_extras.lem +++ b/risc-v/riscv_extras.lem @@ -76,6 +76,7 @@ let speculate_conditional_success : excl_res = let barrier_functions = [ ("MEM_fence_rw_rw", Barrier_RISCV_rw_rw); ("MEM_fence_r_rw", Barrier_RISCV_r_rw); + ("MEM_fence_r_r", Barrier_RISCV_r_r); ("MEM_fence_rw_w", Barrier_RISCV_rw_w); ("MEM_fence_w_w", Barrier_RISCV_w_w); ("MEM_fence_i", Barrier_RISCV_i); diff --git a/risc-v/riscv_extras_embed.lem b/risc-v/riscv_extras_embed.lem index d89dc44c..32110079 100644 --- a/risc-v/riscv_extras_embed.lem +++ b/risc-v/riscv_extras_embed.lem @@ -53,12 +53,14 @@ let speculate_conditional_success () = excl_result () >>= fun b -> return (if b val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit +val MEM_fence_r_r : unit -> M unit val MEM_fence_rw_w : unit -> M unit val MEM_fence_w_w : unit -> M unit val MEM_fence_i : unit -> M unit 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_i () = barrier Barrier_RISCV_i diff --git a/risc-v/riscv_extras_embed_sequential.lem b/risc-v/riscv_extras_embed_sequential.lem index 1f2a0e47..3c922268 100644 --- a/risc-v/riscv_extras_embed_sequential.lem +++ b/risc-v/riscv_extras_embed_sequential.lem @@ -53,12 +53,14 @@ let speculate_conditional_success () = excl_result () >>= fun b -> return (if b val MEM_fence_rw_rw : unit -> M unit val MEM_fence_r_rw : unit -> M unit +val MEM_fence_r_r : unit -> M unit val MEM_fence_rw_w : unit -> M unit val MEM_fence_w_w : unit -> M unit val MEM_fence_i : unit -> M unit 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_i () = barrier Barrier_RISCV_i diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index 602f0bec..ad341c60 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -93,6 +93,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( switch(pred, succ) { case (0b0011, 0b0011) -> IK_barrier (Barrier_RISCV_rw_rw) case (0b0010, 0b0011) -> IK_barrier (Barrier_RISCV_r_rw) + case (0b0010, 0b0010) -> IK_barrier (Barrier_RISCV_r_r) case (0b0011, 0b0001) -> IK_barrier (Barrier_RISCV_rw_w) case (0b0001, 0b0001) -> IK_barrier (Barrier_RISCV_w_w) case _ -> exit "not implemented" diff --git a/risc-v/riscv_types.sail b/risc-v/riscv_types.sail index a11d5561..a7cda963 100644 --- a/risc-v/riscv_types.sail +++ b/risc-v/riscv_types.sail @@ -138,6 +138,7 @@ val extern unit -> bool effect {exmem} speculate_conditional_success val extern unit -> unit effect { barr } MEM_fence_rw_rw val extern unit -> unit effect { barr } MEM_fence_r_rw +val extern unit -> unit effect { barr } MEM_fence_r_r val extern unit -> unit effect { barr } MEM_fence_rw_w val extern unit -> unit effect { barr } MEM_fence_w_w val extern unit -> unit effect { barr } MEM_fence_i diff --git a/src/gen_lib/deep_shallow_convert.lem b/src/gen_lib/deep_shallow_convert.lem index 5a0dd99e..76880dbd 100644 --- a/src/gen_lib/deep_shallow_convert.lem +++ b/src/gen_lib/deep_shallow_convert.lem @@ -471,10 +471,11 @@ let barrier_kindToInterpValue = function | Barrier_MIPS_SYNC -> V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") Unknown) (T_id "barrier_kind") (C_Enum 12) (toInterpValue ()) | Barrier_RISCV_rw_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") Unknown) (T_id "barrier_kind") (C_Enum 13) (toInterpValue ()) | Barrier_RISCV_r_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") Unknown) (T_id "barrier_kind") (C_Enum 14) (toInterpValue ()) - | Barrier_RISCV_rw_w -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") Unknown) (T_id "barrier_kind") (C_Enum 15) (toInterpValue ()) - | Barrier_RISCV_w_w -> V_ctor (Id_aux (Id "Barrier_RISCV_w_w") Unknown) (T_id "barrier_kind") (C_Enum 16) (toInterpValue ()) - | Barrier_RISCV_i -> V_ctor (Id_aux (Id "Barrier_RISCV_i") Unknown) (T_id "barrier_kind") (C_Enum 17) (toInterpValue ()) - | Barrier_x86_MFENCE -> V_ctor (Id_aux (Id "Barrier_x86_MFENCE") Unknown) (T_id "barrier_kind") (C_Enum 18) (toInterpValue ()) + | Barrier_RISCV_r_r -> V_ctor (Id_aux (Id "Barrier_RISCV_r_r") Unknown) (T_id "barrier_kind") (C_Enum 15) (toInterpValue ()) + | Barrier_RISCV_rw_w -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") Unknown) (T_id "barrier_kind") (C_Enum 16) (toInterpValue ()) + | Barrier_RISCV_w_w -> V_ctor (Id_aux (Id "Barrier_RISCV_w_w") Unknown) (T_id "barrier_kind") (C_Enum 17) (toInterpValue ()) + | Barrier_RISCV_i -> V_ctor (Id_aux (Id "Barrier_RISCV_i") Unknown) (T_id "barrier_kind") (C_Enum 18) (toInterpValue ()) + | Barrier_x86_MFENCE -> V_ctor (Id_aux (Id "Barrier_x86_MFENCE") Unknown) (T_id "barrier_kind") (C_Enum 19) (toInterpValue ()) end let rec barrier_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Barrier_Sync") _) _ _ v -> Barrier_Sync @@ -492,6 +493,7 @@ let rec barrier_kindFromInterpValue v = match v with | V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") _) _ _ v -> Barrier_MIPS_SYNC | V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") _) _ _ v -> Barrier_RISCV_rw_rw | V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") _) _ _ v -> Barrier_RISCV_r_rw + | V_ctor (Id_aux (Id "Barrier_RISCV_r_r") _) _ _ v -> Barrier_RISCV_r_r | V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") _) _ _ v -> Barrier_RISCV_rw_w | V_ctor (Id_aux (Id "Barrier_RISCV_w_w") _) _ _ v -> Barrier_RISCV_w_w | V_ctor (Id_aux (Id "Barrier_RISCV_i") _) _ _ v -> Barrier_RISCV_i diff --git a/src/lem_interp/sail_impl_base.lem b/src/lem_interp/sail_impl_base.lem index 4f07f574..c0ec8548 100644 --- a/src/lem_interp/sail_impl_base.lem +++ b/src/lem_interp/sail_impl_base.lem @@ -501,6 +501,7 @@ type barrier_kind = (* RISC-V barriers *) | Barrier_RISCV_rw_rw | Barrier_RISCV_r_rw + | Barrier_RISCV_r_r | Barrier_RISCV_rw_w | Barrier_RISCV_w_w | Barrier_RISCV_i @@ -525,6 +526,7 @@ instance (Show barrier_kind) | Barrier_MIPS_SYNC -> "Barrier_MIPS_SYNC" | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw" | Barrier_RISCV_r_rw -> "Barrier_RISCV_r_rw" + | Barrier_RISCV_r_r -> "Barrier_RISCV_r_r" | Barrier_RISCV_rw_w -> "Barrier_RISCV_rw_w" | Barrier_RISCV_w_w -> "Barrier_RISCV_w_w" | Barrier_RISCV_i -> "Barrier_RISCV_i" @@ -621,10 +623,11 @@ instance (EnumerationType barrier_kind) | Barrier_MIPS_SYNC -> 12 | Barrier_RISCV_rw_rw -> 13 | Barrier_RISCV_r_rw -> 14 - | Barrier_RISCV_rw_w -> 15 - | Barrier_RISCV_w_w -> 16 - | Barrier_RISCV_i -> 17 - | Barrier_x86_MFENCE -> 18 + | Barrier_RISCV_r_r -> 15 + | Barrier_RISCV_rw_w -> 16 + | Barrier_RISCV_w_w -> 17 + | Barrier_RISCV_i -> 18 + | Barrier_x86_MFENCE -> 19 end end -- cgit v1.2.3 From 40a85677707395199a005c2742304b80be87e117 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Wed, 1 Nov 2017 18:42:17 +0000 Subject: workaound for another odd interpreter error where top level let variable got truncated to 64 bits... --- cheri/cheri_prelude_256.sail | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cheri/cheri_prelude_256.sail b/cheri/cheri_prelude_256.sail index 1b13e408..b2bc8b1f 100644 --- a/cheri/cheri_prelude_256.sail +++ b/cheri/cheri_prelude_256.sail @@ -155,12 +155,12 @@ function (bit[257]) memBitsToCapBits256((bool) tag, (bit[256]) b) = this ensures that canonical null_cap is always all-zeros in memory even though it may have bits set logically (e.g. length or exponent *) -let (bit[256]) null_cap_bits = capStructToMemBits256(null_cap) - function (bit[256]) capStructToMemBits((CapStruct) cap) = + let (bit[256]) null_cap_bits = capStructToMemBits256(null_cap) in capStructToMemBits256(cap) ^ null_cap_bits function (bit[257]) memBitsToCapBits((bool) tag, (bit[256]) b) = + let (bit[256]) null_cap_bits = capStructToMemBits256(null_cap) in memBitsToCapBits256(tag, b ^ null_cap_bits) function (CapReg) capStructToCapReg((CapStruct) cap) = -- cgit v1.2.3 From d91841f80740b210c673d3138f77b9d4d5684102 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Thu, 2 Nov 2017 14:06:24 +0000 Subject: reset inCCallDelay in code that is not dead. --- src/lem_interp/run_with_elf_cheri.ml | 1 + src/lem_interp/run_with_elf_cheri128.ml | 1 + 2 files changed, 2 insertions(+) diff --git a/src/lem_interp/run_with_elf_cheri.ml b/src/lem_interp/run_with_elf_cheri.ml index b50cb01d..8f7d5505 100644 --- a/src/lem_interp/run_with_elf_cheri.ml +++ b/src/lem_interp/run_with_elf_cheri.ml @@ -1285,6 +1285,7 @@ let rec fde_loop count context model mode track_dependencies addr_trans = let npc_addr = add_address_nat pc_val 4 in let npc_reg = register_value_of_address npc_addr Sail_impl_base.D_decreasing in reg := Reg.add "nextPC" npc_reg !reg; + reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; | Some 1 -> reg := Reg.add "nextPC" (Reg.find "delayedPC" !reg) !reg; reg := Reg.add "nextPCC" (Reg.find "delayedPCC" !reg) !reg; diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml index 148b29ae..311d6f69 100644 --- a/src/lem_interp/run_with_elf_cheri128.ml +++ b/src/lem_interp/run_with_elf_cheri128.ml @@ -1285,6 +1285,7 @@ let rec fde_loop count context model mode track_dependencies addr_trans = let npc_addr = add_address_nat pc_val 4 in let npc_reg = register_value_of_address npc_addr Sail_impl_base.D_decreasing in reg := Reg.add "nextPC" npc_reg !reg; + reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; | Some 1 -> reg := Reg.add "nextPC" (Reg.find "delayedPC" !reg) !reg; reg := Reg.add "nextPCC" (Reg.find "delayedPCC" !reg) !reg; -- cgit v1.2.3 From 5d59b0c1a477c2d9e1abcfc6fb1b51dff32bd9b5 Mon Sep 17 00:00:00 2001 From: Robert Norton Date: Thu, 2 Nov 2017 14:47:30 +0000 Subject: remove a lot of dead code form run_with_elf_cheri* --- src/lem_interp/run_with_elf_cheri.ml | 568 ------------------------------- src/lem_interp/run_with_elf_cheri128.ml | 570 -------------------------------- 2 files changed, 1138 deletions(-) diff --git a/src/lem_interp/run_with_elf_cheri.ml b/src/lem_interp/run_with_elf_cheri.ml index 8f7d5505..7750c16c 100644 --- a/src/lem_interp/run_with_elf_cheri.ml +++ b/src/lem_interp/run_with_elf_cheri.ml @@ -124,369 +124,6 @@ let register_state_zero register_data rbn : register_value = in register_value_zeros dir width start_index type model = PPC | AArch64 | MIPS -(* -let ppc_register_data_all = [ - (*Pseudo registers*) - ("CIA", (D_increasing, 64, 0)); - ("NIA", (D_increasing, 64, 0)); - ("mode64bit", (D_increasing, 1, 0)); - ("bigendianmode", (D_increasing, 1, 0)); - (* special registers *) - ("CR", (D_increasing, 32, 32)); - ("CTR", (D_increasing, 64, 0 )); - ("LR", (D_increasing, 64, 0 )); - ("XER", (D_increasing, 64, 0 )); - ("VRSAVE",(D_increasing, 32, 32)); - ("FPSCR", (D_increasing, 64, 0 )); - ("VSCR", (D_increasing, 32, 96)); - - (* general purpose registers *) - ("GPR0", (D_increasing, 64, 0 )); - ("GPR1", (D_increasing, 64, 0 )); - ("GPR2", (D_increasing, 64, 0 )); - ("GPR3", (D_increasing, 64, 0 )); - ("GPR4", (D_increasing, 64, 0 )); - ("GPR5", (D_increasing, 64, 0 )); - ("GPR6", (D_increasing, 64, 0 )); - ("GPR7", (D_increasing, 64, 0 )); - ("GPR8", (D_increasing, 64, 0 )); - ("GPR9", (D_increasing, 64, 0 )); - ("GPR10", (D_increasing, 64, 0 )); - ("GPR11", (D_increasing, 64, 0 )); - ("GPR12", (D_increasing, 64, 0 )); - ("GPR13", (D_increasing, 64, 0 )); - ("GPR14", (D_increasing, 64, 0 )); - ("GPR15", (D_increasing, 64, 0 )); - ("GPR16", (D_increasing, 64, 0 )); - ("GPR17", (D_increasing, 64, 0 )); - ("GPR18", (D_increasing, 64, 0 )); - ("GPR19", (D_increasing, 64, 0 )); - ("GPR20", (D_increasing, 64, 0 )); - ("GPR21", (D_increasing, 64, 0 )); - ("GPR22", (D_increasing, 64, 0 )); - ("GPR23", (D_increasing, 64, 0 )); - ("GPR24", (D_increasing, 64, 0 )); - ("GPR25", (D_increasing, 64, 0 )); - ("GPR26", (D_increasing, 64, 0 )); - ("GPR27", (D_increasing, 64, 0 )); - ("GPR28", (D_increasing, 64, 0 )); - ("GPR29", (D_increasing, 64, 0 )); - ("GPR30", (D_increasing, 64, 0 )); - ("GPR31", (D_increasing, 64, 0 )); - (* vector registers *) - ("VR0", (D_increasing, 128, 0 )); - ("VR1", (D_increasing, 128, 0 )); - ("VR2", (D_increasing, 128, 0 )); - ("VR3", (D_increasing, 128, 0 )); - ("VR4", (D_increasing, 128, 0 )); - ("VR5", (D_increasing, 128, 0 )); - ("VR6", (D_increasing, 128, 0 )); - ("VR7", (D_increasing, 128, 0 )); - ("VR8", (D_increasing, 128, 0 )); - ("VR9", (D_increasing, 128, 0 )); - ("VR10", (D_increasing, 128, 0 )); - ("VR11", (D_increasing, 128, 0 )); - ("VR12", (D_increasing, 128, 0 )); - ("VR13", (D_increasing, 128, 0 )); - ("VR14", (D_increasing, 128, 0 )); - ("VR15", (D_increasing, 128, 0 )); - ("VR16", (D_increasing, 128, 0 )); - ("VR17", (D_increasing, 128, 0 )); - ("VR18", (D_increasing, 128, 0 )); - ("VR19", (D_increasing, 128, 0 )); - ("VR20", (D_increasing, 128, 0 )); - ("VR21", (D_increasing, 128, 0 )); - ("VR22", (D_increasing, 128, 0 )); - ("VR23", (D_increasing, 128, 0 )); - ("VR24", (D_increasing, 128, 0 )); - ("VR25", (D_increasing, 128, 0 )); - ("VR26", (D_increasing, 128, 0 )); - ("VR27", (D_increasing, 128, 0 )); - ("VR28", (D_increasing, 128, 0 )); - ("VR29", (D_increasing, 128, 0 )); - ("VR30", (D_increasing, 128, 0 )); - ("VR31", (D_increasing, 128, 0 )); - (* floating-point registers *) - ("FPR0", (D_increasing, 64, 0 )); - ("FPR1", (D_increasing, 64, 0 )); - ("FPR2", (D_increasing, 64, 0 )); - ("FPR3", (D_increasing, 64, 0 )); - ("FPR4", (D_increasing, 64, 0 )); - ("FPR5", (D_increasing, 64, 0 )); - ("FPR6", (D_increasing, 64, 0 )); - ("FPR7", (D_increasing, 64, 0 )); - ("FPR8", (D_increasing, 64, 0 )); - ("FPR9", (D_increasing, 64, 0 )); - ("FPR10", (D_increasing, 64, 0 )); - ("FPR11", (D_increasing, 64, 0 )); - ("FPR12", (D_increasing, 64, 0 )); - ("FPR13", (D_increasing, 64, 0 )); - ("FPR14", (D_increasing, 64, 0 )); - ("FPR15", (D_increasing, 64, 0 )); - ("FPR16", (D_increasing, 64, 0 )); - ("FPR17", (D_increasing, 64, 0 )); - ("FPR18", (D_increasing, 64, 0 )); - ("FPR19", (D_increasing, 64, 0 )); - ("FPR20", (D_increasing, 64, 0 )); - ("FPR21", (D_increasing, 64, 0 )); - ("FPR22", (D_increasing, 64, 0 )); - ("FPR23", (D_increasing, 64, 0 )); - ("FPR24", (D_increasing, 64, 0 )); - ("FPR25", (D_increasing, 64, 0 )); - ("FPR26", (D_increasing, 64, 0 )); - ("FPR27", (D_increasing, 64, 0 )); - ("FPR28", (D_increasing, 64, 0 )); - ("FPR29", (D_increasing, 64, 0 )); - ("FPR30", (D_increasing, 64, 0 )); - ("FPR31", (D_increasing, 64, 0 )); -] - -let initial_stack_and_reg_data_of_PPC_elf_file e_entry all_data_memory = - (* set up initial registers, per 3.4.1 of 64-bit PowerPC ELF Application Binary Interface Supplement 1.9 *) - - let auxiliary_vector_space = Nat_big_num.of_string "17592186042368" (*"0xffffffff800"*) in - (* notionally there should be at least an AT_NULL auxiliary vector entry there, but our examples will never read it *) - - (* take start of stack roughly where running gdb on hello5 on bim says it is*) - let initial_GPR1_stack_pointer = Nat_big_num.of_string "17592186040320" (*"0xffffffff000"*) in - let initial_GPR1_stack_pointer_value = - Sail_impl_base.register_value_of_integer 64 0 Sail_impl_base.D_increasing initial_GPR1_stack_pointer in - (* ELF says we need an initial zero doubleword there *) - let initial_stack_data = - (* the code actually uses the stack, both above and below, so we map a bit more memory*) - (* this is a fairly big but arbitrary chunk *) - (* let initial_stack_data_address = Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128) in - [("initial_stack_data", initial_stack_data_address, Lem_list.replicate (128+32) 0 ))] in *) - (* this is the stack memory that test 1938 actually uses *) - [ ("initial_stack_data1", Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128), - Lem_list.replicate 8 0 ); - ("initial_stack_data2", Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 8), - Lem_list.replicate 8 0 ); - ("initial_stack_data3", Nat_big_num.add initial_GPR1_stack_pointer (Nat_big_num.of_int 16), - Lem_list.replicate 8 0 )] in - - (* read TOC from the second field of the function descriptor pointed to by e_entry*) - let initial_GPR2_TOC = - Sail_impl_base.register_value_of_address - (Sail_impl_base.address_of_byte_list - (List.map (fun b -> match b with Some b -> b | None -> failwith "Address had undefined") - (List.map byte_of_byte_lifted - (read_mem all_data_memory - (Nat_big_num.add (Nat_big_num.of_int 8) e_entry) 8)))) - Sail_impl_base.D_increasing in - (* these initial register values are all mandated to be zero, but that's handled by the generic zeroing below - let initial_GPR3_argc = (Nat_big_num.of_int 0) in - let initial_GPR4_argv = (Nat_big_num.of_int 0) in - let initial_GPR5_envp = (Nat_big_num.of_int 0) in - let initial_FPSCR = (Nat_big_num.of_int 0) in - *) - let initial_register_abi_data : (string * Sail_impl_base.register_value) list = - [ ("GPR1", initial_GPR1_stack_pointer_value); - ("GPR2", initial_GPR2_TOC); - (* - ("GPR3", initial_GPR3_argc); - ("GPR4", initial_GPR4_argv); - ("GPR5", initial_GPR5_envp); - ("FPSCR", initial_FPSCR); - *) - ] in - - (initial_stack_data, initial_register_abi_data) - - -let aarch64_reg bit_count name = (name, (D_decreasing, bit_count, bit_count - 1)) - -let aarch64_PC_data = [aarch64_reg 64 "_PC"] - -(* most of the PSTATE fields are aliases to other registers so they - don't appear here *) -let aarch64_PSTATE_data = [ - aarch64_reg 1 "PSTATE_nRW"; - aarch64_reg 1 "PSTATE_E"; - aarch64_reg 5 "PSTATE_M"; -] - -let aarch64_general_purpose_registers_data = [ - aarch64_reg 64 "R0"; - aarch64_reg 64 "R1"; - aarch64_reg 64 "R2"; - aarch64_reg 64 "R3"; - aarch64_reg 64 "R4"; - aarch64_reg 64 "R5"; - aarch64_reg 64 "R6"; - aarch64_reg 64 "R7"; - aarch64_reg 64 "R8"; - aarch64_reg 64 "R9"; - aarch64_reg 64 "R10"; - aarch64_reg 64 "R11"; - aarch64_reg 64 "R12"; - aarch64_reg 64 "R13"; - aarch64_reg 64 "R14"; - aarch64_reg 64 "R15"; - aarch64_reg 64 "R16"; - aarch64_reg 64 "R17"; - aarch64_reg 64 "R18"; - aarch64_reg 64 "R19"; - aarch64_reg 64 "R20"; - aarch64_reg 64 "R21"; - aarch64_reg 64 "R22"; - aarch64_reg 64 "R23"; - aarch64_reg 64 "R24"; - aarch64_reg 64 "R25"; - aarch64_reg 64 "R26"; - aarch64_reg 64 "R27"; - aarch64_reg 64 "R28"; - aarch64_reg 64 "R29"; - aarch64_reg 64 "R30"; -] - -let aarch64_SIMD_registers_data = [ - aarch64_reg 128 "V0"; - aarch64_reg 128 "V1"; - aarch64_reg 128 "V2"; - aarch64_reg 128 "V3"; - aarch64_reg 128 "V4"; - aarch64_reg 128 "V5"; - aarch64_reg 128 "V6"; - aarch64_reg 128 "V7"; - aarch64_reg 128 "V8"; - aarch64_reg 128 "V9"; - aarch64_reg 128 "V10"; - aarch64_reg 128 "V11"; - aarch64_reg 128 "V12"; - aarch64_reg 128 "V13"; - aarch64_reg 128 "V14"; - aarch64_reg 128 "V15"; - aarch64_reg 128 "V16"; - aarch64_reg 128 "V17"; - aarch64_reg 128 "V18"; - aarch64_reg 128 "V19"; - aarch64_reg 128 "V20"; - aarch64_reg 128 "V21"; - aarch64_reg 128 "V22"; - aarch64_reg 128 "V23"; - aarch64_reg 128 "V24"; - aarch64_reg 128 "V25"; - aarch64_reg 128 "V26"; - aarch64_reg 128 "V27"; - aarch64_reg 128 "V28"; - aarch64_reg 128 "V29"; - aarch64_reg 128 "V30"; - aarch64_reg 128 "V31"; -] - -let aarch64_special_purpose_registers_data = [ - aarch64_reg 32 "CurrentEL"; - aarch64_reg 32 "DAIF"; - aarch64_reg 32 "NZCV"; - aarch64_reg 64 "SP_EL0"; - aarch64_reg 64 "SP_EL1"; - aarch64_reg 64 "SP_EL2"; - aarch64_reg 64 "SP_EL3"; - aarch64_reg 32 "SPSel"; - aarch64_reg 32 "SPSR_EL1"; - aarch64_reg 32 "SPSR_EL2"; - aarch64_reg 32 "SPSR_EL3"; - aarch64_reg 64 "ELR_EL1"; - aarch64_reg 64 "ELR_EL2"; - aarch64_reg 64 "ELR_EL3"; -] - -let aarch64_general_system_control_registers_data = [ - aarch64_reg 64 "HCR_EL2"; - aarch64_reg 64 "ID_AA64MMFR0_EL1"; - aarch64_reg 64 "RVBAR_EL1"; - aarch64_reg 64 "RVBAR_EL2"; - aarch64_reg 64 "RVBAR_EL3"; - aarch64_reg 32 "SCR_EL3"; - aarch64_reg 32 "SCTLR_EL1"; - aarch64_reg 32 "SCTLR_EL2"; - aarch64_reg 32 "SCTLR_EL3"; - aarch64_reg 64 "TCR_EL1"; - aarch64_reg 32 "TCR_EL2"; - aarch64_reg 32 "TCR_EL3"; -] - -let aarch64_debug_registers_data = [ - aarch64_reg 32 "DBGPRCR_EL1"; - aarch64_reg 32 "OSDLR_EL1"; -] - -let aarch64_performance_monitors_registers_data = [] -let aarch64_generic_timer_registers_data = [] -let aarch64_generic_interrupt_controller_CPU_interface_registers_data = [] - -let aarch64_external_debug_registers_data = [ - aarch64_reg 32 "EDSCR"; -] - -let aarch32_general_system_control_registers_data = [ - aarch64_reg 32 "SCR"; -] - -let aarch32_debug_registers_data = [ - aarch64_reg 32 "DBGOSDLR"; - aarch64_reg 32 "DBGPRCR"; -] - -let aarch64_register_data_all = - aarch64_PC_data @ - aarch64_PSTATE_data @ - aarch64_general_purpose_registers_data @ - aarch64_SIMD_registers_data @ - aarch64_special_purpose_registers_data @ - aarch64_general_system_control_registers_data @ - aarch64_debug_registers_data @ - aarch64_performance_monitors_registers_data @ - aarch64_generic_timer_registers_data @ - aarch64_generic_interrupt_controller_CPU_interface_registers_data @ - aarch64_external_debug_registers_data @ - aarch32_general_system_control_registers_data @ - aarch32_debug_registers_data - -let initial_stack_and_reg_data_of_AAarch64_elf_file e_entry all_data_memory = - let (reg_SP_EL0_direction, reg_SP_EL0_width, reg_SP_EL0_initial_index) = - List.assoc "SP_EL0" aarch64_register_data_all in - - (* we compiled a small program that prints out SP and run it a few - times on the Nexus9, these are the results: - 0x0000007fe7f903e0 - 0x0000007fdcdbf3f0 - 0x0000007fcbe1ba90 - 0x0000007fcf378280 - 0x0000007fdd54b8d0 - 0x0000007fd961bc10 - 0x0000007ff3be6350 - 0x0000007fd6bf6ef0 - 0x0000007fff7676f0 - 0x0000007ff2c34560 *) - let initial_SP_EL0 = Nat_big_num.of_string "549739036672" (*"0x0000007fff000000"*) in - let initial_SP_EL0_value = - Sail_impl_base.register_value_of_integer - reg_SP_EL0_width - reg_SP_EL0_initial_index - reg_SP_EL0_direction - initial_SP_EL0 - in - - (* ELF says we need an initial zero doubleword there *) - (* the code actually uses the stack, both above and below, so we map a bit more memory*) - let initial_stack_data = - (* this is a fairly big but arbitrary chunk: *) - (* let initial_stack_data_address = Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128) in - [("initial_stack_data", initial_stack_data_address, Lem_list.replicate (128+32) 0 ))] in *) - - [ ("initial_stack_data1", Nat_big_num.sub initial_SP_EL0 (Nat_big_num.of_int 16), Lem_list.replicate 8 0); - ("initial_stack_data2", Nat_big_num.sub initial_SP_EL0 (Nat_big_num.of_int 8), Lem_list.replicate 8 0) - ] - in - - let initial_register_abi_data : (string * Sail_impl_base.register_value) list = - [("SP_EL0", initial_SP_EL0_value)] - in - - (initial_stack_data, initial_register_abi_data) -*) let mips_register_data_all = [ (*Pseudo registers*) @@ -749,50 +386,6 @@ let initial_system_state_of_elf_file name = let (isa_defs, isa_memory_access, isa_externs, isa_model, model_reg_d, startaddr, initial_stack_data, initial_register_abi_data, register_data_all) = match Nat_big_num.to_int e_machine with -(* | 21 (* EM_PPC64 *) -> - let startaddr = - let e_entry = Uint64.of_int64 (Nat_big_num.to_int64 e_entry) in - match Abi_power64.abi_power64_compute_program_entry_point segments e_entry with - | Error.Fail s -> failwith "Failed computing entry point" - | Error.Success s -> Nat_big_num.of_int64 (Uint64.to_int64 s) - in - let (initial_stack_data, initial_register_abi_data) = - initial_stack_and_reg_data_of_PPC_elf_file e_entry !data_mem in - - (Power.defs, - (Power_extras.read_memory_functions,Power_extras.memory_writes,[],[],Power_extras.barrier_functions), - Power_extras.power_externs, - PPC, - D_increasing, - startaddr, - initial_stack_data, - initial_register_abi_data, - ppc_register_data_all) - - | 183 (* EM_AARCH64 *) -> - let startaddr = - let e_entry = Uint64.of_int64 (Nat_big_num.to_int64 e_entry) in - match Abi_aarch64_le.abi_aarch64_le_compute_program_entry_point segments e_entry with - | Error.Fail s -> failwith "Failed computing entry point" - | Error.Success s -> Nat_big_num.of_int64 (Uint64.to_int64 s) - in - - let (initial_stack_data, initial_register_abi_data) = - initial_stack_and_reg_data_of_AAarch64_elf_file e_entry !data_mem in - - (ArmV8.defs, - (ArmV8_extras.aArch64_read_memory_functions, - ArmV8_extras.aArch64_memory_writes, - ArmV8_extras.aArch64_memory_eas, - ArmV8_extras.aArch64_memory_vals, - ArmV8_extras.aArch64_barrier_functions), - [], - AArch64, - D_decreasing, - startaddr, - initial_stack_data, - initial_register_abi_data, - aarch64_register_data_all) *) | 8 (* EM_MIPS *) -> let startaddr = let e_entry = Uint64.of_string (Nat_big_num.to_string e_entry) in @@ -889,50 +482,6 @@ let initial_system_state_of_elf_file name = in - (* Now we examine the rest of the data memory, - removing the footprint of the symbols and chunking it into aligned chunks *) - - let rec remove_symbols_from_data_memory data_mem symbols = - match symbols with - | [] -> data_mem - | (name,address,size,bs)::symbols' -> - let data_mem' = - Mem.filter - (fun a v -> - not (Nat_big_num.greater_equal a address && - Nat_big_num.less a (Nat_big_num.add (Nat_big_num.of_int (List.length bs)) address))) - data_mem in - remove_symbols_from_data_memory data_mem' symbols' in - - let trimmed_data_memory : (Nat_big_num.num * memory_byte) list = - Mem.bindings (remove_symbols_from_data_memory !data_mem symbol_table) in - - (* make sure that's ordered increasingly.... *) - let trimmed_data_memory = - List.sort (fun (a,b) (a',b') -> Nat_big_num.compare a a') trimmed_data_memory in - - let aligned a n = (* a mod n = 0 *) - let n_big = Nat_big_num.of_int n in - Nat_big_num.equal (Nat_big_num.modulus a n_big) ((Nat_big_num.of_int 0)) in - - let isplus a' a n = (* a' = a+n *) - Nat_big_num.equal a' (Nat_big_num.add (Nat_big_num.of_int n) a) in - - let rec chunk_data_memory dm = - match dm with - | (a0,b0)::(a1,b1)::(a2,b2)::(a3,b3)::(a4,b4)::(a5,b5)::(a6,b6)::(a7,b7)::dm' when - (aligned a0 8 && isplus a1 a0 1 && isplus a2 a0 2 && isplus a3 a0 3 && - isplus a4 a0 4 && isplus a5 a0 5 && isplus a6 a0 6 && isplus a7 a0 7) -> - (a0,8,[b0;b1;b2;b3;b4;b5;b6;b7]) :: chunk_data_memory dm' - | (a0,b0)::(a1,b1)::(a2,b2)::(a3,b3)::dm' when - (aligned a0 4 && isplus a1 a0 1 && isplus a2 a0 2 && isplus a3 a0 3) -> - (a0,4,[b0;b1;b2;b3]) :: chunk_data_memory dm' - | (a0,b0)::(a1,b1)::dm' when - (aligned a0 2 && isplus a1 a0 1) -> - (a0,2,[b0;b1]) :: chunk_data_memory dm' - | (a0,b0)::dm' -> - (a0,1,[b0]):: chunk_data_memory dm' - | [] -> [] in let initial_register_state = fun rbn -> @@ -1022,69 +571,10 @@ let stop_condition_met model instr = true | _ -> false) -let is_branch model instruction = - let (name,_,_) = instruction in - match (model , name) with - | (PPC, "B") -> true - | (PPC, "Bc") -> true - | (PPC, "Bclr") -> true - | (PPC, "Bcctr") -> true - | (PPC, _) -> false - | (AArch64, "BranchImmediate") -> true - | (AArch64, "BranchConditional") -> true - | (AArch64, "CompareAndBranch") -> true - | (AArch64, "TestBitAndBranch") -> true - | (AArch64, "BranchRegister") -> true - | (AArch64, _) -> false - | (MIPS, _) -> false (*todo,fill this in*) - let option_int_of_option_integer i = match i with | Some i -> Some (Nat_big_num.to_int i) | None -> None -let set_next_instruction_address model = - match model with - | PPC -> - let cia = Reg.find "CIA" !reg in - let cia_addr = address_of_register_value cia in - (match cia_addr with - | Some cia_addr -> - let nia_addr = add_address_nat cia_addr 4 in - let nia = register_value_of_address nia_addr Sail_impl_base.D_increasing in - reg := Reg.add "NIA" nia !reg - | _ -> failwith "CIA address contains unknown or undefined") - | AArch64 -> - let pc = Reg.find "_PC" !reg in - let pc_addr = address_of_register_value pc in - (match pc_addr with - | Some pc_addr -> - let n_addr = add_address_nat pc_addr 4 in - let n_pc = register_value_of_address n_addr D_decreasing in - reg := Reg.add "_PC" n_pc !reg - | _ -> failwith "_PC address contains unknown or undefined") - | MIPS -> - let pc_addr = address_of_register_value (Reg.find "PC" !reg) in - let branchPending = integer_of_register_value (Reg.find "branchPending" !reg) in - (match (pc_addr, option_int_of_option_integer branchPending) with - | (Some pc_val, Some 0) -> - (* normal -- increment PC *) - let n_addr = add_address_nat pc_val 4 in - let n_pc = register_value_of_address n_addr D_decreasing in - begin - reg := Reg.add "nextPC" n_pc !reg; - reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - end - | (Some pc_val, Some 1) -> - (* delay slot -- branch to delayed PC and clear branchPending *) - begin - reg := Reg.add "nextPC" (Reg.find "delayedPC" !reg) !reg; - reg := Reg.add "nextPCC" (Reg.find "delayedPCC" !reg) !reg; - reg := Reg.add "branchPending" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing (Nat_big_num.of_int 1)) !reg; - end - | (_, _) -> errorf "PC address contains unknown or undefined"; exit 1) - let add1 = Nat_big_num.add (Nat_big_num.of_int 1) let get_addr_trans_regs _ = @@ -1194,68 +684,10 @@ let rec write_events = function | _ -> failwith "Only register write events expected"); write_events events -let fetch_instruction_opcode_and_update_ia model addr_trans = - match model with - | PPC -> - let cia = Reg.find "CIA" !reg in - let cia_addr = address_of_register_value cia in - (match cia_addr with - | Some cia_addr -> - let cia_a = integer_of_address cia_addr in - let opcode = (get_opcode cia_a) in - begin - reg := Reg.add "CIA" (Reg.find "NIA" !reg) !reg; - Opcode opcode - end - | None -> failwith "CIA address contains unknown or undefined") - | AArch64 -> - let pc = Reg.find "_PC" !reg in - let pc_addr = address_of_register_value pc in - (match pc_addr with - | Some pc_addr -> - let pc_a = integer_of_address pc_addr in - let opcode = (get_opcode pc_a) in - Opcode opcode - | None -> failwith "_PC address contains unknown or undefined") - | MIPS -> - begin - reg := Reg.add "PCC" (Reg.find "nextPCC" !reg) !reg; - let nextPC = Reg.find "nextPC" !reg in - let pc_addr = address_of_register_value nextPC in - (*let unused = interactf "PC: %s\n" (Printing_functions.register_value_to_string nextPC) in*) - (match pc_addr with - | Some pc_addr -> - let pc_a = match addr_trans (get_addr_trans_regs ()) pc_addr with - | Some a, Some events -> write_events (List.rev events); integer_of_address a - | Some a, None -> integer_of_address a - | None, Some events -> - write_events (List.rev events); - let nextPC = Reg.find "nextPC" !reg in - reg := Reg.add "PCC" (Reg.find "nextPCC" !reg) !reg; - let pc_addr = address_of_register_value nextPC in - (match pc_addr with - | Some pc_addr -> - (match addr_trans (get_addr_trans_regs ()) pc_addr with - | Some a, Some events -> write_events (List.rev events); integer_of_address a - | Some a, None -> integer_of_address a - | None, _ -> failwith "Address translation failed twice") - | None -> failwith "no nextPc address") - | _ -> failwith "No address and no events from translate address" - in - let opcode = (get_opcode pc_a) in - begin - reg := Reg.add "PC" (Reg.find "nextPC" !reg) !reg; - Opcode opcode - end - | None -> errorf "nextPC contains unknown or undefined"; exit 1) - end - | _ -> assert false - let get_pc_address = function | MIPS -> Reg.find "PC" !reg | PPC -> Reg.find "CIA" !reg | AArch64 -> Reg.find "_PC" !reg - let option_int_of_reg str = option_int_of_option_integer (integer_of_register_value (Reg.find str !reg)) diff --git a/src/lem_interp/run_with_elf_cheri128.ml b/src/lem_interp/run_with_elf_cheri128.ml index 311d6f69..6dca80f4 100644 --- a/src/lem_interp/run_with_elf_cheri128.ml +++ b/src/lem_interp/run_with_elf_cheri128.ml @@ -124,369 +124,6 @@ let register_state_zero register_data rbn : register_value = in register_value_zeros dir width start_index type model = PPC | AArch64 | MIPS -(* -let ppc_register_data_all = [ - (*Pseudo registers*) - ("CIA", (D_increasing, 64, 0)); - ("NIA", (D_increasing, 64, 0)); - ("mode64bit", (D_increasing, 1, 0)); - ("bigendianmode", (D_increasing, 1, 0)); - (* special registers *) - ("CR", (D_increasing, 32, 32)); - ("CTR", (D_increasing, 64, 0 )); - ("LR", (D_increasing, 64, 0 )); - ("XER", (D_increasing, 64, 0 )); - ("VRSAVE",(D_increasing, 32, 32)); - ("FPSCR", (D_increasing, 64, 0 )); - ("VSCR", (D_increasing, 32, 96)); - - (* general purpose registers *) - ("GPR0", (D_increasing, 64, 0 )); - ("GPR1", (D_increasing, 64, 0 )); - ("GPR2", (D_increasing, 64, 0 )); - ("GPR3", (D_increasing, 64, 0 )); - ("GPR4", (D_increasing, 64, 0 )); - ("GPR5", (D_increasing, 64, 0 )); - ("GPR6", (D_increasing, 64, 0 )); - ("GPR7", (D_increasing, 64, 0 )); - ("GPR8", (D_increasing, 64, 0 )); - ("GPR9", (D_increasing, 64, 0 )); - ("GPR10", (D_increasing, 64, 0 )); - ("GPR11", (D_increasing, 64, 0 )); - ("GPR12", (D_increasing, 64, 0 )); - ("GPR13", (D_increasing, 64, 0 )); - ("GPR14", (D_increasing, 64, 0 )); - ("GPR15", (D_increasing, 64, 0 )); - ("GPR16", (D_increasing, 64, 0 )); - ("GPR17", (D_increasing, 64, 0 )); - ("GPR18", (D_increasing, 64, 0 )); - ("GPR19", (D_increasing, 64, 0 )); - ("GPR20", (D_increasing, 64, 0 )); - ("GPR21", (D_increasing, 64, 0 )); - ("GPR22", (D_increasing, 64, 0 )); - ("GPR23", (D_increasing, 64, 0 )); - ("GPR24", (D_increasing, 64, 0 )); - ("GPR25", (D_increasing, 64, 0 )); - ("GPR26", (D_increasing, 64, 0 )); - ("GPR27", (D_increasing, 64, 0 )); - ("GPR28", (D_increasing, 64, 0 )); - ("GPR29", (D_increasing, 64, 0 )); - ("GPR30", (D_increasing, 64, 0 )); - ("GPR31", (D_increasing, 64, 0 )); - (* vector registers *) - ("VR0", (D_increasing, 128, 0 )); - ("VR1", (D_increasing, 128, 0 )); - ("VR2", (D_increasing, 128, 0 )); - ("VR3", (D_increasing, 128, 0 )); - ("VR4", (D_increasing, 128, 0 )); - ("VR5", (D_increasing, 128, 0 )); - ("VR6", (D_increasing, 128, 0 )); - ("VR7", (D_increasing, 128, 0 )); - ("VR8", (D_increasing, 128, 0 )); - ("VR9", (D_increasing, 128, 0 )); - ("VR10", (D_increasing, 128, 0 )); - ("VR11", (D_increasing, 128, 0 )); - ("VR12", (D_increasing, 128, 0 )); - ("VR13", (D_increasing, 128, 0 )); - ("VR14", (D_increasing, 128, 0 )); - ("VR15", (D_increasing, 128, 0 )); - ("VR16", (D_increasing, 128, 0 )); - ("VR17", (D_increasing, 128, 0 )); - ("VR18", (D_increasing, 128, 0 )); - ("VR19", (D_increasing, 128, 0 )); - ("VR20", (D_increasing, 128, 0 )); - ("VR21", (D_increasing, 128, 0 )); - ("VR22", (D_increasing, 128, 0 )); - ("VR23", (D_increasing, 128, 0 )); - ("VR24", (D_increasing, 128, 0 )); - ("VR25", (D_increasing, 128, 0 )); - ("VR26", (D_increasing, 128, 0 )); - ("VR27", (D_increasing, 128, 0 )); - ("VR28", (D_increasing, 128, 0 )); - ("VR29", (D_increasing, 128, 0 )); - ("VR30", (D_increasing, 128, 0 )); - ("VR31", (D_increasing, 128, 0 )); - (* floating-point registers *) - ("FPR0", (D_increasing, 64, 0 )); - ("FPR1", (D_increasing, 64, 0 )); - ("FPR2", (D_increasing, 64, 0 )); - ("FPR3", (D_increasing, 64, 0 )); - ("FPR4", (D_increasing, 64, 0 )); - ("FPR5", (D_increasing, 64, 0 )); - ("FPR6", (D_increasing, 64, 0 )); - ("FPR7", (D_increasing, 64, 0 )); - ("FPR8", (D_increasing, 64, 0 )); - ("FPR9", (D_increasing, 64, 0 )); - ("FPR10", (D_increasing, 64, 0 )); - ("FPR11", (D_increasing, 64, 0 )); - ("FPR12", (D_increasing, 64, 0 )); - ("FPR13", (D_increasing, 64, 0 )); - ("FPR14", (D_increasing, 64, 0 )); - ("FPR15", (D_increasing, 64, 0 )); - ("FPR16", (D_increasing, 64, 0 )); - ("FPR17", (D_increasing, 64, 0 )); - ("FPR18", (D_increasing, 64, 0 )); - ("FPR19", (D_increasing, 64, 0 )); - ("FPR20", (D_increasing, 64, 0 )); - ("FPR21", (D_increasing, 64, 0 )); - ("FPR22", (D_increasing, 64, 0 )); - ("FPR23", (D_increasing, 64, 0 )); - ("FPR24", (D_increasing, 64, 0 )); - ("FPR25", (D_increasing, 64, 0 )); - ("FPR26", (D_increasing, 64, 0 )); - ("FPR27", (D_increasing, 64, 0 )); - ("FPR28", (D_increasing, 64, 0 )); - ("FPR29", (D_increasing, 64, 0 )); - ("FPR30", (D_increasing, 64, 0 )); - ("FPR31", (D_increasing, 64, 0 )); -] - -let initial_stack_and_reg_data_of_PPC_elf_file e_entry all_data_memory = - (* set up initial registers, per 3.4.1 of 64-bit PowerPC ELF Application Binary Interface Supplement 1.9 *) - - let auxiliary_vector_space = Nat_big_num.of_string "17592186042368" (*"0xffffffff800"*) in - (* notionally there should be at least an AT_NULL auxiliary vector entry there, but our examples will never read it *) - - (* take start of stack roughly where running gdb on hello5 on bim says it is*) - let initial_GPR1_stack_pointer = Nat_big_num.of_string "17592186040320" (*"0xffffffff000"*) in - let initial_GPR1_stack_pointer_value = - Sail_impl_base.register_value_of_integer 64 0 Sail_impl_base.D_increasing initial_GPR1_stack_pointer in - (* ELF says we need an initial zero doubleword there *) - let initial_stack_data = - (* the code actually uses the stack, both above and below, so we map a bit more memory*) - (* this is a fairly big but arbitrary chunk *) - (* let initial_stack_data_address = Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128) in - [("initial_stack_data", initial_stack_data_address, Lem_list.replicate (128+32) 0 ))] in *) - (* this is the stack memory that test 1938 actually uses *) - [ ("initial_stack_data1", Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128), - Lem_list.replicate 8 0 ); - ("initial_stack_data2", Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 8), - Lem_list.replicate 8 0 ); - ("initial_stack_data3", Nat_big_num.add initial_GPR1_stack_pointer (Nat_big_num.of_int 16), - Lem_list.replicate 8 0 )] in - - (* read TOC from the second field of the function descriptor pointed to by e_entry*) - let initial_GPR2_TOC = - Sail_impl_base.register_value_of_address - (Sail_impl_base.address_of_byte_list - (List.map (fun b -> match b with Some b -> b | None -> failwith "Address had undefined") - (List.map byte_of_byte_lifted - (read_mem all_data_memory - (Nat_big_num.add (Nat_big_num.of_int 8) e_entry) 8)))) - Sail_impl_base.D_increasing in - (* these initial register values are all mandated to be zero, but that's handled by the generic zeroing below - let initial_GPR3_argc = (Nat_big_num.of_int 0) in - let initial_GPR4_argv = (Nat_big_num.of_int 0) in - let initial_GPR5_envp = (Nat_big_num.of_int 0) in - let initial_FPSCR = (Nat_big_num.of_int 0) in - *) - let initial_register_abi_data : (string * Sail_impl_base.register_value) list = - [ ("GPR1", initial_GPR1_stack_pointer_value); - ("GPR2", initial_GPR2_TOC); - (* - ("GPR3", initial_GPR3_argc); - ("GPR4", initial_GPR4_argv); - ("GPR5", initial_GPR5_envp); - ("FPSCR", initial_FPSCR); - *) - ] in - - (initial_stack_data, initial_register_abi_data) - - -let aarch64_reg bit_count name = (name, (D_decreasing, bit_count, bit_count - 1)) - -let aarch64_PC_data = [aarch64_reg 64 "_PC"] - -(* most of the PSTATE fields are aliases to other registers so they - don't appear here *) -let aarch64_PSTATE_data = [ - aarch64_reg 1 "PSTATE_nRW"; - aarch64_reg 1 "PSTATE_E"; - aarch64_reg 5 "PSTATE_M"; -] - -let aarch64_general_purpose_registers_data = [ - aarch64_reg 64 "R0"; - aarch64_reg 64 "R1"; - aarch64_reg 64 "R2"; - aarch64_reg 64 "R3"; - aarch64_reg 64 "R4"; - aarch64_reg 64 "R5"; - aarch64_reg 64 "R6"; - aarch64_reg 64 "R7"; - aarch64_reg 64 "R8"; - aarch64_reg 64 "R9"; - aarch64_reg 64 "R10"; - aarch64_reg 64 "R11"; - aarch64_reg 64 "R12"; - aarch64_reg 64 "R13"; - aarch64_reg 64 "R14"; - aarch64_reg 64 "R15"; - aarch64_reg 64 "R16"; - aarch64_reg 64 "R17"; - aarch64_reg 64 "R18"; - aarch64_reg 64 "R19"; - aarch64_reg 64 "R20"; - aarch64_reg 64 "R21"; - aarch64_reg 64 "R22"; - aarch64_reg 64 "R23"; - aarch64_reg 64 "R24"; - aarch64_reg 64 "R25"; - aarch64_reg 64 "R26"; - aarch64_reg 64 "R27"; - aarch64_reg 64 "R28"; - aarch64_reg 64 "R29"; - aarch64_reg 64 "R30"; -] - -let aarch64_SIMD_registers_data = [ - aarch64_reg 128 "V0"; - aarch64_reg 128 "V1"; - aarch64_reg 128 "V2"; - aarch64_reg 128 "V3"; - aarch64_reg 128 "V4"; - aarch64_reg 128 "V5"; - aarch64_reg 128 "V6"; - aarch64_reg 128 "V7"; - aarch64_reg 128 "V8"; - aarch64_reg 128 "V9"; - aarch64_reg 128 "V10"; - aarch64_reg 128 "V11"; - aarch64_reg 128 "V12"; - aarch64_reg 128 "V13"; - aarch64_reg 128 "V14"; - aarch64_reg 128 "V15"; - aarch64_reg 128 "V16"; - aarch64_reg 128 "V17"; - aarch64_reg 128 "V18"; - aarch64_reg 128 "V19"; - aarch64_reg 128 "V20"; - aarch64_reg 128 "V21"; - aarch64_reg 128 "V22"; - aarch64_reg 128 "V23"; - aarch64_reg 128 "V24"; - aarch64_reg 128 "V25"; - aarch64_reg 128 "V26"; - aarch64_reg 128 "V27"; - aarch64_reg 128 "V28"; - aarch64_reg 128 "V29"; - aarch64_reg 128 "V30"; - aarch64_reg 128 "V31"; -] - -let aarch64_special_purpose_registers_data = [ - aarch64_reg 32 "CurrentEL"; - aarch64_reg 32 "DAIF"; - aarch64_reg 32 "NZCV"; - aarch64_reg 64 "SP_EL0"; - aarch64_reg 64 "SP_EL1"; - aarch64_reg 64 "SP_EL2"; - aarch64_reg 64 "SP_EL3"; - aarch64_reg 32 "SPSel"; - aarch64_reg 32 "SPSR_EL1"; - aarch64_reg 32 "SPSR_EL2"; - aarch64_reg 32 "SPSR_EL3"; - aarch64_reg 64 "ELR_EL1"; - aarch64_reg 64 "ELR_EL2"; - aarch64_reg 64 "ELR_EL3"; -] - -let aarch64_general_system_control_registers_data = [ - aarch64_reg 64 "HCR_EL2"; - aarch64_reg 64 "ID_AA64MMFR0_EL1"; - aarch64_reg 64 "RVBAR_EL1"; - aarch64_reg 64 "RVBAR_EL2"; - aarch64_reg 64 "RVBAR_EL3"; - aarch64_reg 32 "SCR_EL3"; - aarch64_reg 32 "SCTLR_EL1"; - aarch64_reg 32 "SCTLR_EL2"; - aarch64_reg 32 "SCTLR_EL3"; - aarch64_reg 64 "TCR_EL1"; - aarch64_reg 32 "TCR_EL2"; - aarch64_reg 32 "TCR_EL3"; -] - -let aarch64_debug_registers_data = [ - aarch64_reg 32 "DBGPRCR_EL1"; - aarch64_reg 32 "OSDLR_EL1"; -] - -let aarch64_performance_monitors_registers_data = [] -let aarch64_generic_timer_registers_data = [] -let aarch64_generic_interrupt_controller_CPU_interface_registers_data = [] - -let aarch64_external_debug_registers_data = [ - aarch64_reg 32 "EDSCR"; -] - -let aarch32_general_system_control_registers_data = [ - aarch64_reg 32 "SCR"; -] - -let aarch32_debug_registers_data = [ - aarch64_reg 32 "DBGOSDLR"; - aarch64_reg 32 "DBGPRCR"; -] - -let aarch64_register_data_all = - aarch64_PC_data @ - aarch64_PSTATE_data @ - aarch64_general_purpose_registers_data @ - aarch64_SIMD_registers_data @ - aarch64_special_purpose_registers_data @ - aarch64_general_system_control_registers_data @ - aarch64_debug_registers_data @ - aarch64_performance_monitors_registers_data @ - aarch64_generic_timer_registers_data @ - aarch64_generic_interrupt_controller_CPU_interface_registers_data @ - aarch64_external_debug_registers_data @ - aarch32_general_system_control_registers_data @ - aarch32_debug_registers_data - -let initial_stack_and_reg_data_of_AAarch64_elf_file e_entry all_data_memory = - let (reg_SP_EL0_direction, reg_SP_EL0_width, reg_SP_EL0_initial_index) = - List.assoc "SP_EL0" aarch64_register_data_all in - - (* we compiled a small program that prints out SP and run it a few - times on the Nexus9, these are the results: - 0x0000007fe7f903e0 - 0x0000007fdcdbf3f0 - 0x0000007fcbe1ba90 - 0x0000007fcf378280 - 0x0000007fdd54b8d0 - 0x0000007fd961bc10 - 0x0000007ff3be6350 - 0x0000007fd6bf6ef0 - 0x0000007fff7676f0 - 0x0000007ff2c34560 *) - let initial_SP_EL0 = Nat_big_num.of_string "549739036672" (*"0x0000007fff000000"*) in - let initial_SP_EL0_value = - Sail_impl_base.register_value_of_integer - reg_SP_EL0_width - reg_SP_EL0_initial_index - reg_SP_EL0_direction - initial_SP_EL0 - in - - (* ELF says we need an initial zero doubleword there *) - (* the code actually uses the stack, both above and below, so we map a bit more memory*) - let initial_stack_data = - (* this is a fairly big but arbitrary chunk: *) - (* let initial_stack_data_address = Nat_big_num.sub initial_GPR1_stack_pointer (Nat_big_num.of_int 128) in - [("initial_stack_data", initial_stack_data_address, Lem_list.replicate (128+32) 0 ))] in *) - - [ ("initial_stack_data1", Nat_big_num.sub initial_SP_EL0 (Nat_big_num.of_int 16), Lem_list.replicate 8 0); - ("initial_stack_data2", Nat_big_num.sub initial_SP_EL0 (Nat_big_num.of_int 8), Lem_list.replicate 8 0) - ] - in - - let initial_register_abi_data : (string * Sail_impl_base.register_value) list = - [("SP_EL0", initial_SP_EL0_value)] - in - - (initial_stack_data, initial_register_abi_data) -*) let mips_register_data_all = [ (*Pseudo registers*) @@ -749,50 +386,6 @@ let initial_system_state_of_elf_file name = let (isa_defs, isa_memory_access, isa_externs, isa_model, model_reg_d, startaddr, initial_stack_data, initial_register_abi_data, register_data_all) = match Nat_big_num.to_int e_machine with -(* | 21 (* EM_PPC64 *) -> - let startaddr = - let e_entry = Uint64.of_int64 (Nat_big_num.to_int64 e_entry) in - match Abi_power64.abi_power64_compute_program_entry_point segments e_entry with - | Error.Fail s -> failwith "Failed computing entry point" - | Error.Success s -> Nat_big_num.of_int64 (Uint64.to_int64 s) - in - let (initial_stack_data, initial_register_abi_data) = - initial_stack_and_reg_data_of_PPC_elf_file e_entry !data_mem in - - (Power.defs, - (Power_extras.read_memory_functions,Power_extras.memory_writes,[],[],Power_extras.barrier_functions), - Power_extras.power_externs, - PPC, - D_increasing, - startaddr, - initial_stack_data, - initial_register_abi_data, - ppc_register_data_all) - - | 183 (* EM_AARCH64 *) -> - let startaddr = - let e_entry = Uint64.of_int64 (Nat_big_num.to_int64 e_entry) in - match Abi_aarch64_le.abi_aarch64_le_compute_program_entry_point segments e_entry with - | Error.Fail s -> failwith "Failed computing entry point" - | Error.Success s -> Nat_big_num.of_int64 (Uint64.to_int64 s) - in - - let (initial_stack_data, initial_register_abi_data) = - initial_stack_and_reg_data_of_AAarch64_elf_file e_entry !data_mem in - - (ArmV8.defs, - (ArmV8_extras.aArch64_read_memory_functions, - ArmV8_extras.aArch64_memory_writes, - ArmV8_extras.aArch64_memory_eas, - ArmV8_extras.aArch64_memory_vals, - ArmV8_extras.aArch64_barrier_functions), - [], - AArch64, - D_decreasing, - startaddr, - initial_stack_data, - initial_register_abi_data, - aarch64_register_data_all) *) | 8 (* EM_MIPS *) -> let startaddr = let e_entry = Uint64.of_string (Nat_big_num.to_string e_entry) in @@ -888,52 +481,6 @@ let initial_system_state_of_elf_file name = List.map (fun (name, (binding, fp)) -> (fp, name)) (StringMap.bindings map) in - - (* Now we examine the rest of the data memory, - removing the footprint of the symbols and chunking it into aligned chunks *) - - let rec remove_symbols_from_data_memory data_mem symbols = - match symbols with - | [] -> data_mem - | (name,address,size,bs)::symbols' -> - let data_mem' = - Mem.filter - (fun a v -> - not (Nat_big_num.greater_equal a address && - Nat_big_num.less a (Nat_big_num.add (Nat_big_num.of_int (List.length bs)) address))) - data_mem in - remove_symbols_from_data_memory data_mem' symbols' in - - let trimmed_data_memory : (Nat_big_num.num * memory_byte) list = - Mem.bindings (remove_symbols_from_data_memory !data_mem symbol_table) in - - (* make sure that's ordered increasingly.... *) - let trimmed_data_memory = - List.sort (fun (a,b) (a',b') -> Nat_big_num.compare a a') trimmed_data_memory in - - let aligned a n = (* a mod n = 0 *) - let n_big = Nat_big_num.of_int n in - Nat_big_num.equal (Nat_big_num.modulus a n_big) ((Nat_big_num.of_int 0)) in - - let isplus a' a n = (* a' = a+n *) - Nat_big_num.equal a' (Nat_big_num.add (Nat_big_num.of_int n) a) in - - let rec chunk_data_memory dm = - match dm with - | (a0,b0)::(a1,b1)::(a2,b2)::(a3,b3)::(a4,b4)::(a5,b5)::(a6,b6)::(a7,b7)::dm' when - (aligned a0 8 && isplus a1 a0 1 && isplus a2 a0 2 && isplus a3 a0 3 && - isplus a4 a0 4 && isplus a5 a0 5 && isplus a6 a0 6 && isplus a7 a0 7) -> - (a0,8,[b0;b1;b2;b3;b4;b5;b6;b7]) :: chunk_data_memory dm' - | (a0,b0)::(a1,b1)::(a2,b2)::(a3,b3)::dm' when - (aligned a0 4 && isplus a1 a0 1 && isplus a2 a0 2 && isplus a3 a0 3) -> - (a0,4,[b0;b1;b2;b3]) :: chunk_data_memory dm' - | (a0,b0)::(a1,b1)::dm' when - (aligned a0 2 && isplus a1 a0 1) -> - (a0,2,[b0;b1]) :: chunk_data_memory dm' - | (a0,b0)::dm' -> - (a0,1,[b0]):: chunk_data_memory dm' - | [] -> [] in - let initial_register_state = fun rbn -> try @@ -1022,69 +569,10 @@ let stop_condition_met model instr = true | _ -> false) -let is_branch model instruction = - let (name,_,_) = instruction in - match (model , name) with - | (PPC, "B") -> true - | (PPC, "Bc") -> true - | (PPC, "Bclr") -> true - | (PPC, "Bcctr") -> true - | (PPC, _) -> false - | (AArch64, "BranchImmediate") -> true - | (AArch64, "BranchConditional") -> true - | (AArch64, "CompareAndBranch") -> true - | (AArch64, "TestBitAndBranch") -> true - | (AArch64, "BranchRegister") -> true - | (AArch64, _) -> false - | (MIPS, _) -> false (*todo,fill this in*) - let option_int_of_option_integer i = match i with | Some i -> Some (Nat_big_num.to_int i) | None -> None -let set_next_instruction_address model = - match model with - | PPC -> - let cia = Reg.find "CIA" !reg in - let cia_addr = address_of_register_value cia in - (match cia_addr with - | Some cia_addr -> - let nia_addr = add_address_nat cia_addr 4 in - let nia = register_value_of_address nia_addr Sail_impl_base.D_increasing in - reg := Reg.add "NIA" nia !reg - | _ -> failwith "CIA address contains unknown or undefined") - | AArch64 -> - let pc = Reg.find "_PC" !reg in - let pc_addr = address_of_register_value pc in - (match pc_addr with - | Some pc_addr -> - let n_addr = add_address_nat pc_addr 4 in - let n_pc = register_value_of_address n_addr D_decreasing in - reg := Reg.add "_PC" n_pc !reg - | _ -> failwith "_PC address contains unknown or undefined") - | MIPS -> - let pc_addr = address_of_register_value (Reg.find "PC" !reg) in - let branchPending = integer_of_register_value (Reg.find "branchPending" !reg) in - (match (pc_addr, option_int_of_option_integer branchPending) with - | (Some pc_val, Some 0) -> - (* normal -- increment PC *) - let n_addr = add_address_nat pc_val 4 in - let n_pc = register_value_of_address n_addr D_decreasing in - begin - reg := Reg.add "nextPC" n_pc !reg; - reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - reg := Reg.add "inCCallDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - end - | (Some pc_val, Some 1) -> - (* delay slot -- branch to delayed PC and clear branchPending *) - begin - reg := Reg.add "nextPC" (Reg.find "delayedPC" !reg) !reg; - reg := Reg.add "nextPCC" (Reg.find "delayedPCC" !reg) !reg; - reg := Reg.add "branchPending" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing Nat_big_num.zero) !reg; - reg := Reg.add "inBranchDelay" (register_value_of_integer 1 0 Sail_impl_base.D_decreasing (Nat_big_num.of_int 1)) !reg; - end - | (_, _) -> errorf "PC address contains unknown or undefined"; exit 1) - let add1 = Nat_big_num.add (Nat_big_num.of_int 1) let get_addr_trans_regs _ = @@ -1194,68 +682,10 @@ let rec write_events = function | _ -> failwith "Only register write events expected"); write_events events -let fetch_instruction_opcode_and_update_ia model addr_trans = - match model with - | PPC -> - let cia = Reg.find "CIA" !reg in - let cia_addr = address_of_register_value cia in - (match cia_addr with - | Some cia_addr -> - let cia_a = integer_of_address cia_addr in - let opcode = (get_opcode cia_a) in - begin - reg := Reg.add "CIA" (Reg.find "NIA" !reg) !reg; - Opcode opcode - end - | None -> failwith "CIA address contains unknown or undefined") - | AArch64 -> - let pc = Reg.find "_PC" !reg in - let pc_addr = address_of_register_value pc in - (match pc_addr with - | Some pc_addr -> - let pc_a = integer_of_address pc_addr in - let opcode = (get_opcode pc_a) in - Opcode opcode - | None -> failwith "_PC address contains unknown or undefined") - | MIPS -> - begin - reg := Reg.add "PCC" (Reg.find "nextPCC" !reg) !reg; - let nextPC = Reg.find "nextPC" !reg in - let pc_addr = address_of_register_value nextPC in - (*let unused = interactf "PC: %s\n" (Printing_functions.register_value_to_string nextPC) in*) - (match pc_addr with - | Some pc_addr -> - let pc_a = match addr_trans (get_addr_trans_regs ()) pc_addr with - | Some a, Some events -> write_events (List.rev events); integer_of_address a - | Some a, None -> integer_of_address a - | None, Some events -> - write_events (List.rev events); - let nextPC = Reg.find "nextPC" !reg in - reg := Reg.add "PCC" (Reg.find "nextPCC" !reg) !reg; - let pc_addr = address_of_register_value nextPC in - (match pc_addr with - | Some pc_addr -> - (match addr_trans (get_addr_trans_regs ()) pc_addr with - | Some a, Some events -> write_events (List.rev events); integer_of_address a - | Some a, None -> integer_of_address a - | None, _ -> failwith "Address translation failed twice") - | None -> failwith "no nextPc address") - | _ -> failwith "No address and no events from translate address" - in - let opcode = (get_opcode pc_a) in - begin - reg := Reg.add "PC" (Reg.find "nextPC" !reg) !reg; - Opcode opcode - end - | None -> errorf "nextPC contains unknown or undefined"; exit 1) - end - | _ -> assert false - let get_pc_address = function | MIPS -> Reg.find "PC" !reg | PPC -> Reg.find "CIA" !reg | AArch64 -> Reg.find "_PC" !reg - let option_int_of_reg str = option_int_of_option_integer (integer_of_register_value (Reg.find str !reg)) -- cgit v1.2.3 From 6b86efcb6e1042d4933b67eaf3a7b3eff1fac256 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Tue, 7 Nov 2017 11:45:06 +0000 Subject: RISC-V parser checks --- risc-v/hgen/lexer.hgen | 4 ++++ risc-v/hgen/parser.hgen | 57 ++++++++++++++++++++++++++++++-------------- risc-v/hgen/token_types.hgen | 4 ++++ risc-v/hgen/tokens.hgen | 3 ++- 4 files changed, 49 insertions(+), 19 deletions(-) diff --git a/risc-v/hgen/lexer.hgen b/risc-v/hgen/lexer.hgen index 27df99f4..e42b8a62 100644 --- a/risc-v/hgen/lexer.hgen +++ b/risc-v/hgen/lexer.hgen @@ -184,3 +184,7 @@ "amomin.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMIN}; "amomaxu.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMAXU}; "amominu.d.aq.rl", AMO {width=RISCVDOUBLE; aq=true; rl=true; op=RISCVAMOMINU}; + +(** pseudo instructions *********************************************) + +"li", LI () diff --git a/risc-v/hgen/parser.hgen b/risc-v/hgen/parser.hgen index cf0ca80b..210e38fb 100644 --- a/risc-v/hgen/parser.hgen +++ b/risc-v/hgen/parser.hgen @@ -1,25 +1,41 @@ | UTYPE reg COMMA NUM - { `RISCVUTYPE($4, $2, $1.op) } + { (* 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 - { `RISCVJAL($4, $2) } + { 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 - { `RISCVJALR($6, $4, $2) } + { if not (iskbitsimm 12 $6) then failwith "offset is not 12bit" + else `RISCVJALR ($6, $4, $2) } | BTYPE reg COMMA reg COMMA NUM - { `RISCVBType($6, $4, $2, $1.op) } + { 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 - { `RISCVIType($6, $4, $2, $1.op) } + { 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 - { `RISCVShiftIop($6, $4, $2, $1.op) } + { 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 - { `RISCVLoad($4, $6, $2, $1.unsigned, $1.width, $1.aq, $1.rl) } + { 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 - { `RISCVStore($4, $2, $6, $1.width, $1.aq, $1.rl) } -| ADDIW reg COMMA reg COMMA NUM - { `RISCVADDIW ($6, $4, $2) } -| SHIFTW reg COMMA reg COMMA NUM - { `RISCVSHIFTW ($6, $4, $2, $1.op) } + { 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 @@ -37,17 +53,22 @@ | FENCEI { `RISCVFENCEI } | LOADRES reg COMMA LPAR reg RPAR - { `RISCVLoadRes($1.aq, $1.rl, $5, $1.width, $2) } + { `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) } + `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) } + { `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) } + `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) } + { `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' offset must be 0" else - `RISCVAMO($1.op, $1.aq, $1.rl, $4, $8, $1.width, $2) } + `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/risc-v/hgen/token_types.hgen b/risc-v/hgen/token_types.hgen index d338d865..f29e318d 100644 --- a/risc-v/hgen/token_types.hgen +++ b/risc-v/hgen/token_types.hgen @@ -17,3 +17,7 @@ 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/risc-v/hgen/tokens.hgen b/risc-v/hgen/tokens.hgen index b0cf1d88..f812adbd 100644 --- a/risc-v/hgen/tokens.hgen +++ b/risc-v/hgen/tokens.hgen @@ -15,4 +15,5 @@ %token FENCEI %token LOADRES %token STORECON -%token AMO +%token AMO +%token LI -- cgit v1.2.3 From 9ab1c6514c38968bcbdf5847ecb811072f731982 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 23 Nov 2017 13:32:42 +0000 Subject: added RISCV_ prefix to some values to stop Lem from renaming them --- risc-v/hgen/herdtools_types_to_shallow_types.hgen | 64 +++++----- risc-v/hgen/shallow_types_to_herdtools_types.hgen | 64 +++++----- risc-v/riscv.sail | 140 +++++++++++----------- risc-v/riscv_types.sail | 12 +- 4 files changed, 140 insertions(+), 140 deletions(-) diff --git a/risc-v/hgen/herdtools_types_to_shallow_types.hgen b/risc-v/hgen/herdtools_types_to_shallow_types.hgen index a63f9aed..e6edd24d 100644 --- a/risc-v/hgen/herdtools_types_to_shallow_types.hgen +++ b/risc-v/hgen/herdtools_types_to_shallow_types.hgen @@ -4,48 +4,48 @@ let translate_reg name value = Sail_values.to_vec0 is_inc (Nat_big_num.of_int 5,Nat_big_num.of_int (reg_to_int value)) let translate_uop op = match op with - | RISCVLUI -> LUI0 - | RISCVAUIPC -> AUIPC + | RISCVLUI -> RISCV_LUI + | RISCVAUIPC -> RISCV_AUIPC let translate_bop op = match op with - | RISCVBEQ -> BEQ0 - | RISCVBNE -> BNE - | RISCVBLT -> BLT - | RISCVBGE -> BGE - | RISCVBLTU -> BLTU - | RISCVBGEU -> BGEU + | 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 -> ADDI0 - | RISCVSLTI -> SLTI0 - | RISCVSLTIU -> SLTIU0 - | RISCVXORI -> XORI0 - | RISCVORI -> ORI0 - | RISCVANDI -> ANDI0 + | 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 -> SLLI - | RISCVSRLI -> SRLI - | RISCVSRAI -> SRAI + | RISCVSLLI -> RISCV_SLLI + | RISCVSRLI -> RISCV_SRLI + | RISCVSRAI -> RISCV_SRAI let translate_rop op = match op with - | RISCVADD -> ADD0 - | RISCVSUB -> SUB0 - | RISCVSLL -> SLL0 - | RISCVSLT -> SLT0 - | RISCVSLTU -> SLTU0 - | RISCVXOR -> XOR0 - | RISCVSRL -> SRL0 - | RISCVSRA -> SRA0 - | RISCVOR -> OR0 - | RISCVAND -> AND0 + | 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 -> ADDW - | RISCVSUBW -> SUBW - | RISCVSLLW -> SLLW - | RISCVSRLW -> SRLW - | RISCVSRAW -> SRAW + | RISCVADDW -> RISCV_ADDW + | RISCVSUBW -> RISCV_SUBW + | RISCVSLLW -> RISCV_SLLW + | RISCVSRLW -> RISCV_SRLW + | RISCVSRAW -> RISCV_SRAW let translate_amoop op = match op with | RISCVAMOSWAP -> AMOSWAP diff --git a/risc-v/hgen/shallow_types_to_herdtools_types.hgen b/risc-v/hgen/shallow_types_to_herdtools_types.hgen index 03b8820c..6b3b7f51 100644 --- a/risc-v/hgen/shallow_types_to_herdtools_types.hgen +++ b/risc-v/hgen/shallow_types_to_herdtools_types.hgen @@ -10,48 +10,48 @@ let translate_out_signed_int inst bits = let translate_out_ireg ireg = IReg (int_to_ireg (translate_out_int ireg)) let translate_out_uop op = match op with - | LUI0 -> RISCVLUI - | AUIPC -> RISCVAUIPC + | RISCV_LUI -> RISCVLUI + | RISCV_AUIPC -> RISCVAUIPC let translate_out_bop op = match op with - | BEQ0 -> RISCVBEQ - | BNE -> RISCVBNE - | BLT -> RISCVBLT - | BGE -> RISCVBGE - | BLTU -> RISCVBLTU - | BGEU -> RISCVBGEU + | 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 - | ADDI0 -> RISCVADDI - | SLTI0 -> RISCVSLTI - | SLTIU0 -> RISCVSLTIU - | XORI0 -> RISCVXORI - | ORI0 -> RISCVORI - | ANDI0 -> RISCVANDI + | 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 - | SLLI -> RISCVSLLI - | SRLI -> RISCVSRLI - | SRAI -> RISCVSRAI + | RISCV_SLLI -> RISCVSLLI + | RISCV_SRLI -> RISCVSRLI + | RISCV_SRAI -> RISCVSRAI let translate_out_rop op = match op with - | ADD0 -> RISCVADD - | SUB0 -> RISCVSUB - | SLL0 -> RISCVSLL - | SLT0 -> RISCVSLT - | SLTU0 -> RISCVSLTU - | XOR0 -> RISCVXOR - | SRL0 -> RISCVSRL - | SRA0 -> RISCVSRA - | OR0 -> RISCVOR - | AND0 -> RISCVAND + | 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 - | ADDW -> RISCVADDW - | SUBW -> RISCVSUBW - | SLLW -> RISCVSLLW - | SRLW -> RISCVSRLW - | SRAW -> RISCVSRAW + | 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 diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index e0a6efba..3a54e0c8 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -8,14 +8,14 @@ scattered function unit execute (********************************************************************) union ast member ((bit[20]), regno, uop) UTYPE -function clause decode ((bit[20]) imm : (regno) rd : 0b0110111) = Some(UTYPE(imm, rd, LUI)) -function clause decode ((bit[20]) imm : (regno) rd : 0b0010111) = Some(UTYPE(imm, rd, AUIPC)) +function clause decode ((bit[20]) imm : (regno) rd : 0b0110111) = Some(UTYPE(imm, rd, RISCV_LUI)) +function clause decode ((bit[20]) imm : (regno) rd : 0b0010111) = Some(UTYPE(imm, rd, RISCV_AUIPC)) function clause execute (UTYPE(imm, rd, op)) = let (bit[64]) off = EXTS(imm : 0x000) in let ret = switch (op) { - case LUI -> off - case AUIPC -> PC + off + case RISCV_LUI -> off + case RISCV_AUIPC -> PC + off } in wGPR(rd, ret) @@ -48,28 +48,28 @@ function clause execute (JALR(imm, rs1, rd)) = { union ast member ((bit[13]), regno, regno, bop) BTYPE function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b000 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BEQ)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BEQ)) function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b001 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BNE)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BNE)) function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b100 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLT)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BLT)) function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b101 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGE)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BGE)) function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b110 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BLTU)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BLTU)) function clause decode ((bit[7]) imm7 : (regno) rs2 : (regno) rs1 : 0b111 : (bit[5]) imm5 : 0b1100011) = - Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, BGEU)) + Some(BTYPE(imm7[6] : imm5[0] : imm7[5..0] : imm5[4..1] : 0b0, rs2, rs1, RISCV_BGEU)) function clause execute (BTYPE(imm, rs2, rs1, op)) = let rs1_val = rGPR(rs1) in let rs2_val = rGPR(rs2) in let taken = switch(op) { - case BEQ -> rs1_val == rs2_val - case BNE -> rs1_val != rs2_val - case BLT -> rs1_val <_s rs2_val - case BGE -> rs1_val >=_s rs2_val - case BLTU -> rs1_val <_u rs2_val - case BGEU -> unsigned(rs1_val) >= unsigned(rs2_val) (* XXX sail missing >=_u *) + case RISCV_BEQ -> rs1_val == rs2_val + case RISCV_BNE -> rs1_val != rs2_val + case RISCV_BLT -> rs1_val <_s rs2_val + case RISCV_BGE -> rs1_val >=_s rs2_val + case RISCV_BLTU -> rs1_val <_u rs2_val + case RISCV_BGEU -> unsigned(rs1_val) >= unsigned(rs2_val) (* XXX sail missing >=_u *) } in if (taken) then nextPC := PC + EXTS(imm) @@ -77,70 +77,70 @@ function clause execute (BTYPE(imm, rs2, rs1, op)) = (********************************************************************) union ast member ((bit[12]), regno, regno, iop) ITYPE -function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ADDI)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, SLTI)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, SLTIU)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, XORI)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ORI)) -function clause decode ((bit[12]) imm : (regno) rs1 : 0b111 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, ANDI)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_ADDI)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b010 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_SLTI)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b011 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_SLTIU)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b100 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_XORI)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b110 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_ORI)) +function clause decode ((bit[12]) imm : (regno) rs1 : 0b111 : (regno) rd : 0b0010011) = Some(ITYPE(imm, rs1, rd, RISCV_ANDI)) function clause execute (ITYPE (imm, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let imm64 = (bit[64]) (EXTS(imm)) in let (bit[64]) result = switch(op) { - case ADDI -> rs1_val + imm64 - case SLTI -> EXTZ(rs1_val <_s imm64) - case SLTIU -> EXTZ(rs1_val <_u imm64) - case XORI -> rs1_val ^ imm64 - case ORI -> rs1_val | imm64 - case ANDI -> rs1_val & imm64 + case RISCV_ADDI -> rs1_val + imm64 + case RISCV_SLTI -> EXTZ(rs1_val <_s imm64) + case RISCV_SLTIU -> EXTZ(rs1_val <_u imm64) + case RISCV_XORI -> rs1_val ^ imm64 + case RISCV_ORI -> rs1_val | imm64 + case RISCV_ANDI -> rs1_val & imm64 } in wGPR(rd, result) (********************************************************************) union ast member ((bit[6]), regno, regno, sop) SHIFTIOP -function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SLLI)) -function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SRLI)) -function clause decode (0b010000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, SRAI)) +function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, RISCV_SLLI)) +function clause decode (0b000000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, RISCV_SRLI)) +function clause decode (0b010000 : (bit[6]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0010011) = Some(SHIFTIOP(shamt, rs1, rd, RISCV_SRAI)) function clause execute (SHIFTIOP(shamt, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let result = switch(op) { - case SLLI -> rs1_val >> shamt - case SRLI -> rs1_val << shamt - case SRAI -> shift_right_arith64(rs1_val, shamt) + case RISCV_SLLI -> rs1_val >> shamt + case RISCV_SRLI -> rs1_val << shamt + case RISCV_SRAI -> shift_right_arith64(rs1_val, shamt) } in wGPR(rd, result) (********************************************************************) union ast member (regno, regno, regno, rop) RTYPE -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, ADD)) -function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SUB)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SLL)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SLT)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SLTU)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b100 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, XOR)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SRL)) -function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, SRA)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b110 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, OR)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b111 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, AND)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_ADD)) +function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SUB)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SLL)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b010 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SLT)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b011 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SLTU)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b100 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_XOR)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SRL)) +function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_SRA)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b110 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_OR)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b111 : (regno) rd : 0b0110011) = Some(RTYPE(rs2, rs1, rd, RISCV_AND)) function clause execute (RTYPE(rs2, rs1, rd, op)) = let rs1_val = rGPR(rs1) in let rs2_val = rGPR(rs2) in let (bit[64]) result = switch(op) { - case ADD -> rs1_val + rs2_val - case SUB -> rs1_val - rs2_val - case SLL -> rs1_val << (rs2_val[5..0]) - case SLT -> EXTZ(rs1_val <_s rs2_val) - case SLTU -> EXTZ(rs1_val <_u rs2_val) - case XOR -> rs1_val ^ rs2_val - case SRL -> rs1_val >> (rs2_val[5..0]) - case SRA -> shift_right_arith64(rs1_val, rs2_val[5..0]) - case OR -> rs1_val | rs2_val - case AND -> rs1_val & rs2_val + case RISCV_ADD -> rs1_val + rs2_val + case RISCV_SUB -> rs1_val - rs2_val + case RISCV_SLL -> rs1_val << (rs2_val[5..0]) + case RISCV_SLT -> EXTZ(rs1_val <_s rs2_val) + case RISCV_SLTU -> EXTZ(rs1_val <_u rs2_val) + case RISCV_XOR -> rs1_val ^ rs2_val + case RISCV_SRL -> rs1_val >> (rs2_val[5..0]) + case RISCV_SRA -> shift_right_arith64(rs1_val, rs2_val[5..0]) + case RISCV_OR -> rs1_val | rs2_val + case RISCV_AND -> rs1_val & rs2_val } in wGPR(rd, result) @@ -217,37 +217,37 @@ function clause execute (ADDIW(imm, rs1, rd)) = (********************************************************************) union ast member ((bit[5]), regno, regno, sop) SHIFTW -function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SLLI)) -function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SRLI)) -function clause decode (0b0100000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, SRAI)) +function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b001 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, RISCV_SLLI)) +function clause decode (0b0000000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, RISCV_SRLI)) +function clause decode (0b0100000 : (bit[5]) shamt : (regno) rs1 : 0b101 : (regno) rd : 0b0011011) = Some(SHIFTW(shamt, rs1, rd, RISCV_SRAI)) function clause execute (SHIFTW(shamt, rs1, rd, op)) = let rs1_val = (rGPR(rs1))[31..0] in let result = switch(op) { - case SLLI -> rs1_val >> shamt - case SRLI -> rs1_val << shamt - case SRAI -> shift_right_arith32(rs1_val, shamt) + case RISCV_SLLI -> rs1_val >> shamt + case RISCV_SRLI -> rs1_val << shamt + case RISCV_SRAI -> shift_right_arith32(rs1_val, shamt) } in wGPR(rd, EXTS(result)) (********************************************************************) union ast member (regno, regno, regno, ropw) RTYPEW -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, ADDW)) -function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SUBW)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SLLW)) -function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SRLW)) -function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, SRAW)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, RISCV_ADDW)) +function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b000 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, RISCV_SUBW)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b001 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, RISCV_SLLW)) +function clause decode (0b0000000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, RISCV_SRLW)) +function clause decode (0b0100000 : (regno) rs2 : (regno) rs1 : 0b101 : (regno) rd : 0b0111011) = Some(RTYPEW(rs2, rs1, rd, RISCV_SRAW)) function clause execute (RTYPEW(rs2, rs1, rd, op)) = let rs1_val = (rGPR(rs1))[31..0] in let rs2_val = (rGPR(rs2))[31..0] in let (bit[32]) result = switch(op) { - case ADDW -> rs1_val + rs2_val - case SUBW -> rs1_val - rs2_val - case SLLW -> rs1_val << (rs2_val[4..0]) - case SRLW -> rs1_val >> (rs2_val[4..0]) - case SRAW -> shift_right_arith32(rs1_val, rs2_val[4..0]) + case RISCV_ADDW -> rs1_val + rs2_val + case RISCV_SUBW -> rs1_val - rs2_val + case RISCV_SLLW -> rs1_val << (rs2_val[4..0]) + case RISCV_SRLW -> rs1_val >> (rs2_val[4..0]) + case RISCV_SRAW -> shift_right_arith32(rs1_val, rs2_val[4..0]) } in wGPR(rd, EXTS(result)) diff --git a/risc-v/riscv_types.sail b/risc-v/riscv_types.sail index a7cda963..b584ae9b 100644 --- a/risc-v/riscv_types.sail +++ b/risc-v/riscv_types.sail @@ -143,12 +143,12 @@ val extern unit -> unit effect { barr } MEM_fence_rw_w val extern unit -> unit effect { barr } MEM_fence_w_w val extern unit -> unit effect { barr } MEM_fence_i -typedef uop = enumerate {LUI; AUIPC} (* upper immediate ops *) -typedef bop = enumerate {BEQ; BNE; BLT; BGE; BLTU; BGEU} (* branch ops *) -typedef iop = enumerate {ADDI; SLTI; SLTIU; XORI; ORI; ANDI} (* immediate ops *) -typedef sop = enumerate {SLLI; SRLI; SRAI} (* shift ops *) -typedef rop = enumerate {ADD; SUB; SLL; SLT; SLTU; XOR; SRL; SRA; OR; AND} (* reg-reg ops *) -typedef ropw = enumerate {ADDW; SUBW; SLLW; SRLW; SRAW} (* reg-reg 32-bit ops *) +typedef uop = enumerate {RISCV_LUI; RISCV_AUIPC} (* upper immediate ops *) +typedef bop = enumerate {RISCV_BEQ; RISCV_BNE; RISCV_BLT; RISCV_BGE; RISCV_BLTU; RISCV_BGEU} (* branch ops *) +typedef iop = enumerate {RISCV_ADDI; RISCV_SLTI; RISCV_SLTIU; RISCV_XORI; RISCV_ORI; RISCV_ANDI} (* immediate ops *) +typedef sop = enumerate {RISCV_SLLI; RISCV_SRLI; RISCV_SRAI} (* shift ops *) +typedef rop = enumerate {RISCV_ADD; RISCV_SUB; RISCV_SLL; RISCV_SLT; RISCV_SLTU; RISCV_XOR; RISCV_SRL; RISCV_SRA; RISCV_OR; RISCV_AND} (* reg-reg ops *) +typedef ropw = enumerate {RISCV_ADDW; RISCV_SUBW; RISCV_SLLW; RISCV_SRLW; RISCV_SRAW} (* reg-reg 32-bit ops *) typedef amoop = enumerate {AMOSWAP; AMOADD; AMOXOR; AMOAND; AMOOR; AMOMIN; AMOMAX; AMOMINU; AMOMAXU} (* AMO ops *) -- cgit v1.2.3 From 16c269d6f26fd69d8788c448b87f4bb479a6ef66 Mon Sep 17 00:00:00 2001 From: Shaked Flur Date: Thu, 23 Nov 2017 15:50:13 +0000 Subject: renaming --- risc-v/hgen/herdtools_ast_to_shallow_ast.hgen | 4 +- risc-v/hgen/shallow_ast_to_herdtools_ast.hgen | 4 +- risc-v/riscv.sail | 12 +- risc-v/riscv_regfp.sail | 4 +- x86/x64.sail | 234 +++++++++++++------------- 5 files changed, 130 insertions(+), 128 deletions(-) diff --git a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen index e66608e6..07c1d082 100644 --- a/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen +++ b/risc-v/hgen/herdtools_ast_to_shallow_ast.hgen @@ -3,10 +3,10 @@ translate_imm20 "imm" imm, translate_reg "rd" rd, translate_uop op) -| `RISCVJAL(imm, rd) -> JAL0( +| `RISCVJAL(imm, rd) -> RISCV_JAL( translate_imm21 "imm" imm, translate_reg "rd" rd) -| `RISCVJALR(imm, rs, rd) -> JALR0( +| `RISCVJALR(imm, rs, rd) -> RISCV_JALR( translate_imm12 "imm" imm, translate_reg "rs" rd, translate_reg "rd" rd) diff --git a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen index 23bcc4cb..3025992e 100644 --- a/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen +++ b/risc-v/hgen/shallow_ast_to_herdtools_ast.hgen @@ -1,7 +1,7 @@ | EBREAK -> `RISCVStopFetching | UTYPE( imm, rd, op) -> `RISCVUTYPE(translate_out_simm20 imm, translate_out_ireg rd, translate_out_uop op) -| JAL0( imm, rd) -> `RISCVJAL(translate_out_simm21 imm, translate_out_ireg rd) -| JALR0( imm, rs, rd) -> `RISCVJALR(translate_out_simm12 imm, translate_out_ireg rs, translate_out_ireg rd) +| 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) diff --git a/risc-v/riscv.sail b/risc-v/riscv.sail index 3a54e0c8..3d52d111 100644 --- a/risc-v/riscv.sail +++ b/risc-v/riscv.sail @@ -20,11 +20,11 @@ function clause execute (UTYPE(imm, rd, op)) = wGPR(rd, ret) (********************************************************************) -union ast member ((bit[21]), regno) JAL +union ast member ((bit[21]), regno) RISCV_JAL -function clause decode ((bit[20]) imm : (regno) rd : 0b1101111) = Some (JAL(imm[19] : imm[7..0] : imm[8] : imm[18..13] : imm[12..9] : 0b0, rd)) +function clause decode ((bit[20]) imm : (regno) rd : 0b1101111) = Some (RISCV_JAL(imm[19] : imm[7..0] : imm[8] : imm[18..13] : imm[12..9] : 0b0, rd)) -function clause execute (JAL(imm, rd)) = { +function clause execute (RISCV_JAL(imm, rd)) = { (bit[64]) pc := PC; wGPR(rd, pc + 4); (bit[64]) offset := EXTS(imm); @@ -32,12 +32,12 @@ function clause execute (JAL(imm, rd)) = { } (********************************************************************) -union ast member((bit[12]), regno, regno) JALR +union ast member((bit[12]), regno, regno) RISCV_JALR function clause decode ((bit[12]) imm : (regno) rs1 : 0b000 : (regno) rd : 0b1100111) = - Some(JALR(imm, rs1, rd)) + Some(RISCV_JALR(imm, rs1, rd)) -function clause execute (JALR(imm, rs1, rd)) = { +function clause execute (RISCV_JALR(imm, rs1, rd)) = { (* write rd before anything else to prevent unintended strength *) wGPR(rd, PC + 4); (bit[64]) newPC := rGPR(rs1) + EXTS(imm); diff --git a/risc-v/riscv_regfp.sail b/risc-v/riscv_regfp.sail index ad341c60..dee9cc8e 100644 --- a/risc-v/riscv_regfp.sail +++ b/risc-v/riscv_regfp.sail @@ -20,12 +20,12 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( case (UTYPE ( imm, rd, op)) -> { if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; } - case (JAL ( imm, rd)) -> { + case (RISCV_JAL ( imm, rd)) -> { if (rd == 0) then () else oR := RFull(GPRstr[rd]) :: oR; let (bit[64]) offset = EXTS(imm) in Nias := [|| NIAFP_concrete_address (PC + offset) ||] } - case (JALR ( imm, rs, rd)) -> { + case (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 (bit[64]) offset = EXTS(imm) in diff --git a/x86/x64.sail b/x86/x64.sail index 16ba0f41..9fa0b838 100644 --- a/x86/x64.sail +++ b/x86/x64.sail @@ -147,7 +147,7 @@ typedef base = const union { typedef scale_index = (bit[2],regn) typedef rm = const union { - regn Reg; + regn X86_Reg; (option,base,qword) Mem; } @@ -167,10 +167,11 @@ typedef bit_offset = const union { (rm, regn) Bit_rm_r; } -typedef monop_name = enumerate { Dec; Inc; Not; Neg } +typedef monop_name = enumerate { X86_Dec; X86_Inc; X86_Not; X86_Neg } typedef binop_name = enumerate { - Add; Or; Adc; Sbb; And; Sub; Xor; Cmp; Rol; Ror; Rcl; Rcr; Shl; Shr; Test; Sar + X86_Add; X86_Or; X86_Adc; X86_Sbb; X86_And; X86_Sub; X86_Xor; X86_Cmp; + X86_Rol; X86_Ror; X86_Rcl; X86_Rcr; X86_Shl; X86_Shr; X86_Test; X86_Sar; } typedef bitop_name = enumerate { Bts; Btc; Btr } @@ -178,47 +179,48 @@ typedef bitop_name = enumerate { Bts; Btc; Btr } function binop_name opc_to_binop_name ((bit[4]) opc) = switch opc { - case 0x0 -> Add - case 0x1 -> Or - case 0x2 -> Adc - case 0x3 -> Sbb - case 0x4 -> And - case 0x5 -> Sub - case 0x6 -> Xor - case 0x7 -> Cmp - case 0x8 -> Rol - case 0x9 -> Ror - case 0xa -> Rcl - case 0xb -> Rcr - case 0xc -> Shl - case 0xd -> Shr - case 0xe -> Test - case 0xf -> Sar + case 0x0 -> X86_Add + case 0x1 -> X86_Or + case 0x2 -> X86_Adc + case 0x3 -> X86_Sbb + case 0x4 -> X86_And + case 0x5 -> X86_Sub + case 0x6 -> X86_Xor + case 0x7 -> X86_Cmp + case 0x8 -> X86_Rol + case 0x9 -> X86_Ror + case 0xa -> X86_Rcl + case 0xb -> X86_Rcr + case 0xc -> X86_Shl + case 0xd -> X86_Shr + case 0xe -> X86_Test + case 0xf -> X86_Sar } typedef cond = enumerate { - O; NO; B; NB; E; NE; NA; A; S; NS; P; NP; L; NL; NG; G; ALWAYS + X86_O; X86_NO; X86_B; X86_NB; X86_E; X86_NE; X86_NA; X86_A; X86_S; + X86_NS; X86_P; X86_NP; X86_L; X86_NL; X86_NG; X86_G; X86_ALWAYS; } function cond bv_to_cond ((bit[4]) v) = switch v { - case 0x0 -> O - case 0x1 -> NO - case 0x2 -> B - case 0x3 -> NB - case 0x4 -> E - case 0x5 -> NE - case 0x6 -> NA - case 0x7 -> A - case 0x8 -> S - case 0x9 -> NS - case 0xa -> P - case 0xb -> NP - case 0xc -> L - case 0xd -> NL - case 0xe -> NG - case 0xf -> G + case 0x0 -> X86_O + case 0x1 -> X86_NO + case 0x2 -> X86_B + case 0x3 -> X86_NB + case 0x4 -> X86_E + case 0x5 -> X86_NE + case 0x6 -> X86_NA + case 0x7 -> X86_A + case 0x8 -> X86_S + case 0x9 -> X86_NS + case 0xa -> X86_P + case 0xb -> X86_NP + case 0xc -> X86_L + case 0xd -> X86_NL + case 0xe -> X86_NG + case 0xf -> X86_G } (* Effective addresses *) @@ -248,7 +250,7 @@ function qword ea_base ((base) b) = function ea ea_rm ((wsize) sz, (rm) r) = switch r { - case (Reg(n)) -> Ea_r (sz, n) + case (X86_Reg(n)) -> Ea_r (sz, n) case (Mem(idx, b, d)) -> Ea_m (sz, ea_index(idx) + (qword) (ea_base(b) + d)) } @@ -509,22 +511,22 @@ function qword sar ((wsize) sz, (qword) a, (qword) b) = function unit write_binop ((bool) locked, (wsize) sz, (binop_name) bop, (qword) a, (qword) b, (ea) e) = switch bop { - case Add -> let (w,c,x) = add_with_carry_out (sz, a, b) in + case X86_Add -> let (w,c,x) = add_with_carry_out (sz, a, b) in write_arith_result (locked, sz, w, c, x, e) - case Sub -> let (w,c,x) = sub_with_borrow (sz, a, b) in + case X86_Sub -> let (w,c,x) = sub_with_borrow (sz, a, b) in write_arith_result (locked, sz, w, c, x, e) - case Cmp -> let (w,c,x) = sub_with_borrow (sz, a, b) in + case X86_Cmp -> let (w,c,x) = sub_with_borrow (sz, a, b) in write_arith_eflags (sz, w, c, x) - case Test -> write_logical_eflags (sz, a & b) - case And -> write_logical_result (locked, sz, a & b, e) (* XXX rmn30 wrong flags? *) - case Xor -> write_logical_result (locked, sz, a ^ b, e) - case Or -> write_logical_result (locked, sz, a | b, e) - case Rol -> write_result_erase_eflags (locked, rol (sz, a, b), e) - case Ror -> write_result_erase_eflags (locked, ror (sz, a, b), e) - case Sar -> write_result_erase_eflags (locked, sar (sz, a, b), e) - case Shl -> write_result_erase_eflags (locked, a << mask_shift (sz, b), e) - case Shr -> write_result_erase_eflags (locked, a >> mask_shift (sz, b), e) - case Adc -> + case X86_Test -> write_logical_eflags (sz, a & b) + case X86_And -> write_logical_result (locked, sz, a & b, e) (* XXX rmn30 wrong flags? *) + case X86_Xor -> write_logical_result (locked, sz, a ^ b, e) + case X86_Or -> write_logical_result (locked, sz, a | b, e) + case X86_Rol -> write_result_erase_eflags (locked, rol (sz, a, b), e) + case X86_Ror -> write_result_erase_eflags (locked, ror (sz, a, b), e) + case X86_Sar -> write_result_erase_eflags (locked, sar (sz, a, b), e) + case X86_Shl -> write_result_erase_eflags (locked, a << mask_shift (sz, b), e) + case X86_Shr -> write_result_erase_eflags (locked, a >> mask_shift (sz, b), e) + case X86_Adc -> { let carry = (bit) CF in let (qword) result = a + (qword) (b + carry) in @@ -534,7 +536,7 @@ function unit write_binop ((bool) locked, (wsize) sz, (binop_name) bop, (qword) write_arith_result_no_CF_OF (locked, sz, result, e); } } - case Sbb -> + case X86_Sbb -> { let carry = (bit) CF in let (qword) result = a - (qword) (b + carry) in @@ -549,33 +551,33 @@ function unit write_binop ((bool) locked, (wsize) sz, (binop_name) bop, (qword) function unit write_monop ((bool) locked, (wsize) sz, (monop_name) mop, (qword) a, (ea) e) = switch mop { - case Not -> wEA(locked, e) := ~(a) - case Dec -> write_arith_result_no_CF_OF (locked, sz, a - 1, e) - case Inc -> write_arith_result_no_CF_OF (locked, sz, a + 1, e)(* XXX rmn30 should set OF *) - case Neg -> { write_arith_result_no_CF_OF (locked, sz, 0 - a, e); - CF := undefined; - } + case X86_Not -> wEA(locked, e) := ~(a) + case X86_Dec -> write_arith_result_no_CF_OF (locked, sz, a - 1, e) + case X86_Inc -> write_arith_result_no_CF_OF (locked, sz, a + 1, e)(* XXX rmn30 should set OF *) + case X86_Neg -> { write_arith_result_no_CF_OF (locked, sz, 0 - a, e); + CF := undefined; + } } function bool read_cond ((cond) c) = switch c { - case A -> ~(CF) & ~(ZF) - case NB -> ~(CF) - case B -> CF - case NA -> CF | (bit) ZF - case E -> ZF - case G -> ~(ZF) & (SF == OF) - case NL -> SF == OF - case L -> SF != OF - case NG -> ZF | SF != OF - case NE -> ~(ZF) - case NO -> ~(OF) - case NP -> ~(PF) - case NS -> ~(SF) - case O -> OF - case P -> PF - case S -> SF - case ALWAYS -> true + case X86_A -> ~(CF) & ~(ZF) + case X86_NB -> ~(CF) + case X86_B -> CF + case X86_NA -> CF | (bit) ZF + case X86_E -> ZF + case X86_G -> ~(ZF) & (SF == OF) + case X86_NL -> SF == OF + case X86_L -> SF != OF + case X86_NG -> ZF | SF != OF + case X86_NE -> ~(ZF) + case X86_NO -> ~(OF) + case X86_NP -> ~(PF) + case X86_NS -> ~(SF) + case X86_O -> OF + case X86_P -> PF + case X86_S -> SF + case X86_ALWAYS -> true } function qword pop_aux () = @@ -677,7 +679,7 @@ function clause execute (CMPXCHG (locked, sz,r,n)) = let val_dst = EA(locked, dst) in let val_acc = EA(false, acc) in { - write_binop (locked, sz, Cmp, val_acc, val_dst, src); + write_binop (locked, sz, X86_Cmp, val_acc, val_dst, src); if val_acc == val_dst then wEA(locked, dst) := EA (false, src) else { @@ -692,9 +694,9 @@ function clause execute (CMPXCHG (locked, sz,r,n)) = DIV ========================================================================== *) -union ast member (wsize,rm) DIV +union ast member (wsize,rm) X86_DIV -function clause execute (DIV (sz,r)) = +function clause execute (X86_DIV (sz,r)) = let w = (int) (value_width(sz)) in let eax = Ea_r(sz, 0) in (* RAX *) let edx = Ea_r(sz, 2) in (* RDX *) @@ -756,7 +758,7 @@ union ast member unit LEAVE function clause execute LEAVE = { RSP := RBP; - pop (Reg (5)); (* RBP *) + pop (X86_Reg (5)); (* RBP *) } (* ========================================================================== @@ -828,9 +830,9 @@ function clause execute (MOVZX (sz1,ds,sz2)) = MUL ========================================================================== *) -union ast member (wsize,rm) MUL +union ast member (wsize,rm) X86_MUL -function clause execute (MUL (sz,r)) = +function clause execute (X86_MUL (sz,r)) = let eax = Ea_r (sz, 0) in (* RAX *) let val_eax = EA(false, eax) in let val_src = EA(false, ea_rm (sz, r)) in @@ -911,7 +913,7 @@ function clause execute (XADD (locked,sz,r,n)) = let val_dst = EA(locked, dst) in { wEA(false, src) := val_dst; - write_binop (locked, sz, Add, val_src, val_dst, dst); + write_binop (locked, sz, X86_Add, val_src, val_dst, dst); } (* ========================================================================== @@ -1326,7 +1328,7 @@ function (regfps) regfp_idx ((option) idx) = function (bool, regfps, regfps) regfp_rm ((rm) r) = switch r { - case (Reg(n)) -> + case (X86_Reg(n)) -> (false, [|| RFull(GPRstr[n]) ||], [|| ||]) case (Mem(idx, b, d)) -> { (true, [|| ||], append(regfp_idx(idx), regfp_base(b))) @@ -1374,40 +1376,40 @@ let all_flags = append([|| RFull("CF"), RFull("OF") ||], all_flags_but_cf_of) function (regfps) regfp_binop_flags ((binop_name) op) = switch (op) { - case Add -> all_flags - case Sub -> all_flags - case Cmp -> all_flags - case Test -> all_flags_but_cf_of - case And -> all_flags_but_cf_of - case Xor -> all_flags_but_cf_of - case Or -> all_flags_but_cf_of - case Rol -> all_flags - case Ror -> all_flags - case Sar -> all_flags - case Shl -> all_flags - case Shr -> all_flags - case Adc -> all_flags - case Sbb -> all_flags + case X86_Add -> all_flags + case X86_Sub -> all_flags + case X86_Cmp -> all_flags + case X86_Test -> all_flags_but_cf_of + case X86_And -> all_flags_but_cf_of + case X86_Xor -> all_flags_but_cf_of + case X86_Or -> all_flags_but_cf_of + case X86_Rol -> all_flags + case X86_Ror -> all_flags + case X86_Sar -> all_flags + case X86_Shl -> all_flags + case X86_Shr -> all_flags + case X86_Adc -> all_flags + case X86_Sbb -> all_flags } function (regfps) regfp_cond ((cond) c) = switch c { - case A -> [|| RFull("CF"), RFull("ZF") ||] - case NB -> [|| RFull("CF") ||] - case B -> [|| RFull("CF") ||] - case NA -> [|| RFull("CF"), RFull("ZF") ||] - case E -> [|| RFull("ZF") ||] - case G -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] - case NL -> [|| RFull("SF"), RFull("OF") ||] - case L -> [|| RFull("SF"), RFull("OF") ||] - case NG -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] - case NE -> [|| RFull("ZF") ||] - case NO -> [|| RFull("OF") ||] - case NP -> [|| RFull("PF") ||] - case NS -> [|| RFull("SF") ||] - case O -> [|| RFull("OF") ||] - case P -> [|| RFull("PF") ||] - case S -> [|| RFull("SF") ||] - case ALWAYS -> [|| ||] + case X86_A -> [|| RFull("CF"), RFull("ZF") ||] + case X86_NB -> [|| RFull("CF") ||] + case X86_B -> [|| RFull("CF") ||] + case X86_NA -> [|| RFull("CF"), RFull("ZF") ||] + case X86_E -> [|| RFull("ZF") ||] + case X86_G -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] + case X86_NL -> [|| RFull("SF"), RFull("OF") ||] + case X86_L -> [|| RFull("SF"), RFull("OF") ||] + case X86_NG -> [|| RFull("ZF"), RFull("SF"), RFull("OF") ||] + case X86_NE -> [|| RFull("ZF") ||] + case X86_NO -> [|| RFull("OF") ||] + case X86_NP -> [|| RFull("PF") ||] + case X86_NS -> [|| RFull("SF") ||] + case X86_O -> [|| RFull("OF") ||] + case X86_P -> [|| RFull("PF") ||] + case X86_S -> [|| RFull("SF") ||] + case X86_ALWAYS -> [|| ||] } function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis (instr) = { @@ -1471,10 +1473,10 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( let (m, rs, aRs) = regfp_rm (r_m) in { ik := if m then IK_mem_rmw (rk, wk) else IK_simple; iR := RFull("RAX") :: RFull(GPRstr[reg]) :: append(rs, aRs); - oR := RFull("RAX") :: append(regfp_binop_flags(Cmp), rs); + oR := RFull("RAX") :: append(regfp_binop_flags(X86_Cmp), rs); aR := aRs; } - case(DIV (sz, r_m) ) -> + case(X86_DIV (sz, r_m) ) -> let (m, rs, ars) = regfp_rm (r_m) in { ik := if m then IK_mem_read (Read_plain) else IK_simple; iR := RFull("RAX") :: RFull("RDX") :: append(rs, ars); @@ -1549,7 +1551,7 @@ function (regfps,regfps,regfps,niafps,diafp,instruction_kind) initial_analysis ( oR := ors; aR := ars; } - case(MUL (sz, r_m) ) -> + case(X86_MUL (sz, r_m) ) -> let (m, rs, ars) = regfp_rm (r_m) in { ik := if m then IK_mem_read (Read_plain) else IK_simple; iR := RFull("RAX") :: append(rs, ars); -- cgit v1.2.3