Section RELSEM.
Variable return_address_offset: function -> code -> ptrofs -> Prop.
Variable ge: genv.
Definition find_function_ptr
(ge: genv) (ros: mreg + ident) (rs: regset) : option block :=
match ros with
| inl r =>
match rs r with
| Vptr b ofs => if Ptrofs.eq ofs Ptrofs.zero then Some b else None
| _ => None
end
| inr symb =>
Genv.find_symbol ge symb
end.
(** Extract the values of the arguments to an external call. *)
Inductive extcall_arg (rs: regset) (m: mem) (sp: val): loc -> val -> Prop :=
| extcall_arg_reg: forall r,
extcall_arg rs m sp (R r) (rs r)
| extcall_arg_stack: forall ofs ty v,
load_stack m sp ty (Ptrofs.repr (Stacklayout.fe_ofs_arg + 4 * ofs)) = Some v ->
extcall_arg rs m sp (S Outgoing ofs ty) v.
Inductive extcall_arg_pair (rs: regset) (m: mem) (sp: val): rpair loc -> val -> Prop :=
| extcall_arg_one: forall l v,
extcall_arg rs m sp l v ->
extcall_arg_pair rs m sp (One l) v
| extcall_arg_twolong: forall hi lo vhi vlo,
extcall_arg rs m sp hi vhi ->
extcall_arg rs m sp lo vlo ->
extcall_arg_pair rs m sp (Twolong hi lo) (Val.longofwords vhi vlo).
Definition extcall_arguments
(rs: regset) (m: mem) (sp: val) (sg: signature) (args: list val) : Prop :=
list_forall2 (extcall_arg_pair rs m sp) (loc_arguments sg) args.
(** Mach execution states. *)
(** Mach execution states. *)
Inductive stackframe: Type :=
| Stackframe:
forall (f: block)       (**r pointer to calling function *)
(sp: val)        (**r stack pointer in calling function *)
(retaddr: val)   (**r Asm return address in calling function *)
(c: code),       (**r program point in calling function *)
stackframe.
Inductive state: Type :=
| State:
forall (stack: list stackframe)  (**r call stack *)
(f: block)                (**r pointer to current function *)
(sp: val)                 (**r stack pointer *)
(c: code)                 (**r current program point *)
(rs: regset)              (**r register state *)
(m: mem),                 (**r memory state *)
state
| Callstate:
forall (stack: list stackframe)  (**r call stack *)
(f: block)                (**r pointer to function to call *)
(rs: regset)              (**r register state *)
(m: mem),                 (**r memory state *)
state
| Returnstate:
forall (stack: list stackframe)  (**r call stack *)
(rs: regset)              (**r register state *)
(m: mem),                 (**r memory state *)
state.
Definition parent_sp (s: list stackframe) : val :=
match s with
| nil => Vnullptr
| Stackframe f sp ra c :: s' => sp
end.
Definition parent_ra (s: list stackframe) : val :=
match s with
| nil => Vnullptr
| Stackframe f sp ra c :: s' => ra
end.
Inductive step: state -> trace -> state -> Prop :=
| exec_Mlabel:
forall s f sp lbl c rs m,
step (State s f sp (Mlabel lbl :: c) rs m)
E0 (State s f sp c rs m)
| exec_Mgetstack:
forall s f sp ofs ty dst c rs m v,
load_stack m sp ty ofs = Some v ->
step (State s f sp (Mgetstack ofs ty dst :: c) rs m)
E0 (State s f sp c (rs#dst <- v) m)
| exec_Msetstack:
forall s f sp src ofs ty c rs m m' rs',
store_stack m sp ty ofs (rs src) = Some m' ->
rs' = undef_regs (destroyed_by_setstack ty) rs ->
step (State s f sp (Msetstack src ofs ty :: c) rs m)
E0 (State s f sp c rs' m')
| exec_Mgetparam:
forall s fb f sp ofs ty dst c rs m v rs',
Genv.find_funct_ptr ge fb = Some (Internal f) ->
load_stack m sp Tptr f.(fn_link_ofs) = Some (parent_sp s) ->
load_stack m (parent_sp s) ty ofs = Some v ->
rs' = (rs # temp_for_parent_frame <- Vundef # dst <- v) ->
step (State s fb sp (Mgetparam ofs ty dst :: c) rs m)
E0 (State s fb sp c rs' m)
| exec_Mop:
forall s f sp op args res c rs m v rs',
eval_operation ge sp op rs##args m = Some v ->
rs' = ((undef_regs (destroyed_by_op op) rs)#res <- v) ->
step (State s f sp (Mop op args res :: c) rs m)
E0 (State s f sp c rs' m)
| exec_Mload:
forall s f sp chunk addr args dst c rs m a v rs',
eval_addressing ge sp addr rs##args = Some a ->
Mem.loadv chunk m a = Some v ->
rs' = ((undef_regs (destroyed_by_load chunk addr) rs)#dst <- v) ->
step (State s f sp (Mload chunk addr args dst :: c) rs m)
E0 (State s f sp c rs' m)
| exec_Mstore:
forall s f sp chunk addr args src c rs m m' a rs',
eval_addressing ge sp addr rs##args = Some a ->
Mem.storev chunk m a (rs src) = Some m' ->
rs' = undef_regs (destroyed_by_store chunk addr) rs ->
step (State s f sp (Mstore chunk addr args src :: c) rs m)
E0 (State s f sp c rs' m')
| exec_Mcall:
forall s fb sp sig ros c rs m f f' ra,
find_function_ptr ge ros rs = Some f' ->
Genv.find_funct_ptr ge fb = Some (Internal f) ->
return_address_offset f c ra ->
step (State s fb sp (Mcall sig ros :: c) rs m)
E0 (Callstate (Stackframe fb sp (Vptr fb ra) c :: s)
f' rs m)
| exec_Mtailcall:
forall s fb stk soff sig ros c rs m f f' m',
find_function_ptr ge ros rs = Some f' ->
Genv.find_funct_ptr ge fb = Some (Internal f) ->
load_stack m (Vptr stk soff) Tptr f.(fn_link_ofs) = Some (parent_sp s) ->
load_stack m (Vptr stk soff) Tptr f.(fn_retaddr_ofs) = Some (parent_ra s) ->
Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
step (State s fb (Vptr stk soff) (Mtailcall sig ros :: c) rs m)
E0 (Callstate s f' rs m')
| exec_Mbuiltin:
forall s f sp rs m ef args res b vargs t vres rs' m',
eval_builtin_args ge rs sp m args vargs ->
external_call ef ge vargs m t vres m' ->
rs' = set_res res vres (undef_regs (destroyed_by_builtin ef) rs) ->
step (State s f sp (Mbuiltin ef args res :: b) rs m)
t (State s f sp b rs' m')
| exec_Mgoto:
forall s fb f sp lbl c rs m c',
Genv.find_funct_ptr ge fb = Some (Internal f) ->
find_label lbl f.(fn_code) = Some c' ->
step (State s fb sp (Mgoto lbl :: c) rs m)
E0 (State s fb sp c' rs m)
| exec_Mcond_true:
forall s fb f sp cond args lbl c rs m c' rs',
eval_condition cond rs##args m = Some true ->
Genv.find_funct_ptr ge fb = Some (Internal f) ->
find_label lbl f.(fn_code) = Some c' ->
rs' = undef_regs (destroyed_by_cond cond) rs ->
step (State s fb sp (Mcond cond args lbl :: c) rs m)
E0 (State s fb sp c' rs' m)
| exec_Mcond_false:
forall s f sp cond args lbl c rs m rs',
eval_condition cond rs##args m = Some false ->
rs' = undef_regs (destroyed_by_cond cond) rs ->
step (State s f sp (Mcond cond args lbl :: c) rs m)
E0 (State s f sp c rs' m)
| exec_Mjumptable:
forall s fb f sp arg tbl c rs m n lbl c' rs',
rs arg = Vint n ->
list_nth_z tbl (Int.unsigned n) = Some lbl ->
Genv.find_funct_ptr ge fb = Some (Internal f) ->
find_label lbl f.(fn_code) = Some c' ->
rs' = undef_regs destroyed_by_jumptable rs ->
step (State s fb sp (Mjumptable arg tbl :: c) rs m)
E0 (State s fb sp c' rs' m)
| exec_Mreturn:
forall s fb stk soff c rs m f m',
Genv.find_funct_ptr ge fb = Some (Internal f) ->
load_stack m (Vptr stk soff) Tptr f.(fn_link_ofs) = Some (parent_sp s) ->
load_stack m (Vptr stk soff) Tptr f.(fn_retaddr_ofs) = Some (parent_ra s) ->
Mem.free m stk 0 f.(fn_stacksize) = Some m' ->
step (State s fb (Vptr stk soff) (Mreturn :: c) rs m)
E0 (Returnstate s rs m')
| exec_function_internal:
forall s fb rs m f m1 m2 m3 stk rs',
Genv.find_funct_ptr ge fb = Some (Internal f) ->
Mem.alloc m 0 f.(fn_stacksize) = (m1, stk) ->
let sp := Vptr stk Ptrofs.zero in
store_stack m1 sp Tptr f.(fn_link_ofs) (parent_sp s) = Some m2 ->
store_stack m2 sp Tptr f.(fn_retaddr_ofs) (parent_ra s) = Some m3 ->
rs' = undef_regs destroyed_at_function_entry rs ->
step (Callstate s fb rs m)
E0 (State s fb sp f.(fn_code) rs' m3)
| exec_function_external:
forall s fb rs m t rs' ef args res m',
Genv.find_funct_ptr ge fb = Some (External ef) ->
extcall_arguments rs m (parent_sp s) (ef_sig ef) args ->
external_call ef ge args m t res m' ->
rs' = set_pair (loc_result (ef_sig ef)) res (undef_caller_save_regs rs) ->
step (Callstate s fb rs m)
t (Returnstate s rs' m')
| exec_return:
forall s f sp ra c rs m,
step (Returnstate (Stackframe f sp ra c :: s) rs m)
E0 (State s f sp c rs m).
End RELSEM.
Inductive initial_state (p: program): state -> Prop :=
| initial_state_intro: forall fb m0,
let ge := Genv.globalenv p in
Genv.init_mem p = Some m0 ->
Genv.find_symbol ge p.(prog_main) = Some fb ->
initial_state p (Callstate nil fb (Regmap.init Vundef) m0).
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall rs m r retcode,
loc_result signature_main = One r ->
rs r = Vint retcode ->
final_state (Returnstate nil rs m) retcode.
Definition semantics (rao: function -> code -> ptrofs -> Prop) (p: program) :=
Semantics (step rao) (initial_state p) final_state (Genv.globalenv p).
(** * Leaf functions *)
(** A leaf function is a function that contains no [Mcall] instruction. *)
Definition is_leaf_function (f: function) : bool :=
List.forallb
(fun i => match i with Mcall _ _ => false | _ => true end)
f.(fn_code).
(** Semantic characterization of leaf functions: functions in the call stack are never leaf functions. *)
Section WF_STATES.
Variable rao: function -> code -> ptrofs -> Prop.
Variable ge: genv.
Inductive wf_frame: stackframe -> Prop :=
| wf_stackframe_intro: forall fb sp ra c f
(CODE: Genv.find_funct_ptr ge fb = Some (Internal f))
(LEAF: is_leaf_function f = false)
(TAIL: is_tail c f.(fn_code)),
wf_frame (Stackframe fb sp ra c).
Inductive wf_state: state -> Prop :=
| wf_normal_state: forall s fb sp c rs m f
(STACK: Forall wf_frame s)
(CODE: Genv.find_funct_ptr ge fb = Some (Internal f))
(TAIL: is_tail c f.(fn_code)),
wf_state (State s fb sp c rs m)
| wf_call_state: forall s fb rs m
(STACK: Forall wf_frame s),
wf_state (Callstate s fb rs m)
| wf_return_state: forall s rs m
(STACK: Forall wf_frame s),
wf_state (Returnstate s rs m).

(* Specifications: *)
Lemma wf_step:
forall S1 t S2, step rao ge S1 t S2 -> wf_state S1 -> wf_state S2.