(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*           Prashanth Mundkur, SRI International                      *)
(*                                                                     *)
(*  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.     *)
(*                                                                     *)
(*  The contributions by Prashanth Mundkur are reused and adapted      *)
(*  under the terms of a Contributor License Agreement between         *)
(*  SRI International and INRIA.                                       *)
(*                                                                     *)
(* *********************************************************************)
(** Abstract syntax and semantics for RISC-V assembly language. *)
Require Stacklayout.
(** * Abstract syntax *)
(** Integer registers.  X0 is treated specially because it always reads as zero and is never used as a destination of an instruction. *)
Inductive ireg: Type :=
| X1:  ireg | X2:  ireg | X3:  ireg | X4:  ireg | X5:  ireg
| X6:  ireg | X7:  ireg | X8:  ireg | X9:  ireg | X10: ireg
| X11: ireg | X12: ireg | X13: ireg | X14: ireg | X15: ireg
| X16: ireg | X17: ireg | X18: ireg | X19: ireg | X20: ireg
| X21: ireg | X22: ireg | X23: ireg | X24: ireg | X25: ireg
| X26: ireg | X27: ireg | X28: ireg | X29: ireg | X30: ireg
| X31: ireg.
Inductive ireg0: Type :=
| X0: ireg0 | X: ireg -> ireg0.
Coercion X: ireg >-> ireg0.
(** Floating-point registers *)
Inductive freg: Type :=
| F0: freg  | F1: freg  | F2: freg  | F3: freg
| F4: freg  | F5: freg  | F6: freg  | F7: freg
| F8: freg  | F9: freg  | F10: freg | F11: freg
| F12: freg | F13: freg | F14: freg | F15: freg
| F16: freg | F17: freg | F18: freg | F19: freg
| F20: freg | F21: freg | F22: freg | F23: freg
| F24: freg | F25: freg | F26: freg | F27: freg
| F28: freg | F29: freg | F30: freg | F31: freg.
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 two functions below axiomatize how the linker processes symbolic references [symbol + offset)] and splits their actual values into a 20-bit high part [%hi(symbol + offset)] and a 12-bit low part [%lo(symbol + offset)]. *)
Parameter low_half: genv -> ident -> ptrofs -> ptrofs.
Parameter high_half: genv -> ident -> ptrofs -> val.
(** The fundamental property of these operations is that, when applied to the address of a symbol, their results can be recombined by addition, rebuilding the original address. *)
(** 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 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.
(** Auxiliaries for memory accesses *)
Definition eval_offset (ofs: offset) : ptrofs :=
match ofs with
| Ofsimm n => n
| Ofslow id delta => low_half ge id delta
end.
Definition exec_load (chunk: memory_chunk) (rs: regset) (m: mem)
(d: preg) (a: ireg) (ofs: offset) :=
match Mem.loadv chunk m (Val.offset_ptr (rs a) (eval_offset ofs)) with
| None => Stuck
| Some v => Next (nextinstr (rs#d <- v)) m
end.
Definition exec_store (chunk: memory_chunk) (rs: regset) (m: mem)
(s: preg) (a: ireg) (ofs: offset) :=
match Mem.storev chunk m (Val.offset_ptr (rs a) (eval_offset ofs)) (rs s) with
| None => Stuck
| Some m' => Next (nextinstr rs) m'
end.
(** Evaluating a branch *)
Definition eval_branch (f: function) (l: label) (rs: regset) (m: mem) (res: option bool) : outcome :=
match res with
| Some true  => goto_label f l rs m
| Some false => Next (nextinstr rs) m
| None => Stuck
end.
(** Execution of a single instruction [i] in initial state [rs] and [m].  Return updated state.  For instructions that correspond to actual RISC-V instructions, the cases are straightforward transliterations of the informal descriptions given in the RISC-V user-mode specification.  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 RISC-V code we generate cannot use those registers to hold values that must survive the execution of the pseudo-instruction. *)
Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : outcome :=
match i with
| Pmv d s =>
Next (nextinstr (rs#d <- (rs#s))) m
(** 32-bit integer register-immediate instructions *)
| Paddiw d s i =>
Next (nextinstr (rs#d <- (Val.add rs##s (Vint i)))) m
| Psltiw d s i =>
Next (nextinstr (rs#d <- (Val.cmp Clt rs##s (Vint i)))) m
| Psltiuw d s i =>
Next (nextinstr (rs#d <- (Val.cmpu (Mem.valid_pointer m) Clt rs##s (Vint i)))) m
| Pandiw d s i =>
Next (nextinstr (rs#d <- (Val.and rs##s (Vint i)))) m
| Poriw d s i =>
Next (nextinstr (rs#d <- (Val.or rs##s (Vint i)))) m
| Pxoriw d s i =>
Next (nextinstr (rs#d <- (Val.xor rs##s (Vint i)))) m
| Pslliw d s i =>
Next (nextinstr (rs#d <- (Val.shl rs##s (Vint i)))) m
| Psrliw d s i =>
Next (nextinstr (rs#d <- (Val.shru rs##s (Vint i)))) m
| Psraiw d s i =>
Next (nextinstr (rs#d <- (Val.shr rs##s (Vint i)))) m
| Pluiw d i =>
Next (nextinstr (rs#d <- (Vint (Int.shl i (Int.repr 12))))) m
(** 32-bit integer register-register instructions *)
| Paddw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.add rs##s1 rs##s2))) m
| Psubw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.sub rs##s1 rs##s2))) m
| Pmulw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mul rs##s1 rs##s2))) m
| Pmulhw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mulhs rs##s1 rs##s2))) m
| Pmulhuw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mulhu rs##s1 rs##s2))) m
| Pdivw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.divs rs##s1 rs##s2)))) m
| Pdivuw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.divu rs##s1 rs##s2)))) m
| Premw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.mods rs##s1 rs##s2)))) m
| Premuw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.modu rs##s1 rs##s2)))) m
| Psltw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmp Clt rs##s1 rs##s2))) m
| Psltuw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpu (Mem.valid_pointer m) Clt rs##s1 rs##s2))) m
| Pseqw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpu (Mem.valid_pointer m) Ceq rs##s1 rs##s2))) m
| Psnew d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpu (Mem.valid_pointer m) Cne rs##s1 rs##s2))) m
| Pandw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.and rs##s1 rs##s2))) m
| Porw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.or rs##s1 rs##s2))) m
| Pxorw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.xor rs##s1 rs##s2))) m
| Psllw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shl rs##s1 rs##s2))) m
| Psrlw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shru rs##s1 rs##s2))) m
| Psraw d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shr rs##s1 rs##s2))) m
(** 64-bit integer register-immediate instructions *)
| Paddil d s i =>
Next (nextinstr (rs#d <- (Val.addl rs###s (Vlong i)))) m
| Psltil d s i =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmpl Clt rs###s (Vlong i))))) m
| Psltiul d s i =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Clt rs###s (Vlong i))))) m
| Pandil d s i =>
Next (nextinstr (rs#d <- (Val.andl rs###s (Vlong i)))) m
| Poril d s i =>
Next (nextinstr (rs#d <- (Val.orl rs###s (Vlong i)))) m
| Pxoril d s i =>
Next (nextinstr (rs#d <- (Val.xorl rs###s (Vlong i)))) m
| Psllil d s i =>
Next (nextinstr (rs#d <- (Val.shll rs###s (Vint i)))) m
| Psrlil d s i =>
Next (nextinstr (rs#d <- (Val.shrlu rs###s (Vint i)))) m
| Psrail d s i =>
Next (nextinstr (rs#d <- (Val.shrl rs###s (Vint i)))) m
| Pluil d i =>
Next (nextinstr (rs#d <- (Vlong (Int64.sign_ext 32 (Int64.shl i (Int64.repr 12)))))) m
(** 64-bit integer register-register instructions *)
| Paddl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.addl rs###s1 rs###s2))) m
| Psubl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.subl rs###s1 rs###s2))) m
| Pmull d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mull rs###s1 rs###s2))) m
| Pmulhl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mullhs rs###s1 rs###s2))) m
| Pmulhul d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mullhu rs###s1 rs###s2))) m
| Pdivl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.divls rs###s1 rs###s2)))) m
| Pdivul d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.divlu rs###s1 rs###s2)))) m
| Preml d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.modls rs###s1 rs###s2)))) m
| Premul d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.modlu rs###s1 rs###s2)))) m
| Psltl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmpl Clt rs###s1 rs###s2)))) m
| Psltul d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Clt rs###s1 rs###s2)))) m
| Pseql d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Ceq rs###s1 rs###s2)))) m
| Psnel d s1 s2 =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.cmplu (Mem.valid_pointer m) Cne rs###s1 rs###s2)))) m
| Pandl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.andl rs###s1 rs###s2))) m
| Porl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.orl rs###s1 rs###s2))) m
| Pxorl d s1 s2 =>
Next (nextinstr (rs#d <- (Val.xorl rs###s1 rs###s2))) m
| Pslll d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shll rs###s1 rs###s2))) m
| Psrll d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shrlu rs###s1 rs###s2))) m
| Psral d s1 s2 =>
Next (nextinstr (rs#d <- (Val.shrl rs###s1 rs###s2))) m
| Pcvtl2w d s =>
Next (nextinstr (rs#d <- (Val.loword rs##s))) m
| Pcvtw2l r =>
Next (nextinstr (rs#r <- (Val.longofint rs#r))) m
(** Unconditional jumps.  Links are always to X1/RA. *)
| Pj_l l =>
goto_label f l rs m
| Pj_s s sg =>
Next (rs#PC <- (Genv.symbol_address ge s Ptrofs.zero)) m
| Pj_r r sg =>
Next (rs#PC <- (rs#r)) m
| Pjal_s s sg =>
Next (rs#PC <- (Genv.symbol_address ge s Ptrofs.zero)
#RA <- (Val.offset_ptr rs#PC Ptrofs.one)
) m
| Pjal_r r sg =>
Next (rs#PC <- (rs#r)
#RA <- (Val.offset_ptr rs#PC Ptrofs.one)
) m
(** Conditional branches, 32-bit comparisons *)
| Pbeqw s1 s2 l =>
eval_branch f l rs m (Val.cmpu_bool (Mem.valid_pointer m) Ceq rs##s1 rs##s2)
| Pbnew s1 s2 l =>
eval_branch f l rs m (Val.cmpu_bool (Mem.valid_pointer m) Cne rs##s1 rs##s2)
| Pbltw s1 s2 l =>
eval_branch f l rs m (Val.cmp_bool Clt rs##s1 rs##s2)
| Pbltuw s1 s2 l =>
eval_branch f l rs m (Val.cmpu_bool (Mem.valid_pointer m) Clt rs##s1 rs##s2)
| Pbgew s1 s2 l =>
eval_branch f l rs m (Val.cmp_bool Cge rs##s1 rs##s2)
| Pbgeuw s1 s2 l =>
eval_branch f l rs m (Val.cmpu_bool (Mem.valid_pointer m) Cge rs##s1 rs##s2)
(** Conditional branches, 64-bit comparisons *)
| Pbeql s1 s2 l =>
eval_branch f l rs m (Val.cmplu_bool (Mem.valid_pointer m) Ceq rs###s1 rs###s2)
| Pbnel s1 s2 l =>
eval_branch f l rs m (Val.cmplu_bool (Mem.valid_pointer m) Cne rs###s1 rs###s2)
| Pbltl s1 s2 l =>
eval_branch f l rs m (Val.cmpl_bool Clt rs###s1 rs###s2)
| Pbltul s1 s2 l =>
eval_branch f l rs m (Val.cmplu_bool (Mem.valid_pointer m) Clt rs###s1 rs###s2)
| Pbgel s1 s2 l =>
eval_branch f l rs m (Val.cmpl_bool Cge rs###s1 rs###s2)
| Pbgeul s1 s2 l =>
eval_branch f l rs m (Val.cmplu_bool (Mem.valid_pointer m) Cge rs###s1 rs###s2)
(** Loads and stores *)
| Plb d a ofs =>
exec_load Mint8signed rs m d a ofs
| Plbu d a ofs =>
exec_load Mint8unsigned rs m d a ofs
| Plh d a ofs =>
exec_load Mint16signed rs m d a ofs
| Plhu d a ofs =>
exec_load Mint16unsigned rs m d a ofs
| Plw d a ofs =>
exec_load Mint32 rs m d a ofs
| Plw_a d a ofs =>
exec_load Many32 rs m d a ofs
| Pld d a ofs =>
exec_load Mint64 rs m d a ofs
| Pld_a d a ofs =>
exec_load Many64 rs m d a ofs
| Psb s a ofs =>
exec_store Mint8unsigned rs m s a ofs
| Psh s a ofs =>
exec_store Mint16unsigned rs m s a ofs
| Psw s a ofs =>
exec_store Mint32 rs m s a ofs
| Psw_a s a ofs =>
exec_store Many32 rs m s a ofs
| Psd s a ofs =>
exec_store Mint64 rs m s a ofs
| Psd_a s a ofs =>
exec_store Many64 rs m s a ofs
(** Floating point register move *)
| Pfmv d s =>
Next (nextinstr (rs#d <- (rs#s))) m
(** 32-bit (single-precision) floating point *)
| Pfls d a ofs =>
exec_load Mfloat32 rs m d a ofs
| Pfss s a ofs =>
exec_store Mfloat32 rs m s a ofs
| Pfnegs d s =>
Next (nextinstr (rs#d <- (Val.negfs rs#s))) m
| Pfabss d s =>
Next (nextinstr (rs#d <- (Val.absfs rs#s))) m
| Pfadds d s1 s2 =>
Next (nextinstr (rs#d <- (Val.addfs rs#s1 rs#s2))) m
| Pfsubs d s1 s2 =>
Next (nextinstr (rs#d <- (Val.subfs rs#s1 rs#s2))) m
| Pfmuls d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mulfs rs#s1 rs#s2))) m
| Pfdivs d s1 s2 =>
Next (nextinstr (rs#d <- (Val.divfs rs#s1 rs#s2))) m
| Pfeqs d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpfs Ceq rs#s1 rs#s2))) m
| Pflts d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpfs Clt rs#s1 rs#s2))) m
| Pfles d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpfs Cle rs#s1 rs#s2))) m
| Pfcvtws d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.intofsingle rs#s)))) m
| Pfcvtwus d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.intuofsingle rs#s)))) m
| Pfcvtsw d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.singleofint rs##s)))) m
| Pfcvtswu d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.singleofintu rs##s)))) m
| Pfcvtls d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.longofsingle rs#s)))) m
| Pfcvtlus d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.longuofsingle rs#s)))) m
| Pfcvtsl d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.singleoflong rs###s)))) m
| Pfcvtslu d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.singleoflongu rs###s)))) m
(** 64-bit (double-precision) floating point *)
| Pfld d a ofs =>
exec_load Mfloat64 rs m d a ofs
| Pfld_a d a ofs =>
exec_load Many64 rs m d a ofs
| Pfsd s a ofs =>
exec_store Mfloat64 rs m s a ofs
| Pfsd_a s a ofs =>
exec_store Many64 rs m s a ofs
| Pfnegd d s =>
Next (nextinstr (rs#d <- (Val.negf rs#s))) m
| Pfabsd d s =>
Next (nextinstr (rs#d <- (Val.absf rs#s))) m
| Pfaddd d s1 s2 =>
Next (nextinstr (rs#d <- (Val.addf rs#s1 rs#s2))) m
| Pfsubd d s1 s2 =>
Next (nextinstr (rs#d <- (Val.subf rs#s1 rs#s2))) m
| Pfmuld d s1 s2 =>
Next (nextinstr (rs#d <- (Val.mulf rs#s1 rs#s2))) m
| Pfdivd d s1 s2 =>
Next (nextinstr (rs#d <- (Val.divf rs#s1 rs#s2))) m
| Pfeqd d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpf Ceq rs#s1 rs#s2))) m
| Pfltd d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpf Clt rs#s1 rs#s2))) m
| Pfled d s1 s2 =>
Next (nextinstr (rs#d <- (Val.cmpf Cle rs#s1 rs#s2))) m
| Pfcvtwd d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.intoffloat rs#s)))) m
| Pfcvtwud d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.intuoffloat rs#s)))) m
| Pfcvtdw d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.floatofint rs##s)))) m
| Pfcvtdwu d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.floatofintu rs##s)))) m
| Pfcvtld d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.longoffloat rs#s)))) m
| Pfcvtlud d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.longuoffloat rs#s)))) m
| Pfcvtdl d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.floatoflong rs###s)))) m
| Pfcvtdlu d s =>
Next (nextinstr (rs#d <- (Val.maketotal (Val.floatoflongu rs###s)))) m
| Pfcvtds d s =>
Next (nextinstr (rs#d <- (Val.floatofsingle rs#s))) m
| Pfcvtsd d s =>
Next (nextinstr (rs#d <- (Val.singleoffloat rs#s))) 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 Mptr m1 (Val.offset_ptr sp pos) rs#SP with
| None => Stuck
| Some m2 => Next (nextinstr (rs #X30 <- (rs SP) #SP <- sp #X31 <- Vundef)) m2
end
| Pfreeframe sz pos =>
match Mem.loadv Mptr m (Val.offset_ptr rs#SP pos) with
| None => Stuck
| Some v =>
match rs SP with
| Vptr stk ofs =>
match Mem.free m stk 0 sz with
| None => Stuck
| Some m' => Next (nextinstr (rs#SP <- v #X31 <- Vundef)) m'
end
| _ => Stuck
end
end
| Plabel lbl =>
Next (nextinstr rs) m
| Ploadsymbol rd s ofs =>
Next (nextinstr (rs#rd <- (Genv.symbol_address ge s ofs))) m
| Ploadsymbol_high rd s ofs =>
Next (nextinstr (rs#rd <- (high_half ge s ofs))) m
| Ploadli rd i =>
Next (nextinstr (rs#X31 <- Vundef #rd <- (Vlong i))) m
| Ploadfi rd f =>
Next (nextinstr (rs#X31 <- Vundef #rd <- (Vfloat f))) m
| Ploadsi rd f =>
Next (nextinstr (rs#X31 <- Vundef #rd <- (Vsingle f))) 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#X5 <- Vundef #X31 <- Vundef) m
end
| _ => Stuck
end
| 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. *)
| Pfence
| Pfmvxs _ _
| Pfmvxd _ _
| Pfmins _ _ _
| Pfmaxs _ _ _
| Pfsqrts _ _
| Pfmadds _ _ _ _
| Pfmsubs _ _ _ _
| Pfnmadds _ _ _ _
| Pfnmsubs _ _ _ _
| Pfmind _ _ _
| Pfmaxd _ _ _
| Pfsqrtd _ _
| Pfmaddd _ _ _ _
| Pfmsubd _ _ _ _
| Pfnmaddd _ _ _ _
| Pfnmsubd _ _ _ _
| Pnop
=> Stuck
end.
(** Translation of the LTL/Linear/Mach view of machine registers to the RISC-V view.  Note that no LTL register maps to [X31].  This register is reserved as temporary, to be used by the generated RV32G code.  *)
Definition preg_of (r: mreg) : preg :=
match r with
| R5  => X5  | R6  => X6  | R7  => X7
| R8  => X8  | R9  => X9  | R10 => X10 | R11 => X11
| R12 => X12 | R13 => X13 | R14 => X14 | R15 => X15
| R16 => X16 | R17 => X17 | R18 => X18 | R19 => X19
| R20 => X20 | R21 => X21 | R22 => X22 | R23 => X23
| R24 => X24 | R25 => X25 | R26 => X26 | R27 => X27
| R28 => X28 | R29 => X29 | R30 => X30
| Machregs.F0  => F0  | Machregs.F1  => F1  | Machregs.F2  => F2  | Machregs.F3  => F3
| Machregs.F4  => F4  | Machregs.F5  => F5  | Machregs.F6  => F6  | Machregs.F7  => F7
| Machregs.F8  => F8  | Machregs.F9  => F9  | Machregs.F10 => F10 | Machregs.F11 => F11
| Machregs.F12 => F12 | Machregs.F13 => F13 | Machregs.F14 => F14 | Machregs.F15 => F15
| Machregs.F16 => F16 | Machregs.F17 => F17 | Machregs.F18 => F18 | Machregs.F19 => F19
| Machregs.F20 => F20 | Machregs.F21 => F21 | Machregs.F22 => F22 | Machregs.F23 => F23
| Machregs.F24 => F24 | Machregs.F25 => F25 | Machregs.F26 => F26 | Machregs.F27 => F27
| Machregs.F28 => F28 | Machregs.F29 => F29 | Machregs.F30 => F30 | Machregs.F31 => F31
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 RISC-V 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#SP (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#X31 <- Vundef))) ->
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 RA) ->
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)
# SP <- Vnullptr
# RA <- Vnullptr 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 = Vnullptr ->
rs X10 = 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).