Module Selection

Instruction selection

The instruction selection pass recognizes opportunities for using combined arithmetic and logical operations and addressing modes offered by the target processor. For instance, the expression x + 1 can take advantage of the "immediate add" instruction of the processor, and on the PowerPC, the expression (x >> 6) & 0xFF can be turned into a "rotate and mask" instruction. Instruction selection proceeds by bottom-up rewriting over expressions. The source language is Cminor and the target language is CminorSel.

Require String.
Require Import Coqlib Maps.
Require Import AST Errors Integers Globalenvs Builtins Switch.
Require Cminor.
Require Import Op CminorSel Cminortyping.
Require Import SelectOp SplitLong SelectLong SelectDiv.
Require Machregs.

Local Open Scope cminorsel_scope.
Local Open Scope error_monad_scope.

Conversion of conditions

Function condexpr_of_expr (e: expr) : condexpr :=
  match e with
  | Eop (Ocmp c) el => CEcond c el
  | Econdition a b c => CEcondition a (condexpr_of_expr b) (condexpr_of_expr c)
  | Elet a b => CElet a (condexpr_of_expr b)
  | _ => CEcond (Ccompuimm Cne Int.zero) (e ::: Enil)
  end.

Function condition_of_expr (e: expr) : condition * exprlist :=
  match e with
  | Eop (Ocmp c) el => (c, el)
  | _ => (Ccompuimm Cne Int.zero, e ::: Enil)
  end.

Conversion of loads and stores

Definition load (chunk: memory_chunk) (e1: expr) :=
  match addressing chunk e1 with
  | (mode, args) => Eload chunk mode args
  end.

Definition store (chunk: memory_chunk) (e1 e2: expr) :=
  match addressing chunk e1 with
  | (mode, args) => Sstore chunk mode args e2
  end.

Instruction selection for operator applications. Most of the work is done by the processor-specific smart constructors defined in modules SelectOp and SelectLong.

Conversion from Cminor expression to Cminorsel expressions

Fixpoint sel_expr (a: Cminor.expr) : expr :=
  match a with
  | Cminor.Evar id => Evar id
  | Cminor.Econst cst => sel_constant cst
  | Cminor.Eunop op arg => sel_unop op (sel_expr arg)
  | Cminor.Ebinop op arg1 arg2 => sel_binop op (sel_expr arg1) (sel_expr arg2)
  | Cminor.Eload chunk addr => load chunk (sel_expr addr)
  end.

Fixpoint sel_exprlist (al: list Cminor.expr) : exprlist :=
  match al with
  | nil => Enil
  | a :: bl => Econs (sel_expr a) (sel_exprlist bl)
  end.

Definition sel_select_opt (ty: typ) (arg1 arg2 arg3: Cminor.expr) : option expr :=
  let (cond, args) := condition_of_expr (sel_expr arg1) in
  SelectOp.select ty cond args (sel_expr arg2) (sel_expr arg3).

Recognition of immediate calls and calls to built-in functions that should be inlined

Inductive call_kind : Type :=
  | Call_default
  | Call_imm (id: ident)
  | Call_builtin (ef: external_function).

Definition expr_is_addrof_ident (e: Cminor.expr) : option ident :=
  match e with
  | Cminor.Econst (Cminor.Oaddrsymbol id ofs) =>
      if Ptrofs.eq ofs Ptrofs.zero then Some id else None
  | _ => None
  end.

Definition classify_call (e: Cminor.expr) : call_kind :=
  match expr_is_addrof_ident e with
  | None => Call_default
  | Some id =>
      match defmap!id with
      | Some(Gfun(External ef)) => if ef_inline ef then Call_builtin ef else Call_imm id
      | _ => Call_imm id
      end
  end.

Builtin arguments and results

Definition sel_builtin_arg
       (e: Cminor.expr) (c: builtin_arg_constraint): AST.builtin_arg expr :=
  let e' := sel_expr e in
  let ba := builtin_arg e' in
  if builtin_arg_ok ba c then ba else BA e'.

Fixpoint sel_builtin_args
       (el: list Cminor.expr)
       (cl: list builtin_arg_constraint): list (AST.builtin_arg expr) :=
  match el with
  | nil => nil
  | e :: el =>
      sel_builtin_arg e (List.hd OK_default cl) :: sel_builtin_args el (List.tl cl)
  end.

