Module Asmgen


Require Import Coqlib.
Require Import Errors.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Op.
Require Import Locations.
Require Import Mach.
Require Import Asm.
Require Import Compopts.
Require Import Asm Asmblock Asmblockgen Machblockgen PostpassScheduling.

Local Open Scope string_scope.
Local Open Scope list_scope.
Local Open Scope error_monad_scope.

Functions called by the Asmexpand ocaml file, inspired and adapted from Asmblockgen.v

Module Asmgen_expand.

Definition iterate_op (op1 op2: shift_op -> instruction) (l: list int) (k: code) :=
  match l with
  | nil =>
      op1 (SOimm Int.zero) :: k (* should never happen *)
  | i :: l' =>
      op1 (SOimm i) :: map (fun i => op2 (SOimm i)) l' ++ k
  end.

Definition loadimm_word (r: ireg) (n: int) (k: code) :=
  let hi := Int.shru n (Int.repr 16) in
  if Int.eq hi Int.zero
  then Asm.Pmovw r n :: k
  else Asm.Pmovw r (Int.zero_ext 16 n) :: Asm.Pmovt r hi :: k.

Definition loadimm (r: ireg) (n: int) (k: code) :=
  let d1 := decompose_int OTHER n in
  let d2 := decompose_int OTHER (Int.not n) in
  let l1 := List.length d1 in
  let l2 := List.length d2 in
  if Nat.leb l1 1%nat then
    Asm.Pmov r (SOimm n) :: k
  else if Nat.leb l2 1%nat then
    Asm.Pmvn r (SOimm (Int.not n)) :: k
  else if Archi.thumb2_support then
    loadimm_word r n k
  else if Nat.leb l1 l2 then
    iterate_op (Asm.Pmov r) (Asm.Porr r r) d1 k
  else
    iterate_op (Asm.Pmvn r) (Asm.Pbic r r) d2 k.

Definition addimm (r1 r2: ireg) (n: int) (k: code) :=
  if Int.ltu (Int.repr (-256)) n then
    Asm.Psub r1 r2 (SOimm (Int.neg n)) :: k
  else
   (let d1 := decompose_int ADDSUB n in
    let d2 := decompose_int ADDSUB (Int.neg n) in
    if Nat.leb (List.length d1) (List.length d2)
    then iterate_op (Asm.Padd r1 r2) (Asm.Padd r1 r1) d1 k
    else iterate_op (Asm.Psub r1 r2) (Asm.Psub r1 r1) d2 k).

Recognition of integer immediate arguments for indexed memory accesses. For all 3 kinds of accesses, we provide not a recognizer but a synthesizer: a function taking an arbitrary offset n and returning a valid offset n' that contains as many useful bits of n as possible, so that the computation of the remainder n - n' is as simple as possible. In particular, if n is a representable immediate argument, we should have n' = n.

Definition mk_immed_mem_word (x: int): int :=
  if Int.lt x Int.zero then
    Int.neg (Int.zero_ext (if thumb tt then 8 else 12) (Int.neg x))
  else
    Int.zero_ext 12 x.

Definition mk_immed_mem_small (x: int): int :=
  if Int.lt x Int.zero then
    Int.neg (Int.zero_ext 8 (Int.neg x))
  else
    Int.zero_ext 8 x.

Definition mk_immed_mem_float (x: int): int :=
  let x := Int.and x (Int.repr (-4)) in (* mask low 2 bits off *)
  if Int.lt x Int.zero then
    Int.neg (Int.zero_ext 10 (Int.neg x))
  else
    Int.zero_ext 10 x.

End Asmgen_expand.

Translation from Asmblock to assembly language Inspired from the Aarch64's backend (see aarch64/Asm.v and aarch64/Asmgen.v)


Module Asmblock_TRANSF.

Translation of a shift immediate operation (type Op.shift)

Definition transl_shift (s: shift) (r: ireg): shift_op :=
  match s with
  | Slsl n => SOlsl r (s_amount n)
  | Slsr n => SOlsr r (s_amount n)
  | Sasr n => SOasr r (s_amount n)
  | Sror n => SOror r (s_amount n)
  end.

