File: x86_extras.lem

package info (click to toggle)
sail-ocaml 0.19.1%2Bdfsg5-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 18,008 kB
  • sloc: ml: 75,941; ansic: 8,848; python: 1,342; exp: 560; sh: 474; makefile: 218; cpp: 36
file content (53 lines) | stat: -rw-r--r-- 2,125 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
open import Pervasives
open import Interp_ast
open import Interp_interface
open import Sail_impl_base
open import Interp_inter_imp
import Set_extra

let memory_parameter_transformer mode v =
  match v with
  | Interp_ast.V_tuple [location;length] ->
    let (v,loc_regs) = extern_with_track mode extern_vector_value location in

    match length with
    | Interp_ast.V_lit (L_aux (L_num len) _) ->
      (v,(natFromInteger len),loc_regs)
    | Interp_ast.V_track (Interp_ast.V_lit (L_aux (L_num len) _)) size_regs ->
      match loc_regs with
      | Nothing -> (v,(natFromInteger len),Just (List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs)))
      | Just loc_regs -> (v,(natFromInteger len),Just (loc_regs++(List.map (fun r -> extern_reg r Nothing) (Set_extra.toList size_regs))))
      end
    | _ -> Assert_extra.failwith "expected 'V_lit (L_aux (L_num _) _)' or 'V_track (V_lit (L_aux (L_num len) _)) _'"
    end
  | _ -> Assert_extra.failwith ("memory_parameter_transformer: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
  end

let memory_parameter_transformer_option_address _mode v =
  match v with
  | Interp_ast.V_tuple [location;_] ->
     Just (extern_vector_value location)
  | _ -> Assert_extra.failwith ("memory_parameter_transformer_option_address: expected 'V_tuple [_;_]' given " ^ (Interp.string_of_value v))
  end

let x86_read_memory_functions : memory_reads =
  [ ("rMEM",                  (MR Read_plain                  memory_parameter_transformer));
    ("rMEM_locked",           (MR Read_X86_locked             memory_parameter_transformer));
  ]

let x86_memory_writes : memory_writes =
  []

let x86_memory_eas : memory_write_eas =
  [ ("MEMea",                     (MEA Write_plain                     memory_parameter_transformer));
    ("MEMea_locked",              (MEA Write_X86_locked                memory_parameter_transformer));
  ]

let x86_memory_vals : memory_write_vals =
  [ ("MEMval",                    (MV memory_parameter_transformer_option_address Nothing));
  ]

let x86_barrier_functions =
  [ 
  ("X86_MFENCE", Barrier_x86_MFENCE);
  ]