(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
(** Abstract syntax and semantics for ARM assembly language *)
Require Stacklayout.
(** * Abstract syntax *)
(** Integer registers, floating-point registers. *)
Inductive ireg: Type :=
| IR0: ireg  | IR1: ireg  | IR2: ireg  | IR3: ireg
| IR4: ireg  | IR5: ireg  | IR6: ireg  | IR7: ireg
| IR8: ireg  | IR9: ireg  | IR10: ireg | IR11: ireg
| IR12: ireg | IR13: ireg | IR14: ireg.
Inductive freg: Type :=
| FR0: freg  | FR1: freg  | FR2: freg  | FR3: freg
| FR4: freg  | FR5: freg  | FR6: freg  | FR7: freg
| FR8: freg  | FR9: freg  | FR10: freg  | FR11: freg
| FR12: freg  | FR13: freg  | FR14: freg  | FR15: freg.
Inductive sreg: Type :=
| SR0: sreg  | SR1: sreg  | SR2: sreg  | SR3: sreg
| SR4: sreg  | SR5: sreg  | SR6: sreg  | SR7: sreg
| SR8: sreg  | SR9: sreg  | SR10: sreg  | SR11: sreg
| SR12: sreg  | SR13: sreg  | SR14: sreg  | SR15: sreg
| SR16: sreg  | SR17: sreg  | SR18: sreg  | SR19: sreg
| SR20: sreg  | SR21: sreg  | SR22: sreg  | SR23: sreg
| SR24: sreg  | SR25: sreg  | SR26: sreg  | SR27: sreg
| SR28: sreg  | SR29: sreg  | SR30: sreg  | SR31: sreg.
Fixpoint label_pos (lbl: label) (pos: Z) (c: code) {struct c} : option Z :=
match c with
| nil => None
| instr :: c' =>
if is_label lbl instr then Some (pos + 1) else label_pos lbl (pos + 1) c'
end.
Variable ge: genv.
(** The semantics is purely small-step and defined as a function from the current state (a register set + a memory state) to either [Next rs' m'] where [rs'] and [m'] are the updated register set and memory state after execution of the instruction at [rs#PC], or [Stuck] if the processor is stuck. *)
Inductive outcome: Type :=
| Next: regset -> mem -> outcome
| Stuck: outcome.
(** Manipulations over the [PC] register: continuing with the next instruction ([nextinstr]) or branching to a label ([goto_label]). *)
Definition nextinstr (rs: regset) :=
rs#PC <- (Val.offset_ptr rs#PC Ptrofs.one).
Definition nextinstr_nf (rs: regset) :=
nextinstr (undef_flags rs).
Definition goto_label (f: function) (lbl: label) (rs: regset) (m: mem) :=
match label_pos lbl 0 (fn_code f) with
| None => Stuck
| Some pos =>
match rs#PC with
| Vptr b ofs => Next (rs#PC <- (Vptr b (Ptrofs.repr pos))) m
| _ => Stuck
end
end.
(** Evaluation of [shift_op] operands *)
Definition eval_shift_op (so: shift_op) (rs: regset) :=
match so with
| SOimm n => Vint n
| SOreg r => rs r
| SOlsl r n => Val.shl (rs r) (Vint n)
| SOlsr r n => Val.shru (rs r) (Vint n)
| SOasr r n => Val.shr (rs r) (Vint n)
| SOror r n => Val.ror (rs r) (Vint n)
end.
(** Auxiliaries for memory accesses *)
Definition exec_load (chunk: memory_chunk) (addr: val) (r: preg)
(rs: regset) (m: mem) :=
match Mem.loadv chunk m addr with
| None => Stuck
| Some v => Next (nextinstr (rs#r <- v)) m
end.
Definition exec_store (chunk: memory_chunk) (addr: val) (r: preg)
(rs: regset) (m: mem) :=
match Mem.storev chunk m addr (rs r) with
| None => Stuck
| Some m' => Next (nextinstr rs) m'
end.
(** Comparisons. *)
Definition compare_int (rs: regset) (v1 v2: val) (m: mem) :=
rs#CN <- (Val.negative (Val.sub v1 v2))
#CZ <- (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2)
#CC <- (Val.cmpu (Mem.valid_pointer m) Cge v1 v2)
#CV <- (Val.sub_overflow v1 v2).
(** Semantics of [fcmp] instructions: << ==	N=0 Z=1 C=1 V=0 <	N=1 Z=0 C=0 V=0 >	N=0 Z=0 C=1 V=0 unord	N=0 Z=0 C=1 V=1 >> *)
Definition compare_float (rs: regset) (v1 v2: val) :=
match v1, v2 with
| Vfloat f1, Vfloat f2 =>
rs#CN <- (Val.of_bool (Float.cmp Clt f1 f2))
#CZ <- (Val.of_bool (Float.cmp Ceq f1 f2))
#CC <- (Val.of_bool (negb (Float.cmp Clt f1 f2)))
#CV <- (Val.of_bool (negb (Float.cmp Ceq f1 f2 || Float.cmp Clt f1 f2 || Float.cmp Cgt f1 f2)))
| _, _ =>
rs#CN <- Vundef
#CZ <- Vundef
#CC <- Vundef
#CV <- Vundef
end.
Definition compare_float32 (rs: regset) (v1 v2: val) :=
match v1, v2 with
| Vsingle f1, Vsingle f2 =>
rs#CN <- (Val.of_bool (Float32.cmp Clt f1 f2))
#CZ <- (Val.of_bool (Float32.cmp Ceq f1 f2))
#CC <- (Val.of_bool (negb (Float32.cmp Clt f1 f2)))
#CV <- (Val.of_bool (negb (Float32.cmp Ceq f1 f2 || Float32.cmp Clt f1 f2 || Float32.cmp Cgt f1 f2)))
| _, _ =>
rs#CN <- Vundef
#CZ <- Vundef
#CC <- Vundef
#CV <- Vundef
end.
(** Testing a condition *)
Definition eval_testcond (c: testcond) (rs: regset) : option bool :=
match c with
| TCeq =>                             (**r equal *)
match rs CZ with
| Vint n => Some (Int.eq n Int.one)
| _ => None
end
| TCne =>                             (**r not equal *)
match rs CZ with
| Vint n => Some (Int.eq n Int.zero)
| _ => None
end
| TClo =>                             (**r unsigned less than  *)
match rs CC with
| Vint n => Some (Int.eq n Int.zero)
| _ => None
end
| TCls =>                             (**r unsigned less or equal *)
match rs CC, rs CZ with
| Vint c, Vint z => Some (Int.eq c Int.zero || Int.eq z Int.one)
| _, _ => None
end
| TChs =>                             (**r unsigned greater or equal *)
match rs CC with
| Vint n => Some (Int.eq n Int.one)
| _ => None
end
| TChi =>                             (**r unsigned greater *)
match rs CC, rs CZ with
| Vint c, Vint z => Some (Int.eq c Int.one && Int.eq z Int.zero)
| _, _ => None
end
| TClt =>                             (**r signed less than *)
match rs CV, rs CN with
| Vint o, Vint s => Some (Int.eq (Int.xor o s) Int.one)
| _, _ => None
end
| TCle =>                             (**r signed less or equal *)
match rs CV, rs CN, rs CZ with
| Vint o, Vint s, Vint z => Some (Int.eq (Int.xor o s) Int.one || Int.eq z Int.one)
| _, _, _ => None
end
| TCge =>                             (**r signed greater or equal *)
match rs CV, rs CN with
| Vint o, Vint s => Some (Int.eq (Int.xor o s) Int.zero)
| _, _ => None
end
| TCgt =>                             (**r signed greater *)
match rs CV, rs CN, rs CZ with
| Vint o, Vint s, Vint z => Some (Int.eq (Int.xor o s) Int.zero && Int.eq z Int.zero)
| _, _, _ => None
end
| TCpl =>                             (**r positive *)
match rs CN with
| Vint n => Some (Int.eq n Int.zero)
| _ => None
end
| TCmi =>                             (**r negative *)
match rs CN with
| Vint n => Some (Int.eq n Int.one)
| _ => None
end
end.
(** Execution of a single instruction [i] in initial state [rs] and [m].  Return updated state.  For instructions that correspond to actual ARM instructions, the cases are straightforward transliterations of the informal descriptions given in the ARM reference manuals.  For pseudo-instructions, refer to the informal descriptions given above.  Note that we set to [Vundef] the registers used as temporaries by the expansions of the pseudo-instructions, so that the ARM code we generate cannot use those registers to hold values that must survive the execution of the pseudo-instruction.  Likewise, for several instructions we set the condition flags to [Vundef], so that we can expand them later to the S form or to the non-S form, whichever is more compact in Thumb2. *)
Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : outcome :=
match i with
| Padd r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.add rs#r2 (eval_shift_op so rs)))) m
| Pand r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.and rs#r2 (eval_shift_op so rs)))) m
| Pasr r1 r2 r3 =>
Next (nextinstr_nf (rs#r1 <- (Val.shr rs#r2 rs#r3))) m
| Pb lbl =>
goto_label f lbl rs m
| Pbc cond lbl =>
match eval_testcond cond rs with
| Some true => goto_label f lbl rs m
| Some false => Next (nextinstr rs) m
| None => Stuck
end
| Pbsymb id sg =>
Next (rs#PC <- (Genv.symbol_address ge id Ptrofs.zero)) m
| Pbreg r sg =>
Next (rs#PC <- (rs#r)) m
| Pblsymb id sg =>
Next (rs#IR14 <- (Val.add rs#PC Vone) #PC <- (Genv.symbol_address ge id Ptrofs.zero)) m
| Pblreg r sg =>
Next (rs#IR14 <- (Val.add rs#PC Vone) #PC <- (rs#r)) m
| Pbic r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.and rs#r2 (Val.notint (eval_shift_op so rs))))) m
| Pcmp r1 so =>
Next (nextinstr (compare_int rs rs#r1 (eval_shift_op so rs) m)) m
| Pcmn r1 so =>
Next (nextinstr (compare_int rs rs#r1 (Val.neg (eval_shift_op so rs)) m)) m
| Peor r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.xor rs#r2 (eval_shift_op so rs)))) m
| Pldr r1 r2 sa =>
exec_load Mint32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pldr_a r1 r2 sa =>
exec_load Many32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pldrb r1 r2 sa =>
exec_load Mint8unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pldrh r1 r2 sa =>
exec_load Mint16unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pldrsb r1 r2 sa =>
exec_load Mint8signed (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pldrsh r1 r2 sa =>
exec_load Mint16signed (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Plsl r1 r2 r3 =>
Next (nextinstr_nf (rs#r1 <- (Val.shl rs#r2 rs#r3))) m
| Plsr r1 r2 r3 =>
Next (nextinstr_nf (rs#r1 <- (Val.shru rs#r2 rs#r3))) m
| Pmla r1 r2 r3 r4 =>
Next (nextinstr (rs#r1 <- (Val.add (Val.mul rs#r2 rs#r3) rs#r4))) m
| Pmov r1 so =>
Next (nextinstr_nf (rs#r1 <- (eval_shift_op so rs))) m
| Pmovw r n =>
Next (nextinstr (rs#r <- (Vint n))) m
| Pmovt r n =>
Next (nextinstr (rs#r <- (Val.or (Val.and rs#r (Vint (Int.repr 65535)))
(Vint (Int.shl n (Int.repr 16)))))) m
| Pmul r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.mul rs#r2 rs#r3))) m
| Pmvn r1 so =>
Next (nextinstr_nf (rs#r1 <- (Val.notint (eval_shift_op so rs)))) m
| Porr r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.or rs#r2 (eval_shift_op so rs)))) m
| Prsb r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.sub (eval_shift_op so rs) rs#r2))) m
| Pstr r1 r2 sa =>
exec_store Mint32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pstr_a r1 r2 sa =>
exec_store Many32 (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pstrb r1 r2 sa =>
exec_store Mint8unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Pstrh r1 r2 sa =>
exec_store Mint16unsigned (Val.add rs#r2 (eval_shift_op sa rs)) r1 rs m
| Psdiv =>
match Val.divs rs#IR0 rs#IR1 with
| Some v => Next (nextinstr (rs#IR0 <- v
#IR1 <- Vundef #IR2 <- Vundef
#IR3 <- Vundef #IR12 <- Vundef)) m
| None => Stuck
end
| Psbfx r1 r2 lsb sz =>
Next (nextinstr (rs#r1 <- (Val.sign_ext (Int.unsigned sz) (Val.shru rs#r2 (Vint lsb))))) m
| Psmull rdl rdh r1 r2 =>
Next (nextinstr (rs#rdl <- (Val.mul rs#r1 rs#r2)
#rdh <- (Val.mulhs rs#r1 rs#r2))) m
| Psub r1 r2 so =>
Next (nextinstr_nf (rs#r1 <- (Val.sub rs#r2 (eval_shift_op so rs)))) m
| Pudiv =>
match Val.divu rs#IR0 rs#IR1 with
| Some v => Next (nextinstr (rs#IR0 <- v
#IR1 <- Vundef #IR2 <- Vundef
#IR3 <- Vundef #IR12 <- Vundef)) m
| None => Stuck
end
| Pumull rdl rdh r1 r2 =>
Next (nextinstr (rs#rdl <- (Val.mul rs#r1 rs#r2)
#rdh <- (Val.mulhu rs#r1 rs#r2))) m
(* Floating-point coprocessor instructions *)
| Pfcpyd r1 r2 =>
Next (nextinstr (rs#r1 <- (rs#r2))) m
| Pfabsd r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.absf rs#r2))) m
| Pfnegd r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.negf rs#r2))) m
| Pfaddd r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.addf rs#r2 rs#r3))) m
| Pfdivd r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.divf rs#r2 rs#r3))) m
| Pfmuld r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.mulf rs#r2 rs#r3))) m
| Pfsubd r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.subf rs#r2 rs#r3))) m
| Pflid r1 f =>
Next (nextinstr (rs#r1 <- (Vfloat f))) m
| Pfcmpd r1 r2 =>
Next (nextinstr (compare_float rs rs#r1 rs#r2)) m
| Pfcmpzd r1 =>
Next (nextinstr (compare_float rs rs#r1 (Vfloat Float.zero))) m
| Pfsitod r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.maketotal (Val.floatofint rs#r2)))) m
| Pfuitod r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.maketotal (Val.floatofintu rs#r2)))) m
| Pftosizd r1 r2 =>
Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intoffloat rs#r2)))) m
| Pftouizd r1 r2 =>
Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intuoffloat rs#r2)))) m
| Pfabss r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.absfs rs#r2))) m
| Pfnegs r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.negfs rs#r2))) m
| Pfadds r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.addfs rs#r2 rs#r3))) m
| Pfdivs r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.divfs rs#r2 rs#r3))) m
| Pfmuls r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.mulfs rs#r2 rs#r3))) m
| Pfsubs r1 r2 r3 =>
Next (nextinstr (rs#r1 <- (Val.subfs rs#r2 rs#r3))) m
| Pflis r1 f =>
Next (nextinstr (rs#r1 <- (Vsingle f))) m
| Pfcmps r1 r2 =>
Next (nextinstr (compare_float32 rs rs#r1 rs#r2)) m
| Pfcmpzs r1 =>
Next (nextinstr (compare_float32 rs rs#r1 (Vsingle Float32.zero))) m
| Pfsitos r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.maketotal (Val.singleofint rs#r2)))) m
| Pfuitos r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.maketotal (Val.singleofintu rs#r2)))) m
| Pftosizs r1 r2 =>
Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intofsingle rs#r2)))) m
| Pftouizs r1 r2 =>
Next (nextinstr (rs #FR6 <- Vundef #r1 <- (Val.maketotal (Val.intuofsingle rs#r2)))) m
| Pfcvtsd r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.singleoffloat rs#r2))) m
| Pfcvtds r1 r2 =>
Next (nextinstr (rs#r1 <- (Val.floatofsingle rs#r2))) m
| Pfldd r1 r2 n =>
exec_load Mfloat64 (Val.add rs#r2 (Vint n)) r1 rs m
| Pfldd_a r1 r2 n =>
exec_load Many64 (Val.add rs#r2 (Vint n)) r1 rs m
| Pflds r1 r2 n =>
exec_load Mfloat32 (Val.add rs#r2 (Vint n)) r1 rs m
| Pfstd r1 r2 n =>
exec_store Mfloat64 (Val.add rs#r2 (Vint n)) r1 rs m
| Pfstd_a r1 r2 n =>
exec_store Many64 (Val.add rs#r2 (Vint n)) r1 rs m
| Pfsts r1 r2 n =>
exec_store Mfloat32 (Val.add rs#r2 (Vint n)) r1 rs m
(* Pseudo-instructions *)
| Pallocframe sz pos =>
let (m1, stk) := Mem.alloc m 0 sz in
let sp := (Vptr stk Ptrofs.zero) in
match Mem.storev Mint32 m1 (Val.offset_ptr sp pos) rs#IR13 with
| None => Stuck
| Some m2 => Next (nextinstr (rs #IR12 <- (rs#IR13) #IR13 <- sp)) m2
end
| Pfreeframe sz pos =>
match Mem.loadv Mint32 m (Val.offset_ptr rs#IR13 pos) with
| None => Stuck
| Some v =>
match rs#IR13 with
| Vptr stk ofs =>
match Mem.free m stk 0 sz with
| None => Stuck
| Some m' => Next (nextinstr (rs#IR13 <- v)) m'
end
| _ => Stuck
end
end
| Plabel lbl =>
Next (nextinstr rs) m
| Ploadsymbol r1 lbl ofs =>
Next (nextinstr (rs#r1 <- (Genv.symbol_address ge lbl ofs))) m
| Pmovite cond r1 ifso ifnot =>
let v :=
match eval_testcond cond rs with
| Some true => eval_shift_op ifso rs
| Some false => eval_shift_op ifnot rs
| None => Vundef
end in
Next (nextinstr (rs#r1 <- v)) m
| Pfmovite cond r1 ifso ifnot =>
let v :=
match eval_testcond cond rs with
| Some true => rs#ifso
| Some false => rs#ifnot
| None => Vundef
end in
Next (nextinstr (rs#r1 <- v)) m
| Pbtbl r tbl =>
match rs#r with
| Vint n =>
match list_nth_z tbl (Int.unsigned n) with
| None => Stuck
| Some lbl => goto_label f lbl (rs#IR14 <- Vundef) m
end
| _ => Stuck
end
| Pcfi_rel_offset ofs =>
Next (nextinstr rs) m
| Pbuiltin ef args res => Stuck    (**r treated specially below *)
(** The following instructions and directives are not generated directly by Asmgen, so we do not model them. *)
| Ppush _
| Padc _ _ _
| Pcfi_adjust _
| Pclz _ _
| Prev _ _
| Prev16 _ _
| Pfsqrt _ _
| Prsc _ _ _
| Psbc _ _ _
| Pnop
| Padds _ _ _
| Psubs _ _ _
| Prsbs _ _ _
| Pdmb
| Pdsb
| Pisb
| Pbne _
| Pldr_p _ _ _
| Pldrb_p _ _ _
| Pldrh_p _ _ _
| Pstr_p _ _ _
| Pstrb_p _ _ _
| Pstrh_p _ _ _
| Pfcpy_fs _ _
| Pfcpy_sf _ _
| Pfcpy_fii _ _ _
| Pfcpy_fi _ _
| Pfcpy_iif _ _ _
| Pfcpy_if _ _
| Pconstants _
| Ploadsymbol_imm _ _ _
| Pflid_lbl _ _ _
| Pflis_lbl _ _ _
| Pflid_imm _ _
| Pflis_imm _ _
| Ploadsymbol_lbl _ _ _ _
=>
Stuck
end.
(** Translation of the LTL/Linear/Mach view of machine registers to the ARM view.  Note that no LTL register maps to [IR14]. This register is reserved as temporary, to be used by the generated ARM code.  *)
Definition preg_of (r: mreg) : preg :=
match r with
| R0 => IR0 | R1 => IR1 | R2 => IR2 | R3 => IR3
| R4 => IR4 | R5 => IR5 | R6 => IR6 | R7 => IR7
| R8 => IR8 | R9 => IR9 | R10 => IR10 | R11 => IR11
| R12 => IR12
| F0 => FR0 | F1 => FR1 | F2 => FR2 | F3 => FR3
| F4 => FR4 | F5 => FR5 | F6 => FR6 | F7 => FR7
| F8 => FR8 | F9 => FR9 | F10 => FR10 | F11 => FR11
| F12 => FR12 | F13 => FR13 | F14 => FR14 | F15 => FR15
end.
(** Undefine all registers except SP and callee-save registers *)
Definition undef_caller_save_regs (rs: regset) : regset :=
fun r =>
if preg_eq r SP
|| In_dec preg_eq r (List.map preg_of (List.filter is_callee_save all_mregs))
then rs r
else Vundef.
(** Extract the values of the arguments of an external call. We exploit the calling conventions from module [Conventions], except that we use ARM registers instead of locations. *)
Inductive extcall_arg (rs: regset) (m: mem): loc -> val -> Prop :=
| extcall_arg_reg: forall r,
extcall_arg rs m (R r) (rs (preg_of r))
| extcall_arg_stack: forall ofs ty bofs v,
bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
Mem.loadv (chunk_of_type ty) m
(Val.offset_ptr (rs (IR IR13)) (Ptrofs.repr bofs)) = Some v ->
extcall_arg rs m (S Outgoing ofs ty) v.
Inductive extcall_arg_pair (rs: regset) (m: mem): rpair loc -> val -> Prop :=
| extcall_arg_one: forall l v,
extcall_arg rs m l v ->
extcall_arg_pair rs m (One l) v
| extcall_arg_twolong: forall hi lo vhi vlo,
extcall_arg rs m hi vhi ->
extcall_arg rs m lo vlo ->
extcall_arg_pair rs m (Twolong hi lo) (Val.longofwords vhi vlo).
Definition extcall_arguments
(rs: regset) (m: mem) (sg: signature) (args: list val) : Prop :=
list_forall2 (extcall_arg_pair rs m) (loc_arguments sg) args.
Definition loc_external_result (sg: signature) : rpair preg :=
map_rpair preg_of (loc_result sg).
(** Execution of the instruction at [rs#PC]. *)
Inductive state: Type :=
| State: regset -> mem -> state.
Inductive step: state -> trace -> state -> Prop :=
| exec_step_internal:
forall b ofs f i rs m rs' m',
rs PC = Vptr b ofs ->
Genv.find_funct_ptr ge b = Some (Internal f) ->
find_instr (Ptrofs.unsigned ofs) (fn_code f) = Some i ->
exec_instr f i rs m = Next rs' m' ->
step (State rs m) E0 (State rs' m')
| exec_step_builtin:
forall b ofs f ef args res rs m vargs t vres rs' m',
rs PC = Vptr b ofs ->
Genv.find_funct_ptr ge b = Some (Internal f) ->
find_instr (Ptrofs.unsigned ofs) f.(fn_code) = Some (Pbuiltin ef args res) ->
eval_builtin_args ge rs (rs SP) m args vargs ->
external_call ef ge vargs m t vres m' ->
rs' = nextinstr
(set_res res vres
(undef_regs (map preg_of (destroyed_by_builtin ef)) rs)) ->
step (State rs m) t (State rs' m')
| exec_step_external:
forall b ef args res rs m t rs' m',
rs PC = Vptr b Ptrofs.zero ->
Genv.find_funct_ptr ge b = Some (External ef) ->
external_call ef ge args m t res m' ->
extcall_arguments rs m (ef_sig ef) args ->
rs' = (set_pair (loc_external_result (ef_sig ef) ) res (undef_caller_save_regs rs))#PC <- (rs IR14) ->
step (State rs m) t (State rs' m').
End RELSEM.
(** Execution of whole programs. *)
Inductive initial_state (p: program): state -> Prop :=
| initial_state_intro: forall m0,
let ge := Genv.globalenv p in
let rs0 :=
(Pregmap.init Vundef)
# PC <- (Genv.symbol_address ge p.(prog_main) Ptrofs.zero)
# IR14 <- Vzero
# IR13 <- Vzero in
Genv.init_mem p = Some m0 ->
initial_state p (State rs0 m0).
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall rs m r,
rs#PC = Vzero ->
rs#IR0 = Vint r ->
final_state (State rs m) r.
Definition semantics (p: program) :=
Semantics step (initial_state p) final_state (Genv.globalenv p).
(** Determinacy of the [Asm] semantics. *)
Remark extcall_arguments_determ:
forall rs m sg args1 args2,
extcall_arguments rs m sg args1 -> extcall_arguments rs m sg args2 -> args1 = args2.

Lemma semantics_determinate: forall p, determinate (semantics p).