Definition ireg_of_preg (p : Asm.preg) : res ireg :=
  match p with
  | DR (IR r) => OK r
  | _ => Error (msg "Asmgen.ireg_of_preg")
  end.

Definition freg_of_preg (p : Asm.preg) : res freg :=
  match p with
  | DR (FR r) => OK r
  | _ => Error (msg "Asmgen.freg_of_preg")
  end.

Definition ls_double_valid_chunk (chk: memory_chunk) :=
  match chk with
  | Mint32 | Many32 => true
  | _ => false
  end.

Definition ls_double_valid_chunk_load (chk: memory_chunk) :=
  match chk with
  | Mint32 | Mint32al1 | Many32 => true
  | _ => false
  end.

Definition gen_load_double (rd1 rd2 ra: Asm.ireg) (chk1 chk2: memory_chunk) (i1 i2: int) :=
  if ls_double_valid_chunk_load chk1 && ls_double_valid_chunk_load chk2
  then
    if thumb tt
    then if negb (Asm.preg_eq rd1 rd2) && Int.eq (Int.add i1 (Int.repr 4)) i2
         then OK (Asm.Pldrd rd1 rd2 ra chk1 chk2 i1)
         else Error (msg "Asmgen.gen_load_double: Pldrd_thumb construction is wrong")
    else
      match ls_double_constraints rd1 rd2 chk1 chk2 i1 i2 with
      | Some (rd1, rd2, chk1, chk2, i) => OK (Asm.Pldrd rd1 rd2 ra chk1 chk2 i)
      | _ => Error (msg "Asmgen.gen_load_double: Pldrd construction is wrong")
      end
  else Error (msg "Asmgen.gen_load_double: Pldrd chunks are wrong").

Definition gen_store_double (rf1 rf2 ra: Asm.ireg) (chk1 chk2: memory_chunk) (i1 i2: int) :=
  if ls_double_valid_chunk chk1 && ls_double_valid_chunk chk2
  then
    if thumb tt
    then if Int.eq (Int.add i1 (Int.repr 4)) i2
         then OK (Asm.Pstrd rf1 rf2 ra chk1 chk2 i1)
         else if Int.eq (Int.add i2 (Int.repr 4)) i1
         then OK (Asm.Pstrd rf2 rf1 ra chk2 chk1 i2)
         else Error (msg "Asmgen.gen_store_double: Pstrd construction is wrong (Thumb)")
    else match ls_double_constraints rf1 rf2 chk1 chk2 i1 i2 with
         | Some (rf1, rf2, chk1, chk2, i) => OK (Asm.Pstrd rf1 rf2 ra chk1 chk2 i)
         | _ => Error (msg "Asmgen.gen_store_double: Pstrd construction is wrong")
         end
  else Error (msg "Asmgen.gen_store_double: Pstrd chunks are wrong").

Post-incremented double load/store: the Asmblock peephole only produces these in Thumb mode and in canonical orientation (chk1 at offset 0, chk2 at offset 4). ARM-mode lowering would require the chunk-swap logic of gen_load_double/gen_store_double, which we do not implement here; the OCaml peephole oracle is responsible for not producing the post-incremented forms in ARM mode.

Definition gen_load_pi_double (rd1 rd2 ra: Asm.ireg) (chk1 chk2: memory_chunk) (i: int) :=
  if ls_double_valid_chunk_load chk1 && ls_double_valid_chunk_load chk2
  then
    if thumb tt
    then OK (Asm.Pldrd_pi rd1 rd2 ra chk1 chk2 i)
    else Error (msg "Asmgen.gen_load_pi_double: Pldrd_pi requires Thumb mode")
  else Error (msg "Asmgen.gen_load_pi_double: Pldrd_pi chunks are wrong").

Definition gen_store_pi_double (rf1 rf2 ra: Asm.ireg) (chk1 chk2: memory_chunk) (i: int) :=
  if ls_double_valid_chunk chk1 && ls_double_valid_chunk chk2
  then
    if thumb tt
    then OK (Asm.Pstrd_pi rf1 rf2 ra chk1 chk2 i)
    else Error (msg "Asmgen.gen_store_pi_double: Pstrd_pi requires Thumb mode")
  else Error (msg "Asmgen.gen_store_pi_double: Pstrd_pi chunks are wrong").

Definition basic_to_instruction (b: basic): res Asm.instruction :=
  match b with
  | PArith (PArithP (Pgetcanary) rd) =>
      do rd' <- ireg_of_preg rd;
      OK (Asm.Pgetcanary rd')
  | PArith (PArithP (Pflis f) rd) =>
      do rd' <- freg_of_preg rd;
      OK (Asm.Pflis rd' f)
  | PArith (PArithP (Pmovw i) rd) =>
      do rd' <- ireg_of_preg rd;
      OK (Asm.Pmovw rd' i)
  | PArith (PArithPP (Pubfx i1 i2) rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pubfx rd' rs' i1 i2)
  | PArith (PArithPP (Psbfx i1 i2) rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Psbfx rd' rs' i1 i2)
  | PArith (PArithPP Puxtb rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Puxtb rd' rs')
  | PArith (PArithPP Psxtb rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Psxtb rd' rs')
  | PArith (PArithPP Puxth rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Puxth rd' rs')
  | PArith (PArithPP Psxth rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Psxth rd' rs')
  | PArith (PArithPP Pfcpyd rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfcpyd rd' rs')
  | PArith (PArithPP Pfabsd rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfabsd rd' rs')
  | PArith (PArithPP Pfnegd rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfnegd rd' rs')
  | PArith (PArithPP Pfabss rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfabss rd' rs')
  | PArith (PArithPP Pfnegs rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfnegs rd' rs')
  | PArith (PArithPP Pfcvtsd rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfcvtsd rd' rs')
  | PArith (PArithPP Pfcvtds rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfcvtds rd' rs')
  | PArith (PArithPP Pfsitod rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pfsitod rd' rs')
  | PArith (PArithPP Pfuitod rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pfuitod rd' rs')
  | PArith (PArithPP Pfsitos rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pfsitos rd' rs')
  | PArith (PArithPP Pfuitos rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pfuitos rd' rs')
  | PArith (PArithPP Psingle_of_bits rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Psingle_of_bits rd' rs')
  | PArith (PArithPP Phibits_of_float rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Phibits_of_float rd' rs')
  | PArith (PArithPP Pclz rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Pclz rd' rs')
  | PArith (PArithPP Prbit rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Prbit rd' rs')
  | PArith (PArithPP Prev rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- ireg_of_preg rs;
      OK (Asm.Prev rd' rs')
  | PArith (PArithPP Pbits_of_single rd rs) =>
      do rd' <- ireg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pbits_of_single rd' rs')
  | PArith (PArithPP Pfsqrts rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfsqrts rd' rs')
  | PArith (PArithPP Pfsqrtd rd rs) =>
      do rd' <- freg_of_preg rd;
      do rs' <- freg_of_preg rs;
      OK (Asm.Pfsqrtd rd' rs')
  | PArith (PArithRO Pmov rd o) =>
      OK (Asm.Pmov rd o)
  | PArith (PArithRO Pmvn rd o) =>
      OK (Asm.Pmvn rd o)
  | PArith (PArithPPP Pasr rd rs1 rs2) =>
      do rd' <- ireg_of_preg rd;
      do rs1' <- ireg_of_preg rs1;
      do rs2' <- ireg_of_preg rs2;
      OK (Asm.Pasr rd' rs1' rs2')
  | PArith (PArithAPP (Pbfc i1 i2) rd rs) =>
      if (Asm.preg_eq rd rs) then
        do rd' <- ireg_of_preg rd;
        OK (Asm.Pbfc rd' i1 i2)
      else Error (msg "Asmgen.basic_to_instruction: Pbfc uses registers at both source and target")
  | PArith (PArithAPP (Pmovt i) rd rs) =>
      if (Asm.preg_eq rd rs) then
        do rd' <- ireg_of_preg rd;
        OK (Asm.Pmovt rd' i)
      else Error (msg "Asmgen.basic_to_instruction: Pmovt uses registers at both source and target")
  | PArith (PArithPPP Plsl rd rs1 rs2) =>
      do rd' <- ireg_of_preg rd;
      do rs1' <- ireg_of_preg rs1;
      do rs2' <- ireg_of_preg rs2;
      OK (Asm.Plsl rd' rs1' rs2')
  | PArith (PArithPPP Plsr rd rs1 rs2) =>
      do rd' <- ireg_of_preg rd;
      do rs1' <- ireg_of_preg rs1;
      do rs2' <- ireg_of_preg rs2;
      OK (Asm.Plsr rd' rs1' rs2')
  | PArith (PArithPPP Pror rd rs1 rs2) =>
      do rd' <- ireg_of_preg rd;
      do rs1' <- ireg_of_preg rs1;
      do rs2' <- ireg_of_preg rs2;
      OK (Asm.Pror rd' rs1' rs2')
  | PArith (PArithPPP Pmul rd rs1 rs2) =>
      do rd' <- ireg_of_preg rd;
      do rs1' <- ireg_of_preg rs1;
      do rs2' <- ireg_of_preg rs2;
      OK (Asm.Pmul rd' rs1' rs2')
  | PArith (PArithPPP Pfaddd rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfaddd rd' rs1' rs2')
  | PArith (PArithPPP Pfdivd rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfdivd rd' rs1' rs2')
  | PArith (PArithPPP Pfmuld rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfmuld rd' rs1' rs2')
  | PArith (PArithPPP Pfsubd rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfsubd rd' rs1' rs2')
  | PArith (PArithPPP Pfadds rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfadds rd' rs1' rs2')
  | PArith (PArithPPP Pfdivs rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfdivs rd' rs1' rs2')
  | PArith (PArithPPP Pfmuls rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfmuls rd' rs1' rs2')
  | PArith (PArithPPP Pfsubs rd rs1 rs2) =>
      do rd' <- freg_of_preg rd;
      do rs1' <- freg_of_preg rs1;
      do rs2' <- freg_of_preg rs2;
      OK (Asm.Pfsubs rd' rs1' rs2')
  | PArith (PArithPPP Pdouble_of_iibits rd rlo rhi) =>
      do rd' <- freg_of_preg rd;
      do rlo' <- ireg_of_preg rlo;
      do rhi' <- ireg_of_preg rhi;
      OK (Asm.Pfcpy_fii rd' rlo' rhi')
  | PArith (PArithPPP (Pbfi i1 i2) rd rs1 rs2) =>
      if (Asm.preg_eq rd rs1) then
        do rd' <- ireg_of_preg rd;
        do rs' <- ireg_of_preg rs2;
        OK (Asm.Pbfi rd' rs' i1 i2)
      else Error (msg "Asmgen.basic_to_instruction: Pbfi uses registers at both source and target")
  | PArith (PArithRRO Padd rd rs o) =>
      OK (Asm.Padd rd rs o)
  | PArith (PArithRRO Pand rd rs o) =>
      OK (Asm.Pand rd rs o)
  | PArith (PArithRRO Pbic rd rs o) =>
      OK (Asm.Pbic rd rs o)
  | PArith (PArithRRO Peor rd rs o) =>
      OK (Asm.Peor rd rs o)
  | PArith (PArithRRO Porr rd rs o) =>
      OK (Asm.Porr rd rs o)
  | PArith (PArithRRO Prsb rd rs o) =>
      OK (Asm.Prsb rd rs o)
  | PArith (PArithRRO Psub rd rs o) =>
      OK (Asm.Psub rd rs o)
  | PArith (PArithAFFF Pfmlad rd rs1 rs2) =>
      OK (Asm.Pfmlad rd rs1 rs2)
  | PArith (PArithAFFF Pfmlsd rd rs1 rs2) =>
      OK (Asm.Pfmlsd rd rs1 rs2)
  | PArith (PArithAFFF Pfmlas rd rs1 rs2) =>
      OK (Asm.Pfmlas rd rs1 rs2)
  | PArith (PArithAFFF Pfmlss rd rs1 rs2) =>
      OK (Asm.Pfmlss rd rs1 rs2)
  | PArith (PArithRRRR Pmla rd rs1 rs2 rs3) =>
      OK (Asm.Pmla rd rs1 rs2 rs3)
  | PArith (PArithRRRR Pmls rd rs1 rs2 rs3) =>
      OK (Asm.Pmls rd rs1 rs2 rs3)
  | PArith (PArithDRRRR Psmull rd rs1 rs2 rs3) =>
      OK (Asm.Psmull rd rs1 rs2 rs3)
  | PArith (PArithDRRRR Pumull rd rs1 rs2 rs3) =>
      OK (Asm.Pumull rd rs1 rs2 rs3)
  | PArith (PArithComparisonF Pfcmpzd r) =>
      OK (Asm.Pfcmpzd r)
  | PArith (PArithComparisonF Pfcmpzs r) =>
      OK (Asm.Pfcmpzs r)
  | PArith (PArithComparisonFF Pfcmpd r1 r2) =>
      OK (Asm.Pfcmpd r1 r2)
  | PArith (PArithComparisonFF Pfcmps r1 r2) =>
      OK (Asm.Pfcmps r1 r2)
  | PArith (PArithComparisonRO Pcmp r o) =>
      OK (Asm.Pcmp r o)
  | PArith (PArithComparisonRO Pcmn r o) =>
      OK (Asm.Pcmn r o)
  | PArith (PArithComparisonRO Ptst r o) =>
      OK (Asm.Ptst r o)
  | PArith (Pflid rd f) =>
      OK (Asm.Pflid rd f)
  | PArith (Pftosizd rd rs) =>
      OK (Asm.Pftosizd rd rs)
  | PArith (Pftouizd rd rs) =>
      OK (Asm.Pftouizd rd rs)
  | PArith (Pftosizs rd rs) =>
      OK (Asm.Pftosizs rd rs)
  | PArith (Pftouizs rd rs) =>
      OK (Asm.Pftouizs rd rs)
  | PArith (Pmovite c rd o1 o2) =>
      OK (Asm.Pmovite c rd o1 o2)
  | PArith (Pfmovite c rd rs1 rs2) =>
      OK (Asm.Pfmovite c rd rs1 rs2)
  | PArith (Psubs rd rs o) =>
      OK (Asm.Psubs rd rs o)
  | PArith (Padds rd rs o) =>
      OK (Asm.Padds rd rs o)
  | PArith (Psbcs rd rs o) =>
      OK (Asm.Psbcs rd rs o)
  | PLoad (Pcldi Pldr rd ra o) =>
      OK (Asm.Pldr rd ra o)
  | PLoad (Pcldi Pldr_a rd ra o) =>
      OK (Asm.Pldr_a rd ra o)
  | PLoad (Pcldi Pldr_u rd ra o) =>
      OK (Asm.Pldr_u rd ra o)
  | PLoad (Pcldi Pldrb rd ra o) =>
      OK (Asm.Pldrb rd ra o)
  | PLoad (Pcldi Pldrh rd ra o) =>
      OK (Asm.Pldrh rd ra o)
  | PLoad (Pcldi Pldrsb rd ra o) =>
      OK (Asm.Pldrsb rd ra o)
  | PLoad (Pcldi Pldrsh rd ra o) =>
      OK (Asm.Pldrsh rd ra o)
  | PLoad (Pcldipi Pldr_pi rd ra o) =>
      OK (Asm.Pldr_pi rd ra o)
  | PLoad (Pcldipi Pldr_api rd ra o) =>
      OK (Asm.Pldr_api rd ra o)
  | PLoad (Pcldipi Pldrb_pi rd ra o) =>
      OK (Asm.Pldrb_pi rd ra o)
  | PLoad (Pcldipi Pldrh_pi rd ra o) =>
      OK (Asm.Pldrh_pi rd ra o)
  | PLoad (Pcldipi Pldrsb_pi rd ra o) =>
      OK (Asm.Pldrsb_pi rd ra o)
  | PLoad (Pcldipi Pldrsh_pi rd ra o) =>
      OK (Asm.Pldrsh_pi rd ra o)
  | PLoad (Pcldipd Pldr_pd rd ra o) =>
      OK (Asm.Pldr_pd rd ra o)
  | PLoad (Pcldipd Pldr_apd rd ra o) =>
      OK (Asm.Pldr_apd rd ra o)
  | PLoad (Pcldipd Pldrb_pd rd ra o) =>
      OK (Asm.Pldrb_pd rd ra o)
  | PLoad (Pcldipd Pldrh_pd rd ra o) =>
      OK (Asm.Pldrh_pd rd ra o)
  | PLoad (Pcldipd Pldrsb_pd rd ra o) =>
      OK (Asm.Pldrsb_pd rd ra o)
  | PLoad (Pcldipd Pldrsh_pd rd ra o) =>
      OK (Asm.Pldrsh_pd rd ra o)
  | PLoad (Pcldf Pfldd rd ra i) =>
      OK (Asm.Pfldd rd ra i)
  | PLoad (Pcldf Pfldd_a rd ra i) =>
      OK (Asm.Pfldd_a rd ra i)
  | PLoad (Pcldf Pflds rd ra i) =>
      OK (Asm.Pflds rd ra i)
  | PLoad (Pclddi rd1 rd2 ra chk1 chk2 i1 i2) =>
      gen_load_double rd1 rd2 ra chk1 chk2 i1 i2
  | PLoad (Pclddi_pi rd1 rd2 ra chk1 chk2 i) =>
      gen_load_pi_double rd1 rd2 ra chk1 chk2 i
  | PLoad (Pcldm ra l) => OK (Asm.Pldm ra l)
  | PLoad (Pcvldm ra l) => OK (Asm.Pvldm ra l)
  | PStore (Pcsti Pstr rd ra o) =>
      OK (Asm.Pstr rd ra o)
  | PStore (Pcsti Pstr_a rd ra o) =>
      OK (Asm.Pstr_a rd ra o)
  | PStore (Pcsti Pstr_u rd ra o) =>
      OK (Asm.Pstr_u rd ra o)
  | PStore (Pcsti Pstrb rd ra o) =>
      OK (Asm.Pstrb rd ra o)
  | PStore (Pcsti Pstrh rd ra o) =>
      OK (Asm.Pstrh rd ra o)
  | PStore (Pcstf Pfstd rd ra i) =>
      OK (Asm.Pfstd rd ra i)
  | PStore (Pcstf Pfstd_a rd ra i) =>
      OK (Asm.Pfstd_a rd ra i)
  | PStore (Pcstf Pfsts rd ra i) =>
      OK (Asm.Pfsts rd ra i)
  | PStore (Pcstdi rd1 rd2 ra chk1 chk2 i1 i2) =>
      gen_store_double rd1 rd2 ra chk1 chk2 i1 i2
  | PStore (Pcstdi_pi rs1 rs2 ra chk1 chk2 i) =>
      gen_store_pi_double rs1 rs2 ra chk1 chk2 i
  | PStore (Pcstm ra l) => OK (Asm.Pstm ra l)
  | PStore (Pcvstm ra l) => OK (Asm.Pvstm ra l)
  | PStore (Pcstipi Pstr_pi rd ra o) =>
      OK (Asm.Pstr_pi rd ra o)
  | PStore (Pcstipi Pstr_api rd ra o) =>
      OK (Asm.Pstr_api rd ra o)
  | PStore (Pcstipi Pstrb_pi rd ra o) =>
      OK (Asm.Pstrb_pi rd ra o)
  | PStore (Pcstipi Pstrh_pi rd ra o) =>
      OK (Asm.Pstrh_pi rd ra o)
  | PStore (Pcstipd Pstr_pd rd ra o) =>
      OK (Asm.Pstr_pd rd ra o)
  | PStore (Pcstipd Pstr_apd rd ra o) =>
      OK (Asm.Pstr_apd rd ra o)
  | PStore (Pcstipd Pstrb_pd rd ra o) =>
      OK (Asm.Pstrb_pd rd ra o)
  | PStore (Pcstipd Pstrh_pd rd ra o) =>
      OK (Asm.Pstrh_pd rd ra o)
  | PMemcpy (Pmemcpy8 tr) ras rad mas mad =>
      OK (Asm.Pmemcpy8 ras rad mas mad tr)
  | PMemcpy (Pmemcpy16 tr) ras rad mas mad =>
      OK (Asm.Pmemcpy16 ras rad mas mad tr)
  | PMemcpy (Pmemcpy32 tr) ras rad mas mad =>
      OK (Asm.Pmemcpy32 ras rad mas mad tr)
  | PMemcpy (Pmemcpy64 tr1 tr2) ras rad mas mad =>
      OK (Asm.Pmemcpy64 ras rad mas mad tr1 tr2)
  | Pallocframe sz linkofs =>
      OK (Asm.Pallocframe sz linkofs)
  | Pfreeframe sz linkofs =>
      OK (Asm.Pfreeframe sz linkofs)
  | Ploadsymbol rd id p =>
      OK (Asm.Ploadsymbol rd id p)
  | Pnop r =>
      OK (Asm.Pnop r)
  | Pcfi_rel_offset ofs =>
      OK (Asm.Pcfi_rel_offset ofs)
  | Psdiv rd r1 r2 =>
      OK (Asm.Psdiv rd r1 r2)
  | Pudiv rd r1 r2 =>
      OK (Asm.Pudiv rd r1 r2)
  | Pmemcpyf64 ras rad tr is id => OK (Asm.Pmemcpyf64 ras rad tr is id)
  end.

Definition cf_instruction_to_instruction (cfi: cf_instruction): Asm.instruction :=
  match cfi with
  | Pb lbl => Asm.Pb lbl
  | Pbc c lbl => Asm.Pbc c lbl
  | Pcbz r lbl => Asm.Pcbz r lbl
  | Pcbnz r lbl => Asm.Pcbnz r lbl
  | Pbsymb id sg => Asm.Pbsymb id sg
  | Pblsymb id sg => Asm.Pblsymb id sg
  | Pbreg r sg => Asm.Pbreg r sg
  | Pblreg r sg => Asm.Pblreg r sg
  | Pbtbl r tbl => Asm.Pbtbl r tbl
  end.

Definition control_to_instruction (c: control) :=
  match c with
  | PCtlFlow i => cf_instruction_to_instruction i
  | Pbuiltin ef args res => Asm.Pbuiltin ef (List.map (map_builtin_arg DR) args) (map_builtin_res DR res)
  end.

Fixpoint unfold_label (ll: list label) :=
  match ll with
  | nil => nil
  | l :: ll => Plabel l :: unfold_label ll
  end.

Fixpoint unfold_body (lb: list basic): res Asm.code :=
  match lb with
  | nil => OK nil
  | b :: lb =>
    do b_is <- basic_to_instruction b;
    do lb_is <- unfold_body lb;
    OK (b_is :: lb_is)
  end.

Definition unfold_exit (oc: option control) :=
  match oc with
  | None => nil
  | Some c => control_to_instruction c :: nil
  end.

Definition unfold_bblock (bb: bblock) :=
  let lbl := unfold_label (header bb) in
  if zle (list_length_z (header bb)) 1 then
    do bo_is <- unfold_body (body bb);
    OK (lbl ++ bo_is ++ unfold_exit (exit bb))
  else
    Error (msg "Asmgen.unfold_bblock: Multiple labels were generated.").

Fixpoint unfold (bbs: Asmblock.bblocks) : res Asm.code :=
  match bbs with
  | nil => OK (nil)
  | bb :: bbs' =>
    do bb_is <- unfold_bblock bb;
    do bbs'_is <- unfold bbs';
    OK (bb_is ++ bbs'_is)
  end.

Definition transf_function (f: Asmblock.function) : res Asm.function :=
  do c <- unfold (Asmblock.fn_blocks f);
  if zlt Ptrofs.max_unsigned (list_length_z c)
  then Error (msg "Asmgen.trans_function: code size exceeded")
  else OK {| Asm.fn_sig := Asmblock.fn_sig f; Asm.fn_code := c |}.

Definition transf_fundef (f: Asmblock.fundef) : res Asm.fundef :=
  transf_partial_fundef transf_function f.

Definition transf_program (p: Asmblock.program) : res Asm.program :=
  transform_partial_program transf_fundef p.

End Asmblock_TRANSF.

Definition transf_program (p: Mach.program) : res Asm.program :=
  let mbp := Machblockgen.transf_program p in
  do abp <- Asmblockgen.transf_program mbp;
  do abp' <- (time "PostpassScheduling total oracle+verification" PostpassScheduling.transf_program) abp;
  Asmblock_TRANSF.transf_program abp'.