Definition sel_builtin_res (optid: option ident) : builtin_res ident :=
  match optid with
  | None => BR_none
  | Some id => BR id
  end.

Known builtin functions

Function sel_known_builtin (bf: builtin_function) (args: exprlist) :=
  match bf, args with
  | BI_platform b, _ =>
      SelectOp.platform_builtin b args
  | BI_standard (BI_select ty), a1 ::: a2 ::: a3 ::: Enil =>
      Some (sel_select ty a1 a2 a3)
  | BI_standard BI_fabs, a1 ::: Enil =>
      Some (SelectOp.absf a1)
  | BI_standard BI_fabsf, a1 ::: Enil =>
      Some (SelectOp.absfs a1)
  | _, _ =>
      None
  end.

A CminorSel statement that does nothing, like Sskip, but reduces.

Definition Sno_op := Sseq Sskip Sskip.

Builtin functions in general

Definition sel_builtin_default (optid: option ident) (ef: external_function)
                               (args: list Cminor.expr) :=
  Sbuiltin (sel_builtin_res optid) ef
           (sel_builtin_args args (Machregs.builtin_constraints ef)).

Definition sel_builtin (optid: option ident) (ef: external_function)
                               (args: list Cminor.expr) :=
  match ef with
  | EF_builtin name sg =>
      match lookup_builtin_function name sg with
      | Some bf =>
          match optid with
          | Some id =>
              match sel_known_builtin bf (sel_exprlist args) with
              | Some a => Sassign id a
              | None => sel_builtin_default optid ef args
              end
          | None =>
              Sno_op (* builtins with semantics are pure *)
          end
      | None => sel_builtin_default optid ef args
      end
  | _ =>
      sel_builtin_default optid ef args
  end.

Conversion of Cminor switch statements to decision trees.

Parameter compile_switch: Z -> nat -> table -> comptree.

Section SEL_SWITCH.

Variable make_cmp_eq: expr -> Z -> expr.
Variable make_cmp_ltu: expr -> Z -> expr.
Variable make_sub: expr -> Z -> expr.
Variable make_to_int: expr -> expr.

Fixpoint sel_switch (arg: nat) (t: comptree): exitexpr :=
  match t with
  | CTaction act =>
      XEexit act
  | CTifeq key act t' =>
      XEcondition (condexpr_of_expr (make_cmp_eq (Eletvar arg) key))
                  (XEexit act)
                  (sel_switch arg t')
  | CTiflt key t1 t2 =>
      XEcondition (condexpr_of_expr (make_cmp_ltu (Eletvar arg) key))
                  (sel_switch arg t1)
                  (sel_switch arg t2)
  | CTjumptable ofs sz tbl t' =>
      XElet (make_sub (Eletvar arg) ofs)
        (XEcondition (condexpr_of_expr (make_cmp_ltu (Eletvar O) sz))
                     (XEjumptable (make_to_int (Eletvar O)) tbl)
                     (sel_switch (S arg) t'))
  end.

End SEL_SWITCH.

Definition sel_switch_int :=
  sel_switch
    (fun arg n => comp Ceq arg (Eop (Ointconst (Int.repr n)) Enil))
    (fun arg n => compu Clt arg (Eop (Ointconst (Int.repr n)) Enil))
    (fun arg ofs => sub arg (Eop (Ointconst (Int.repr ofs)) Enil))
    (fun arg => arg).

Definition sel_switch_long :=
  sel_switch
    (fun arg n => cmpl Ceq arg (longconst (Int64.repr n)))
    (fun arg n => cmplu Clt arg (longconst (Int64.repr n)))
    (fun arg ofs => subl arg (longconst (Int64.repr ofs)))
    lowlong.

"If conversion": conversion of certain if-then-else statements into branchless conditional move instructions.

Recognition of "then" and "else" statements that support if-conversion. Basically we are interested in assignments to local variables id = e. However the front-end may have put skip statements and debug annotations around these assignments.

External heuristic to limit the amount of if-conversion performed. Arguments are: the condition, the "then" and the "else" expressions, and the type at which selection is done.

Parameter if_conversion_heuristic:
  Cminor.expr -> Cminor.expr -> Cminor.expr -> AST.typ -> bool.

Definition if_conversion_base
      (ki: known_idents) (env: typenv)
      (cond: Cminor.expr) (id: ident) (ifso ifnot: Cminor.expr) : option stmt :=
  let ty := env id in
  if is_known ki id
  && safe_expr ki ifso && safe_expr ki ifnot
  && if_conversion_heuristic cond ifso ifnot ty
  then option_map
         (fun sel => Sassign id sel)
         (sel_select_opt ty cond ifso ifnot)
  else None.

Definition if_conversion
      (ki: known_idents) (env: typenv)
      (cond: Cminor.expr) (ifso ifnot: Cminor.stmt) : option stmt :=
  match classify_stmt ifso, classify_stmt ifnot with
  | SCskip, SCassign id a =>
      if_conversion_base ki env cond id (Cminor.Evar id) a
  | SCassign id a, SCskip =>
      if_conversion_base ki env cond id a (Cminor.Evar id)
  | SCassign id1 a1, SCassign id2 a2 =>
      if ident_eq id1 id2 then if_conversion_base ki env cond id1 a1 a2 else None
  | _, _ => None
  end.

Conversion from Cminor statements to Cminorsel statements.

Fixpoint sel_stmt (ki: known_idents) (env: typenv) (s: Cminor.stmt) : res stmt :=
  match s with
  | Cminor.Sskip => OK Sskip
  | Cminor.Sassign id e => OK (Sassign id (sel_expr e))
  | Cminor.Sstore chunk addr rhs => OK (store chunk (sel_expr addr) (sel_expr rhs))
  | Cminor.Scall optid sg fn args =>
      OK (match classify_call fn with
      | Call_default => Scall optid sg (inl _ (sel_expr fn)) (sel_exprlist args)
      | Call_imm id => Scall optid sg (inr _ id) (sel_exprlist args)
      | Call_builtin ef => sel_builtin optid ef args
      end)
  | Cminor.Sbuiltin optid ef args =>
      OK (sel_builtin optid ef args)
  | Cminor.Stailcall sg fn args =>
      OK (match classify_call fn with
      | Call_imm id => Stailcall sg (inr _ id) (sel_exprlist args)
      | _ => Stailcall sg (inl _ (sel_expr fn)) (sel_exprlist args)
      end)
  | Cminor.Sseq s1 s2 =>
      do s1' <- sel_stmt ki env s1; do s2' <- sel_stmt ki env s2;
      OK (Sseq s1' s2')
  | Cminor.Sifthenelse e ifso ifnot =>
      match if_conversion ki env e ifso ifnot with
      | Some s => OK s
      | None =>
          do ifso' <- sel_stmt ki env ifso; do ifnot' <- sel_stmt ki env ifnot;
          OK (Sifthenelse (condexpr_of_expr (sel_expr e)) ifso' ifnot')
      end
  | Cminor.Sloop body =>
      do body' <- sel_stmt ki env body; OK (Sloop body')
  | Cminor.Sblock body =>
      do body' <- sel_stmt ki env body; OK (Sblock body')
  | Cminor.Sexit n => OK (Sexit n)
  | Cminor.Sswitch false e cases dfl =>
      let t := compile_switch Int.modulus dfl cases in
      if validate_switch Int.modulus dfl cases t
      then OK (Sswitch (XElet (sel_expr e) (sel_switch_int O t)))
      else Error (msg "Selection: bad switch (int)")
  | Cminor.Sswitch true e cases dfl =>
      let t := compile_switch Int64.modulus dfl cases in
      if validate_switch Int64.modulus dfl cases t
      then OK (Sswitch (XElet (sel_expr e) (sel_switch_long O t)))
      else Error (msg "Selection: bad switch (long)")
  | Cminor.Sreturn None => OK (Sreturn None)
  | Cminor.Sreturn (Some e) => OK (Sreturn (Some (sel_expr e)))
  | Cminor.Slabel lbl body =>
      do body' <- sel_stmt ki env body; OK (Slabel lbl body')
  | Cminor.Sgoto lbl => OK (Sgoto lbl)
  end.

End SELECTION.

Conversion of functions.

