-
Notifications
You must be signed in to change notification settings - Fork 108
/
CommonOps.thy
148 lines (117 loc) · 4.43 KB
/
CommonOps.thy
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(*
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
*
* SPDX-License-Identifier: BSD-2-Clause
*)
theory CommonOps
imports
"CLib.CTranslationNICTA"
GlobalsSwap
ArchSetup
begin
text \<open>Additional constants needed to make conversion to and from the graph lang easy\<close>
definition
bvshl :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where
"bvshl x y = x << (unat y)"
definition
bvlshr :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where
"bvlshr x y = x >> (unat y)"
definition
bvashr :: "'a :: len word \<Rightarrow> 'a word \<Rightarrow> 'a word"
where
"bvashr x y = x >>> (unat y)"
definition
bv_shift_amount :: "nat => 'a :: len word"
where
"bv_shift_amount n = of_nat (min n ((2 ^ len_of TYPE('a)) - 1))"
definition
bv_clz :: "('a :: len) word \<Rightarrow> 'a word"
where
"bv_clz x = of_nat (word_clz x)"
definition
bv_ctz :: "('a :: len) word \<Rightarrow> 'a word"
where
"bv_ctz x = of_nat (word_ctz x)"
definition
bv_popcount :: "('a :: len) word \<Rightarrow> 'a word"
where
"bv_popcount x = of_nat (pop_count x)"
definition
"mem_acc mem addr = h_val mem (Ptr addr)"
definition
"mem_upd mem addr v = heap_update (Ptr addr) v mem"
definition
"store_word8 (addr :: addr) (w :: word8) m = m (addr := w)"
definition
"load_word8 (addr :: addr) m = (m addr :: word8)"
definition
"store_word32 (addr :: addr) (w :: word32)
= heap_update_list addr (rev (word_rsplit w))"
definition
"load_word32 (addr :: addr) memory
= (word_rcat (rev (heap_list memory 4 addr)) :: word32)"
definition
"store_word64 (addr :: addr) (w :: word64)
= heap_update_list addr (rev (word_rsplit w))"
definition
"load_word64 (addr :: addr) memory
= (word_rcat (rev (heap_list memory 8 addr)) :: word64)"
abbreviation (input)
"store_machine_word :: machine_word mem_upd
\<equiv> arch_store_machine_word store_word32 store_word64"
abbreviation (input)
"load_machine_word :: machine_word mem_read
\<equiv> arch_load_machine_word load_word32 load_word64"
definition
word_add_with_carry :: "('a :: len) word \<Rightarrow> 'a word \<Rightarrow> bool
\<Rightarrow> ('a word \<times> (bool \<times> bool))"
where
"word_add_with_carry x y cin \<equiv>
let cinw = if cin then 1 else 0
in (x + y + cinw,
unat (x + y + cinw) \<noteq> unat x + unat y + unat cinw,
(msb x \<noteq> msb y) \<and> (msb x \<noteq> msb (x + y + cinw)))"
\<comment> \<open>
`all_htd_updates` is a utility term that we use to stash HTD updates when
going into and out of GraphLang.
\<close>
definition
all_htd_updates :: "('a :: c_type) itself \<Rightarrow> machine_word \<Rightarrow> addr \<Rightarrow> machine_word
\<Rightarrow> heap_typ_desc \<Rightarrow> heap_typ_desc"
where
"all_htd_updates (tp :: ('a :: c_type) itself) mode p sz
= (if mode = 0
then typ_clear_region p (unat sz)
else if mode = 1 then ptr_retyps (unat sz) (Ptr p:: 'a ptr)
else if mode = 2 then typ_region_bytes p (unat sz)
else if mode = 3 then ptr_retyps (2 ^ unat sz) (Ptr p :: 'a ptr)
else if mode = 4 then ptr_arr_retyps (unat sz) (Ptr p :: 'a ptr)
else ptr_arr_retyps (2 ^ unat sz) (Ptr p :: 'a ptr))"
\<comment> \<open>
This type has a weird domain @{typ "50 word"} to help you figure out the
source of your problem when asmrefine breaks - if you see `50 word`, it's
probably a ghost_assertions problem.
\<close>
type_synonym ghost_assertions = "50 word \<Rightarrow> addr"
definition
ghost_assertion_data_get :: "int \<Rightarrow> ('a \<Rightarrow> ghost_assertions) \<Rightarrow> 'a \<Rightarrow> addr"
where
"ghost_assertion_data_get k acc s = (acc s) (word_of_int k)"
definition
ghost_assertion_data_set :: "int \<Rightarrow> addr \<Rightarrow> ((ghost_assertions \<Rightarrow> ghost_assertions) \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a"
where
"ghost_assertion_data_set k v upd = upd (\<lambda>f. f (word_of_int k := v))"
definition
"pvalid htd (v :: ('a :: c_type) itself) x = h_t_valid htd c_guard (Ptr x :: 'a ptr)"
definition
"palign_valid (v :: ('a :: c_type) itself) x = c_guard (Ptr x :: 'a ptr)"
definition
"pweak_valid htd (v :: ('a :: c_type) itself) x = ptr_safe (Ptr x :: 'a ptr) htd"
definition
"pglobal_valid htd (v :: ('a :: mem_type) itself) x = ptr_inverse_safe (Ptr x :: 'a ptr) htd"
definition
"parray_valid htd (v :: ('a :: c_type) itself) x n
= array_assertion (Ptr x :: 'a ptr) (unat n) htd"
end