Commit 974b6c23 authored by Rodolphe Lepigre's avatar Rodolphe Lepigre
Browse files

Abstract away the events.

parent 79385a3f
...@@ -14,6 +14,49 @@ Section c_type. ...@@ -14,6 +14,49 @@ Section c_type.
Definition dearray (τ : c_type) : c_type := τ. Definition dearray (τ : c_type) : c_type := τ.
End c_type. End c_type.
Definition tag_symb := string. (* FIXME *)
Definition memb_ident := string.
(** Allocation kind. *)
Inductive allocation_kind := object | region.
(** Relational operator. *)
Inductive rel_op := Lt | Le | Gt | Ge.
(** Generic notion of event. *)
Section event.
Context {ptr_value int_value value : Set}.
Inductive event :=
(** allocate_object(al, τ, {readWrite|readOnly(v)}) = p *)
| allocate_object (al : N) (τ : c_type) (v : option value) (p : ptr_value)
(** allocate_region(al, n) = p *)
| allocate_region (al : N) (n : N) (p : ptr_value)
(** kill_{object|region}(p) *)
| kill (k : allocation_kind) (p : ptr_value)
(** load(τ, p) = v *)
| load (τ : c_type) (p : ptr_value) (v : value) (* FIXME add footprint? *)
(** store(τ, p, v) *)
| store (τ : c_type) (p : ptr_value) (v : value) (* FIXME add footprint? *)
(** diff_ptrval(τ, p1, p2) = x *)
| diff_ptrval (τ : c_type) (p1 p2 : ptr_value) (x : int_value)
(** relop_ptrval(op, p1, p2) = b *)
| relop_ptrval (op : rel_op) (p1 p2 : ptr_value) (b : bool)
(** eq_ptrval(p1, p2) = b *)
| eq_ptrval (p1 p2 : ptr_value) (b : bool)
(** array_offset(p, τ, n) = p' *)
| array_offset (p : ptr_value) (τ : c_type) (n : N) (p' : ptr_value)
(** member_offset(p, T, x) = p' *)
| member_offset (p : ptr_value) (T : tag_symb) (x : memb_ident) (p' : ptr_value)
(** cast_ival_to_ptrval(τ, x) = p *)
| cast_ival_to_ptrval (τ : c_type) (x : int_value) (p : ptr_value)
(** cast_ptrval_to_ival(τ, p) = x *)
| cast_ptrval_to_ival (τ : c_type) (p : ptr_value) (x : int_value)
(** copy_alloc_id(τ, x, p) = p' - only used by Caesium. *)
| copy_alloc_id (τ : c_type) (x : int_value) (p : ptr_value) (p' : ptr_value)
.
End event.
(** * Provenance *) (** * Provenance *)
Definition allocation_id := Z. Definition allocation_id := Z.
...@@ -28,8 +71,8 @@ Inductive provenance := ...@@ -28,8 +71,8 @@ Inductive provenance :=
(** Symbolic provenance. *) (** Symbolic provenance. *)
| Psymbolic (ι : symbol). | Psymbolic (ι : symbol).
Notation "@empty" := (Pempty). Notation "$empty" := (Pempty).
Notation "@ i" := (@Palloc_id i) (at level 100). Notation "$ i" := (Palloc_id i) (at level 10).
Instance provenance_eq_dec : EqDecision provenance. Instance provenance_eq_dec : EqDecision provenance.
Proof. Proof.
...@@ -47,7 +90,6 @@ Qed. ...@@ -47,7 +90,6 @@ Qed.
Definition address := N. Definition address := N.
Inductive kind := object | region.
Inductive access := readWrite | readOnly. Inductive access := readWrite | readOnly.
Inductive taint_flag := exposed | unexposed. Inductive taint_flag := exposed | unexposed.
...@@ -61,7 +103,7 @@ Record allocation := Alloc { ...@@ -61,7 +103,7 @@ Record allocation := Alloc {
(** Is the allocation read-only? *) (** Is the allocation read-only? *)
alloc_access : access; alloc_access : access;
(** Allocation kind: it is an object? Otherwise region. *) (** Allocation kind: it is an object? Otherwise region. *)
alloc_kind : kind; alloc_kind : allocation_kind;
(** Taint flag: has the allocaiton been exposed? *) (** Taint flag: has the allocaiton been exposed? *)
alloc_taint_flag : taint_flag; alloc_taint_flag : taint_flag;
}. }.
...@@ -129,13 +171,13 @@ Inductive ptr_value := ...@@ -129,13 +171,13 @@ Inductive ptr_value :=
Fixpoint go_combine_prov acc πs := Fixpoint go_combine_prov acc πs :=
match πs with match πs with
| [] => default @empty acc | [] => default $empty acc
| π :: πs => match acc with | π :: πs => match acc with
| None => go_combine_prov (Some π) πs | None => go_combine_prov (Some π) πs
| Some π' => if bool_decide (π = π') then | Some π' => if bool_decide (π = π') then
go_combine_prov acc πs go_combine_prov acc πs
else else
@empty $empty
end end
end. end.
...@@ -151,45 +193,6 @@ Section value. ...@@ -151,45 +193,6 @@ Section value.
: option (value * gset allocation_id) := Some ((), ). : option (value * gset allocation_id) := Some ((), ).
End value. End value.
(** * Events. *)
Inductive rel_op := Lt | Le | Gt | Ge.
Definition interp_rel_op (op : rel_op) (a1 a2 : address) : bool :=
match op with
| Lt => bool_decide (a1 < a2)%N
| Le => bool_decide (a1 a2)%N
| Gt => bool_decide (¬ (a1 a2))%N
| Ge => bool_decide (¬ (a1 < a2))%N
end.
Inductive event :=
(** allocate_object(al, τ, {readWrite|readOnly(v)}) = p *)
| allocate_object (al : N) (τ : c_type) (v : option value) (p : ptr_value)
(** allocate_region(al, n) = p *)
| allocate_region (al : N) (n : N) (p : ptr_value)
(** kill_{object|region}(p) *)
| kill (kind : kind) (p : ptr_value)
(** load(τ, p) = v *)
| load (τ : c_type) (p : ptr_value) (v : value) (* FIXME add footprint? *)
(** store(τ, p, v) *)
| store (τ : c_type) (p : ptr_value) (v : value) (* FIXME add footprint? *)
(** diff_ptrval(τ, p1, p2) = x *)
| diff_ptrval (τ : c_type) (p1 p2 : ptr_value) (x : Z)
(** relop_ptrval(op, p1, p2) = b *)
| relop_ptrval (op : rel_op) (p1 p2 : ptr_value) (b : bool)
(** eq_ptrval(p1, p2) = b *)
| eq_ptrval (p1 p2 : ptr_value) (b : bool)
(** array_offset(p, τ, n) = p' *)
| array_offset (p : ptr_value) (τ : c_type) (n : N) (p' : ptr_value)
(** member_offset(p, T, x) = p' *)
| member_offset (p : ptr_value) (T : unit) (x : unit) (p' : ptr_value) (* FIXME *)
(** cast_ival_to_ptrval(τ, x) = p *)
| cast_ival_to_ptrval (τ : c_type) (x : Z) (p : ptr_value)
(** cast_ptrval_to_ival(τ, p) = x *)
| cast_ptrval_to_ival (τ : c_type) (p : ptr_value) (x : Z)
.
(** Allocating an object or a region. *) (** Allocating an object or a region. *)
Definition valid_new_alloc a (A : allocation_map) al n := Definition valid_new_alloc a (A : allocation_map) al n :=
...@@ -222,12 +225,22 @@ Definition expose (A : allocation_map) (I : gset allocation_id) := ...@@ -222,12 +225,22 @@ Definition expose (A : allocation_map) (I : gset allocation_id) :=
let m := set_fold f A.(am_id_map) I in let m := set_fold f A.(am_id_map) I in
AllocMap m A.(am_symb_map). AllocMap m A.(am_symb_map).
Inductive mem_step : mem_state event mem_state Prop := Definition interp_rel_op (op : rel_op) (a1 a2 : address) : bool :=
match op with
| Lt => bool_decide (a1 < a2)%N
| Le => bool_decide (a1 a2)%N
| Gt => bool_decide (¬ (a1 a2))%N
| Ge => bool_decide (¬ (a1 < a2))%N
end.
Definition PNVI_event := @event ptr_value Z value.
Inductive mem_step : mem_state PNVI_event mem_state Prop :=
| Alloc_object_rw A M al τ p n a i: | Alloc_object_rw A M al τ p n a i:
n = size_of τ n = size_of τ
A.(am_id_map) !! i = None A.(am_id_map) !! i = None
valid_new_alloc a A al n valid_new_alloc a A al n
p = Ptr (@i) a p = Ptr ($ i) a
let A' := let A' :=
let alloc := Some (Alloc n (Some τ) a readWrite object unexposed) in let alloc := Some (Alloc n (Some τ) a readWrite object unexposed) in
AllocMap (<[i := alloc]> A.(am_id_map)) A.(am_symb_map) AllocMap (<[i := alloc]> A.(am_id_map)) A.(am_symb_map)
...@@ -240,7 +253,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -240,7 +253,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
n = size_of τ n = size_of τ
A.(am_id_map) !! i = None A.(am_id_map) !! i = None
valid_new_alloc a A al n valid_new_alloc a A al n
p = Ptr (@i) a p = Ptr ($i) a
bs = repr v bs = repr v
let A' := let A' :=
let alloc := Some (Alloc n (Some τ) a readOnly object unexposed) in let alloc := Some (Alloc n (Some τ) a readOnly object unexposed) in
...@@ -254,7 +267,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -254,7 +267,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
| Alloc_region A M al p n a i: | Alloc_region A M al p n a i:
A.(am_id_map) !! i = None A.(am_id_map) !! i = None
valid_new_alloc a A al n valid_new_alloc a A al n
p = Ptr (@i) a p = Ptr ($i) a
let A' := let A' :=
let alloc := Some (Alloc n None a readWrite region unexposed) in let alloc := Some (Alloc n None a readWrite region unexposed) in
AllocMap (<[i := alloc]> A.(am_id_map)) A.(am_symb_map) AllocMap (<[i := alloc]> A.(am_id_map)) A.(am_symb_map)
...@@ -264,7 +277,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -264,7 +277,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(allocate_region al n p) (allocate_region al n p)
(State A' M) (State A' M)
| Kill A M k p i a alloc: | Kill A M k p i a alloc:
p = Ptr (@i) a p = Ptr ($i) a
A.(am_id_map) !! i = Some (Some alloc) A.(am_id_map) !! i = Some (Some alloc)
a = alloc.(alloc_addr) a = alloc.(alloc_addr)
k = alloc.(alloc_kind) k = alloc.(alloc_kind)
...@@ -307,7 +320,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -307,7 +320,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(kill k p) (kill k p)
(State A' M) (State A' M)
| Load A M τ p v a i n bs I_tainted: | Load A M τ p v a i n bs I_tainted:
p = Ptr (@i) a p = Ptr ($i) a
n = size_of τ n = size_of τ
bound_check op_load a n i A bound_check op_load a n i A
memory_read M a (N.to_nat n) = Some bs memory_read M a (N.to_nat n) = Some bs
...@@ -332,7 +345,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -332,7 +345,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(load τ p v) (load τ p v)
(State A'' M) (State A'' M)
| Store A M τ p v i a n: | Store A M τ p v i a n:
p = Ptr (@i) a p = Ptr ($i) a
n = size_of τ n = size_of τ
bound_check op_store a n i A bound_check op_store a n i A
let M' := memory_write M a (repr v) in let M' := memory_write M a (repr v) in
...@@ -353,8 +366,8 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -353,8 +366,8 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(store τ p v) (store τ p v)
(State A' M') (State A' M')
| Diff_ptrval A M τ p1 p2 x i1 a1 i2 a2 alloc: | Diff_ptrval A M τ p1 p2 x i1 a1 i2 a2 alloc:
p1 = Ptr (@i1) a1 p1 = Ptr ($i1) a1
p2 = Ptr (@i2) a2 p2 = Ptr ($i2) a2
i1 = i2 i1 = i2
A.(am_id_map) !! i1 = Some (Some alloc) A.(am_id_map) !! i1 = Some (Some alloc)
(alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N (alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N
...@@ -365,7 +378,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -365,7 +378,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(diff_ptrval τ p1 p2 x) (diff_ptrval τ p1 p2 x)
(State A M) (State A M)
| Diff_ptrval_iota_r A M τ p1 p2 x i a1 ι a2 alloc: | Diff_ptrval_iota_r A M τ p1 p2 x i a1 ι a2 alloc:
p1 = Ptr (@i) a1 p1 = Ptr ($i) a1
p2 = Ptr (Psymbolic ι) a2 p2 = Ptr (Psymbolic ι) a2
i symb_set A ι i symb_set A ι
A.(am_id_map) !! i = Some (Some alloc) A.(am_id_map) !! i = Some (Some alloc)
...@@ -379,7 +392,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -379,7 +392,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(State A' M) (State A' M)
| Diff_ptrval_iota_l A M τ p1 p2 x ι a1 i a2 alloc: | Diff_ptrval_iota_l A M τ p1 p2 x ι a1 i a2 alloc:
p1 = Ptr (Psymbolic ι) a2 p1 = Ptr (Psymbolic ι) a2
p2 = Ptr (@i) a2 p2 = Ptr ($i) a2
i symb_set A ι i symb_set A ι
A.(am_id_map) !! i = Some (Some alloc) A.(am_id_map) !! i = Some (Some alloc)
(alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N (alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N
...@@ -422,8 +435,8 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -422,8 +435,8 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(diff_ptrval τ p1 p2 x) (diff_ptrval τ p1 p2 x)
(State A' M) (State A' M)
| Pointer_relop A M op p1 p2 b i1 a1 i2 a2 alloc: | Pointer_relop A M op p1 p2 b i1 a1 i2 a2 alloc:
p1 = Ptr (@i1) a1 p1 = Ptr ($i1) a1
p2 = Ptr (@i2) a2 p2 = Ptr ($i2) a2
i1 = i2 i1 = i2
A.(am_id_map) !! i1 = Some (Some alloc) A.(am_id_map) !! i1 = Some (Some alloc)
(alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N (alloc.(alloc_addr) a1 alloc.(alloc_addr) + alloc.(alloc_size))%N
...@@ -453,7 +466,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -453,7 +466,7 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(alloc.(alloc_addr) a alloc.(alloc_addr) + alloc.(alloc_size))%N (alloc.(alloc_addr) a alloc.(alloc_addr) + alloc.(alloc_size))%N
alloc.(alloc_taint_flag) = exposed alloc.(alloc_taint_flag) = exposed
(* FIXME ensure no other candidate alloc? *) (* FIXME ensure no other candidate alloc? *)
p = Ptr (@i) a p = Ptr ($i) a
mem_step mem_step
(State A M) (State A M)
(cast_ival_to_ptrval τ x p ) (cast_ival_to_ptrval τ x p )
...@@ -475,13 +488,13 @@ Inductive mem_step : mem_state → event → mem_state → Prop := ...@@ -475,13 +488,13 @@ Inductive mem_step : mem_state → event → mem_state → Prop :=
(State A' M) (State A' M)
| Intptr_cast_fallback A M τ x p a: | Intptr_cast_fallback A M τ x p a:
(* FIXME check no candidate alloc? *) (* FIXME check no candidate alloc? *)
p = Ptr (@empty) a p = Ptr ($empty) a
mem_step mem_step
(State A M) (State A M)
(cast_ival_to_ptrval τ x p) (cast_ival_to_ptrval τ x p)
(State A M) (State A M)
| Ptrint_cast A M τ p x i a alloc: | Ptrint_cast A M τ p x i a alloc:
p = Ptr (@i) a (* FIXME What about other shapes of pointers. *) p = Ptr ($i) a (* FIXME What about other shapes of pointers. *)
A.(am_id_map) !! i = Some (Some alloc) A.(am_id_map) !! i = Some (Some alloc)
x = Z.of_N a x = Z.of_N a
let A' := expose A {[i]} in let A' := expose A {[i]} in
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment