(** ** Location of function arguments *)

(** In the x86-32 ABI, all arguments are passed on stack. (Snif.) *)

Fixpoint loc_arguments_32
    (tyl: list typ) (ofs: Z) {struct tyl} : list (rpair loc) :=
  match tyl with
  | nil => nil
  | ty :: tys =>
      match ty with
      | Tlong => Twolong (S Outgoing (ofs + 1) Tint) (S Outgoing ofs Tint)
      | _     => One (S Outgoing ofs ty)
      end
      :: loc_arguments_32 tys (ofs + typesize ty)
  end.(** In the x86-64 ABI:
- The first 6 integer arguments are passed in registers [DI], [SI], [DX], [CX], [R8], [R9].
- The first 8 floating-point arguments are passed in registers [X0] to [X7].
- Extra arguments are passed on the stack, in [Outgoing] slots.
  Consecutive stack slots are separated by 8 bytes, even if only 4 bytes
  of data is used in a slot.
*)

Definition int_param_regs := DI :: SI :: DX :: CX :: R8 :: R9 :: nil.Definition float_param_regs := X0 :: X1 :: X2 :: X3 :: X4 :: X5 :: X6 :: X7 :: nil.Fixpoint loc_arguments_64
    (tyl: list typ) (ir fr ofs: Z) {struct tyl} : list (rpair loc) :=
  match tyl with
  | nil => nil
  | (Tint | Tlong | Tany32 | Tany64) as ty :: tys =>
      match list_nth_z int_param_regs ir with
      | None =>
          One (S Outgoing ofs ty) :: loc_arguments_64 tys ir fr (ofs + 2)
      | Some ireg =>
          One (R ireg) :: loc_arguments_64 tys (ir + 1) fr ofs
      end
  | (Tfloat | Tsingle) as ty :: tys =>
      match list_nth_z float_param_regs fr with
      | None =>
          One (S Outgoing ofs ty) :: loc_arguments_64 tys ir fr (ofs + 2)
      | Some freg =>
          One (R freg) :: loc_arguments_64 tys ir (fr + 1) ofs
      end
  end.(** [loc_arguments s] returns the list of locations where to store arguments
  when calling a function with signature [s].  *)

Definition loc_arguments (s: signature) : list (rpair loc) :=
  if Archi.ptr64
  then loc_arguments_64 s.(sig_args) 0 0 0
  else loc_arguments_32 s.(sig_args) 0.(** [size_arguments s] returns the number of [Outgoing] slots used
  to call a function with signature [s]. *)

Fixpoint size_arguments_32
    (tyl: list typ) (ofs: Z) {struct tyl} : Z :=
  match tyl with
  | nil => ofs
  | ty :: tys => size_arguments_32 tys (ofs + typesize ty)
  end.Fixpoint size_arguments_64 (tyl: list typ) (ir fr ofs: Z) {struct tyl} : Z :=
  match tyl with
  | nil => ofs
  | (Tint | Tlong | Tany32 | Tany64) :: tys =>
      match list_nth_z int_param_regs ir with
      | None => size_arguments_64 tys ir fr (ofs + 2)
      | Some ireg => size_arguments_64 tys (ir + 1) fr ofs
      end
  | (Tfloat | Tsingle) :: tys =>
      match list_nth_z float_param_regs fr with
      | None => size_arguments_64 tys ir fr (ofs + 2)
      | Some freg => size_arguments_64 tys ir (fr + 1) ofs
      end
  end.Definition size_arguments (s: signature) : Z :=
  if Archi.ptr64
  then size_arguments_64 s.(sig_args) 0 0 0
  else size_arguments_32 s.(sig_args) 0.Definition loc_argument_32_charact (ofs: Z) (l: loc) : Prop :=
  match l with
  | S Outgoing ofs' ty => ofs' >= ofs /\ typealign ty = 1
  | _ => False
  end.Remark loc_arguments_32_charact:
  forall tyl ofs p,
  In p (loc_arguments_32 tyl ofs) -> forall_rpair (loc_argument_32_charact ofs) p.

(* Specifications: *)
Lemma loc_arguments_acceptable: forall (s: signature) (p: rpair loc), In p (loc_arguments s) -> forall_rpair loc_argument_acceptable p.