Definition known_id (f: Cminor.function) : known_idents :=
  let add (ki: known_idents) (id: ident) := PTree.set id tt ki in
  List.fold_left add f.(Cminor.fn_vars)
      (List.fold_left add f.(Cminor.fn_params) (PTree.empty unit)).

Definition sel_function (dm: PTree.t globdef) (hf: helper_functions) (f: Cminor.function) : res function :=
  let ki := known_id f in
  do env <- Cminortyping.type_function f;
  do body' <- sel_stmt dm ki env f.(Cminor.fn_body);
  OK (mkfunction
        f.(Cminor.fn_sig)
        f.(Cminor.fn_params)
        f.(Cminor.fn_vars)
        f.(Cminor.fn_stackspace)
        body').

Definition sel_fundef (dm: PTree.t globdef) (hf: helper_functions) (f: Cminor.fundef) : res fundef :=
  transf_partial_fundef (sel_function dm hf) f.

Setting up the helper functions.

We build a partial mapping from global identifiers to their definitions, restricting ourselves to the globals we are interested in, namely the external function declarations that are marked as runtime library helpers. This ensures that the mapping remains small and that lookup_helper below is efficient.

Definition globdef_of_interest (gd: globdef) : bool :=
  match gd with
  | Gfun (External (EF_runtime name sg)) => true
  | _ => false
  end.

Definition record_globdefs (defmap: PTree.t globdef) : PTree.t globdef :=
  PTree.fold
    (fun m id gd => if globdef_of_interest gd then PTree.set id gd m else m)
    defmap (PTree.empty globdef).

Definition lookup_helper_aux
     (name: String.string) (sg: signature) (res: option ident)
     (id: ident) (gd: globdef) :=
  match gd with
  | Gfun (External (EF_runtime name' sg')) =>
      if String.string_dec name name' && signature_eq sg sg'
      then Some id
      else res
  | _ => res
  end.

Definition lookup_helper (globs: PTree.t globdef)
                         (name: String.string) (sg: signature) : res ident :=
  match PTree.fold (lookup_helper_aux name sg) globs None with
  | Some id => OK id
  | None => Error (MSG name :: MSG ": missing or incorrect declaration" :: nil)
  end.

Local Open Scope string_scope.

Definition get_helpers (defmap: PTree.t globdef) : res helper_functions :=
  let globs := record_globdefs defmap in
  do i64_dtos <- lookup_helper globs "__compcert_i64_dtos" sig_f_l ;
  do i64_dtou <- lookup_helper globs "__compcert_i64_dtou" sig_f_l ;
  do i64_stod <- lookup_helper globs "__compcert_i64_stod" sig_l_f ;
  do i64_utod <- lookup_helper globs "__compcert_i64_utod" sig_l_f ;
  do i64_stof <- lookup_helper globs "__compcert_i64_stof" sig_l_s ;
  do i64_utof <- lookup_helper globs "__compcert_i64_utof" sig_l_s ;
  do i64_sdiv <- lookup_helper globs "__compcert_i64_sdiv" sig_ll_l ;
  do i64_udiv <- lookup_helper globs "__compcert_i64_udiv" sig_ll_l ;
  do i64_smod <- lookup_helper globs "__compcert_i64_smod" sig_ll_l ;
  do i64_umod <- lookup_helper globs "__compcert_i64_umod" sig_ll_l ;
  do i64_shl <- lookup_helper globs "__compcert_i64_shl" sig_li_l ;
  do i64_shr <- lookup_helper globs "__compcert_i64_shr" sig_li_l ;
  do i64_sar <- lookup_helper globs "__compcert_i64_sar" sig_li_l ;
  do i64_umulh <- lookup_helper globs "__compcert_i64_umulh" sig_ll_l ;
  do i64_smulh <- lookup_helper globs "__compcert_i64_smulh" sig_ll_l ;
  OK (mk_helper_functions
     i64_dtos i64_dtou i64_stod i64_utod i64_stof i64_utof
     i64_sdiv i64_udiv i64_smod i64_umod
     i64_shl i64_shr i64_sar
     i64_umulh i64_smulh).

Conversion of programs.

Definition sel_program (p: Cminor.program) : res program :=
  let dm := prog_defmap p in
  do hf <- get_helpers dm;
  transform_partial_program (sel_fundef dm hf) p.