From 438d541dbe5fe7d7fe6b7aacaa6e6ef070c2e237 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Thu, 16 Apr 2020 20:23:35 +0200 Subject: Move reserved_registers to CPragmas. The list of reserved_registers is never reset between the compilation of multiple files. Instead of storing them in IRC they are moved in the CPragmas file and reset in the a new reset function for Cpragmas whic is called per file. --- cfrontend/CPragmas.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'cfrontend') diff --git a/cfrontend/CPragmas.ml b/cfrontend/CPragmas.ml index 44660718..ce2cfcf0 100644 --- a/cfrontend/CPragmas.ml +++ b/cfrontend/CPragmas.ml @@ -49,13 +49,15 @@ let process_use_section_pragma classname id = (* #pragma reserve_register *) +let reserved_registers = ref ([]: Machregs.mreg list) + let process_reserve_register_pragma name = match Machregsaux.register_by_name name with | None -> C2C.error "unknown register in `reserve_register' pragma" | Some r -> if Machregsaux.can_reserve_register r then - IRC.reserved_registers := r :: !IRC.reserved_registers + reserved_registers := r :: !reserved_registers else C2C.error "cannot reserve this register (not a callee-save)" @@ -84,5 +86,8 @@ let process_pragma name = | _ -> false +let reset () = + reserved_registers := [] + let initialize () = C2C.process_pragma_hook := process_pragma -- cgit From 070babeff47562a72d6a58dd70fc7ac1bcbf205c Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 15 Jun 2020 19:20:15 +0200 Subject: SimplExpr: better translation of casts in a "for effects" context This is useful for statements such as `(void) expr;` where we would prefer not to explicitly compute intermediate values of type `void` and store them in Clight temporary variables. See issue #361 for a real-world occurrence of this phenomenon. --- cfrontend/SimplExpr.v | 11 ++- cfrontend/SimplExprproof.v | 165 +++++++++++++++++++++++---------------------- cfrontend/SimplExprspec.v | 126 +++++++++++++++++++--------------- 3 files changed, 166 insertions(+), 136 deletions(-) (limited to 'cfrontend') diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v index 7cdff468..1398317d 100644 --- a/cfrontend/SimplExpr.v +++ b/cfrontend/SimplExpr.v @@ -226,6 +226,8 @@ Definition sd_seqbool_val (tmp: ident) (ty: type) := SDbase type_bool ty tmp. Definition sd_seqbool_set (ty: type) (sd: set_destination) := let tmp := sd_temp sd in SDcons type_bool ty tmp sd. +Definition sd_cast_set (ty: type) (sd: set_destination) := + let tmp := sd_temp sd in SDcons ty ty tmp sd. Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement * expr) := match a with @@ -268,8 +270,13 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement do (sl2, a2) <- transl_expr For_val r2; ret (finish dst (sl1 ++ sl2) (Ebinop op a1 a2 ty)) | Csyntax.Ecast r1 ty => - do (sl1, a1) <- transl_expr For_val r1; - ret (finish dst sl1 (Ecast a1 ty)) + match dst with + | For_val | For_set _ => + do (sl1, a1) <- transl_expr For_val r1; + ret (finish dst sl1 (Ecast a1 ty)) + | For_effects => + transl_expr For_effects r1 + end | Csyntax.Eseqand r1 r2 ty => do (sl1, a1) <- transl_expr For_val r1; match dst with diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v index ee1df409..9a3f32ec 100644 --- a/cfrontend/SimplExprproof.v +++ b/cfrontend/SimplExprproof.v @@ -145,18 +145,18 @@ Proof. assert (A: forall dst a, dst = For_val \/ dst = For_effects -> final dst a = nil). intros. destruct H; subst dst; auto. apply tr_expr_exprlist; intros; simpl in *; try discriminate; auto. - rewrite H0; auto. simpl; auto. - rewrite H0; auto. simpl; auto. - destruct H1; congruence. - destruct (andb_prop _ _ H6). inv H1. +- rewrite H0; auto. simpl; auto. +- rewrite H0; auto. simpl; auto. +- destruct H1; congruence. +- destruct (andb_prop _ _ H6). inv H1. rewrite H0; eauto. simpl; auto. unfold chunk_for_volatile_type in H9. destruct (type_is_volatile (Csyntax.typeof e1)); simpl in H8; congruence. - rewrite H0; auto. simpl; auto. - rewrite H0; auto. simpl; auto. - destruct (andb_prop _ _ H7). rewrite H0; auto. rewrite H2; auto. simpl; auto. - rewrite H0; auto. simpl; auto. - destruct (andb_prop _ _ H6). rewrite H0; auto. +- rewrite H0; auto. simpl; auto. +- rewrite H0; auto. simpl; auto. +- destruct (andb_prop _ _ H7). rewrite H0; auto. rewrite H2; auto. simpl; auto. +- rewrite H0; auto. simpl; auto. +- destruct (andb_prop _ _ H6). rewrite H0; auto. Qed. Lemma tr_simple_expr_nil: @@ -234,11 +234,11 @@ Proof. Opaque makeif. intros e m. apply (eval_simple_rvalue_lvalue_ind ge e m); intros until tmps; intros TR; inv TR. -(* value *) +- (* value *) auto. - auto. - exists a0; auto. -(* rvalof *) +- auto. +- exists a0; auto. +- (* rvalof *) inv H7; try congruence. exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. @@ -248,53 +248,55 @@ Opaque makeif. exploit deref_loc_translated; eauto. unfold chunk_for_volatile_type; rewrite H2. tauto. destruct dst; auto. econstructor. split. simpl; eauto. auto. -(* addrof *) +- (* addrof *) exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. assert (eval_expr tge e le m (Eaddrof' a1 ty) (Vptr b ofs)) by (apply eval_Eaddrof'; auto). assert (typeof (Eaddrof' a1 ty) = ty) by (apply typeof_Eaddrof'). destruct dst; auto. simpl; econstructor; eauto. -(* unop *) +- (* unop *) exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. assert (eval_expr tge e le m (Eunop op a1 ty) v). econstructor; eauto. congruence. destruct dst; auto. simpl; econstructor; eauto. -(* binop *) +- (* binop *) exploit H0; eauto. intros [A [B C]]. exploit H2; eauto. intros [D [E F]]. subst sl1 sl2; simpl. assert (eval_expr tge e le m (Ebinop op a1 a2 ty) v). econstructor; eauto. rewrite comp_env_preserved; congruence. destruct dst; auto. simpl; econstructor; eauto. -(* cast *) +- (* cast effects *) + exploit H0; eauto. +- (* cast val *) exploit H0; eauto. intros [A [B C]]. subst sl1; simpl. assert (eval_expr tge e le m (Ecast a1 ty) v). econstructor; eauto. congruence. destruct dst; auto. simpl; econstructor; eauto. -(* sizeof *) +- (* sizeof *) rewrite <- comp_env_preserved. destruct dst. split; auto. split; auto. constructor. auto. exists (Esizeof ty1 ty). split. auto. split. auto. constructor. -(* alignof *) +- (* alignof *) rewrite <- comp_env_preserved. destruct dst. split; auto. split; auto. constructor. auto. exists (Ealignof ty1 ty). split. auto. split. auto. constructor. -(* var local *) +- (* var local *) split; auto. split; auto. apply eval_Evar_local; auto. -(* var global *) +- (* var global *) split; auto. split; auto. apply eval_Evar_global; auto. rewrite symbols_preserved; auto. -(* deref *) +- (* deref *) exploit H0; eauto. intros [A [B C]]. subst sl1. split; auto. split. rewrite typeof_Ederef'; auto. apply eval_Ederef'; auto. -(* field struct *) +- (* field struct *) rewrite <- comp_env_preserved in *. exploit H0; eauto. intros [A [B C]]. subst sl1. split; auto. split; auto. rewrite B in H1. eapply eval_Efield_struct; eauto. -(* field union *) +- (* field union *) rewrite <- comp_env_preserved in *. exploit H0; eauto. intros [A [B C]]. subst sl1. split; auto. split; auto. rewrite B in H1. eapply eval_Efield_union; eauto. @@ -408,43 +410,43 @@ Ltac UNCHANGED := (*generalize compat_dest_change; intro CDC.*) apply leftcontext_leftcontextlist_ind; intros. -(* base *) +- (* base *) TR. rewrite <- app_nil_end; auto. red; auto. intros. rewrite <- app_nil_end; auto. -(* deref *) +- (* deref *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* field *) +- (* field *) inv H1. exploit H0. eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* rvalof *) +- (* rvalof *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1; rewrite app_ass; eauto. red; eauto. intros. rewrite <- app_ass; econstructor; eauto. exploit typeof_context; eauto. congruence. -(* addrof *) +- (* addrof *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* unop *) +- (* unop *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1; rewrite app_ass; eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* binop left *) +- (* binop left *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. red; auto. intros. rewrite <- app_ass. econstructor; eauto. eapply tr_expr_invariant; eauto. UNCHANGED. -(* binop right *) +- (* binop right *) inv H2. assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. @@ -452,14 +454,19 @@ Ltac UNCHANGED := red; auto. intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor; eauto. eapply tr_expr_invariant; eauto. UNCHANGED. -(* cast *) +- (* cast *) inv H1. ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. - TR. subst sl1; rewrite app_ass; eauto. auto. + TR. eauto. auto. + intros. econstructor; eauto. ++ (* generic *) + exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. + TR. subst sl1. rewrite app_ass. eauto. auto. intros. rewrite <- app_ass. econstructor; eauto. -(* seqand *) +- (* seqand *) inv H1. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -467,15 +474,15 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. - auto. auto. auto. auto. - (* for set *) + auto. auto. auto. ++ (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -483,9 +490,9 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. -(* seqor *) +- (* seqor *) inv H1. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -493,15 +500,15 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. - auto. auto. auto. auto. - (* for set *) + auto. auto. auto. ++ (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -509,9 +516,9 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. -(* condition *) +- (* condition *) inv H1. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -520,7 +527,7 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. auto. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -529,7 +536,7 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. - (* for set *) ++ (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. rewrite app_ass. eauto. @@ -538,16 +545,16 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. auto. auto. auto. -(* assign left *) +- (* assign left *) inv H1. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. red; auto. @@ -556,9 +563,9 @@ Ltac UNCHANGED := auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. auto. -(* assign right *) +- (* assign right *) inv H2. - (* for effects *) ++ (* for effects *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl2. rewrite app_ass. eauto. @@ -567,7 +574,7 @@ Ltac UNCHANGED := econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. - (* for val *) ++ (* for val *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl2. rewrite app_ass. eauto. @@ -577,9 +584,9 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. -(* assignop left *) +- (* assignop left *) inv H1. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. red; auto. @@ -587,7 +594,7 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. symmetry; eapply typeof_context; eauto. eauto. auto. auto. auto. auto. auto. auto. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. red; auto. @@ -595,9 +602,9 @@ Ltac UNCHANGED := eapply tr_expr_invariant; eauto. UNCHANGED. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. eapply typeof_context; eauto. -(* assignop right *) +- (* assignop right *) inv H2. - (* for effects *) ++ (* for effects *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl2. rewrite app_ass. eauto. @@ -605,7 +612,7 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. eauto. auto. auto. auto. auto. auto. auto. - (* for val *) ++ (* for val *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl2. rewrite app_ass. eauto. @@ -613,35 +620,35 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. -(* postincr *) +- (* postincr *) inv H1. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor; eauto. symmetry; eapply typeof_context; eauto. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor; eauto. eapply typeof_context; eauto. -(* call left *) +- (* call left *) inv H1. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. auto. auto. auto. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. auto. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. auto. auto. auto. auto. -(* call right *) +- (* call right *) inv H2. - (* for effects *) ++ (* for effects *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. @@ -650,7 +657,7 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. - (* for val *) ++ (* for val *) assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. @@ -660,42 +667,42 @@ Ltac UNCHANGED := auto. eapply tr_expr_invariant; eauto. UNCHANGED. apply S; auto. auto. auto. auto. auto. -(* builtin *) +- (* builtin *) inv H1. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. apply S; auto. auto. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. change (sl3++sl2') with (nil ++ sl3 ++ sl2'). rewrite app_ass. econstructor. auto. apply S; auto. auto. auto. -(* comma *) +- (* comma *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q; rewrite app_ass; eauto. red; auto. intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_expr_invariant; eauto. UNCHANGED. auto. auto. auto. -(* paren *) +- (* paren *) inv H1. - (* for val *) ++ (* for val *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. eauto. red; auto. intros. econstructor; eauto. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. eauto. auto. intros. econstructor; eauto. - (* for set *) ++ (* for set *) exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. rewrite Q. eauto. auto. intros. econstructor; eauto. -(* cons left *) +- (* cons left *) inv H1. exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. TR. subst sl1. rewrite app_ass. eauto. @@ -703,7 +710,7 @@ Ltac UNCHANGED := intros. rewrite <- app_ass. econstructor. apply S; auto. eapply tr_exprlist_invariant; eauto. UNCHANGED. auto. auto. auto. -(* cons right *) +- (* cons right *) inv H2. assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl. exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]]. diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v index e7d57a1c..98425311 100644 --- a/cfrontend/SimplExprspec.v +++ b/cfrontend/SimplExprspec.v @@ -108,7 +108,12 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> tr_expr le dst (Csyntax.Ebinop op e1 e2 ty) (sl1 ++ sl2 ++ final dst (Ebinop op a1 a2 ty)) (Ebinop op a1 a2 ty) tmp - | tr_cast: forall le dst e1 ty sl1 a1 tmp, + | tr_cast_effects: forall le e1 ty sl1 a1 any tmp, + tr_expr le For_effects e1 sl1 a1 tmp -> + tr_expr le For_effects (Csyntax.Ecast e1 ty) + sl1 + any tmp + | tr_cast_val: forall le dst e1 ty sl1 a1 tmp, tr_expr le For_val e1 sl1 a1 tmp -> tr_expr le dst (Csyntax.Ecast e1 ty) (sl1 ++ final dst (Ecast a1 ty)) @@ -767,58 +772,69 @@ Lemma transl_meets_spec: exists tmps, (forall le, tr_exprlist le rl sl al tmps) /\ contained tmps g g'). Proof. apply expr_exprlist_ind; simpl add_dest; intros. -(* val *) +- (* val *) simpl in H. destruct v; monadInv H; exists (@nil ident); split; auto with gensym. Opaque makeif. - intros. destruct dst; simpl in *; inv H2. ++ intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. ++ intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. ++ intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. - intros. destruct dst; simpl in *; inv H2. ++ intros. destruct dst; simpl in *; inv H2. constructor. auto. intros; constructor. constructor. constructor. auto. intros; constructor. -(* var *) +- (* var *) monadInv H; econstructor; split; auto with gensym. UseFinish. constructor. -(* field *) +- (* field *) monadInv H0. exploit H; eauto. auto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. -(* valof *) +- (* valof *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. exploit transl_valof_meets_spec; eauto. intros [tmp2 [Csyntax D]]. UseFinish. exists (tmp1 ++ tmp2); split. intros; apply tr_expr_add_dest. econstructor; eauto with gensym. eauto with gensym. -(* deref *) +- (* deref *) monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. -(* addrof *) +- (* addrof *) monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. econstructor; eauto. -(* unop *) +- (* unop *) monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. -(* binop *) +- (* binop *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. UseFinish. exists (tmp1 ++ tmp2); split. intros; apply tr_expr_add_dest. econstructor; eauto with gensym. eauto with gensym. -(* cast *) - monadInv H0. exploit H; eauto. intros [tmp [A B]]. UseFinish. - econstructor; split; eauto. intros; apply tr_expr_add_dest. constructor; auto. -(* seqand *) +- (* cast *) + destruct dst. ++ (* for value *) + monadInv H0. exploit H; eauto. intros [tmp [A B]]. + econstructor; split; eauto. intros; apply tr_expr_add_dest. + rewrite (app_nil_end sl). + apply tr_cast_val with (dst := For_val); auto. ++ (* for effects *) + exploit H; eauto. intros [tmp [A B]]. + econstructor; split; eauto. intros; eapply tr_cast_effects; eauto. ++ (* for set *) + monadInv H0. exploit H; eauto. intros [tmp [A B]]. + econstructor; split; eauto. intros; apply tr_expr_add_dest. + apply tr_cast_val with (dst := For_set sd); auto. +- (* seqand *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0. - (* for value *) ++ (* for value *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. simpl add_dest in *. exists (x0 :: tmp1 ++ tmp2); split. @@ -826,23 +842,23 @@ Opaque makeif. apply list_disjoint_cons_r; eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exploit H0; eauto with gensym. intros [tmp2 [Csyntax D]]. simpl add_dest in *. exists (tmp1 ++ tmp2); split. intros; eapply tr_seqand_effects; eauto with gensym. apply contained_app; eauto with gensym. - (* for set *) ++ (* for set *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. simpl add_dest in *. exists (tmp1 ++ tmp2); split. intros; eapply tr_seqand_set; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. apply contained_app; eauto with gensym. -(* seqor *) +- (* seqor *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0. - (* for value *) ++ (* for value *) exploit H0; eauto with gensym. intros [tmp2 [Csyntax D]]. simpl add_dest in *. exists (x0 :: tmp1 ++ tmp2); split. @@ -850,23 +866,23 @@ Opaque makeif. apply list_disjoint_cons_r; eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. simpl add_dest in *. exists (tmp1 ++ tmp2); split. intros; eapply tr_seqor_effects; eauto with gensym. apply contained_app; eauto with gensym. - (* for set *) ++ (* for set *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. simpl add_dest in *. exists (tmp1 ++ tmp2); split. intros; eapply tr_seqor_set; eauto with gensym. apply list_disjoint_cons_r; eauto with gensym. apply contained_app; eauto with gensym. -(* condition *) +- (* condition *) monadInv H2. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0. - (* for value *) ++ (* for value *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. exploit H1; eauto with gensym. intros [tmp3 [E F]]. simpl add_dest in *. @@ -877,14 +893,14 @@ Opaque makeif. apply contained_cons. eauto with gensym. apply contained_app. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exploit H0; eauto. intros [tmp2 [Csyntax D]]. exploit H1; eauto. intros [tmp3 [E F]]. simpl add_dest in *. exists (tmp1 ++ tmp2 ++ tmp3); split. intros; eapply tr_condition_effects; eauto with gensym. apply contained_app; eauto with gensym. - (* for test *) ++ (* for test *) exploit H0; eauto with gensym. intros [tmp2 [C D]]. exploit H1; eauto 10 with gensym. intros [tmp3 [E F]]. simpl add_dest in *. @@ -895,69 +911,69 @@ Opaque makeif. apply contained_cons; eauto with gensym. apply contained_app; eauto with gensym. apply contained_app; eauto with gensym. -(* sizeof *) +- (* sizeof *) monadInv H. UseFinish. exists (@nil ident); split; auto with gensym. constructor. -(* alignof *) +- (* alignof *) monadInv H. UseFinish. exists (@nil ident); split; auto with gensym. constructor. -(* assign *) +- (* assign *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. destruct dst; monadInv EQ2; simpl add_dest in *. - (* for value *) ++ (* for value *) exists (x1 :: tmp1 ++ tmp2); split. intros. eapply tr_assign_val with (dst := For_val); eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. - (* for set *) ++ (* for set *) exists (x1 :: tmp1 ++ tmp2); split. repeat rewrite app_ass. simpl. intros. eapply tr_assign_val with (dst := For_set sd); eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. -(* assignop *) +- (* assignop *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. exploit transl_valof_meets_spec; eauto. intros [tmp3 [E F]]. destruct dst; monadInv EQ3; simpl add_dest in *. - (* for value *) ++ (* for value *) exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split. intros. eapply tr_assignop_val with (dst := For_val); eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exists (tmp1 ++ tmp2 ++ tmp3); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. - (* for set *) ++ (* for set *) exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split. repeat rewrite app_ass. simpl. intros. eapply tr_assignop_val with (dst := For_set sd); eauto with gensym. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. -(* postincr *) +- (* postincr *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0; simpl add_dest in *. - (* for value *) ++ (* for value *) exists (x0 :: tmp1); split. econstructor; eauto with gensym. apply contained_cons; eauto with gensym. - (* for effects *) ++ (* for effects *) exploit transl_valof_meets_spec; eauto. intros [tmp2 [Csyntax D]]. exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. eauto with gensym. - (* for set *) ++ (* for set *) repeat rewrite app_ass; simpl. exists (x0 :: tmp1); split. econstructor; eauto with gensym. apply contained_cons; eauto with gensym. -(* comma *) +- (* comma *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto with gensym. intros [tmp2 [Csyntax D]]. exists (tmp1 ++ tmp2); split. @@ -967,46 +983,46 @@ Opaque makeif. simpl. eapply incl_tran. 2: apply add_dest_incl. auto with gensym. destruct dst; simpl; auto with gensym. apply contained_app; eauto with gensym. -(* call *) +- (* call *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. destruct dst; monadInv EQ2; simpl add_dest in *. - (* for value *) ++ (* for value *) exists (x1 :: tmp1 ++ tmp2); split. econstructor; eauto with gensym. congruence. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. - (* for effects *) ++ (* for effects *) exists (tmp1 ++ tmp2); split. econstructor; eauto with gensym. apply contained_app; eauto with gensym. - (* for set *) ++ (* for set *) exists (x1 :: tmp1 ++ tmp2); split. repeat rewrite app_ass. econstructor; eauto with gensym. congruence. apply contained_cons. eauto with gensym. apply contained_app; eauto with gensym. -(* builtin *) +- (* builtin *) monadInv H0. exploit H; eauto. intros [tmp1 [A B]]. destruct dst; monadInv EQ0; simpl add_dest in *. - (* for value *) ++ (* for value *) exists (x0 :: tmp1); split. econstructor; eauto with gensym. congruence. apply contained_cons; eauto with gensym. - (* for effects *) ++ (* for effects *) exists tmp1; split. econstructor; eauto with gensym. auto. - (* for set *) ++ (* for set *) exists (x0 :: tmp1); split. repeat rewrite app_ass. econstructor; eauto with gensym. congruence. apply contained_cons; eauto with gensym. -(* loc *) +- (* loc *) monadInv H. -(* paren *) +- (* paren *) monadInv H0. -(* nil *) +- (* nil *) monadInv H; exists (@nil ident); split; auto with gensym. constructor. -(* cons *) +- (* cons *) monadInv H1. exploit H; eauto. intros [tmp1 [A B]]. exploit H0; eauto. intros [tmp2 [Csyntax D]]. exists (tmp1 ++ tmp2); split. -- cgit From 375c844efb8b91d4ff1dce08ed25f55ddef231d7 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 15 Jun 2020 19:49:07 +0200 Subject: SimplExpr: remove unused definition "sd_cast_set" Follow-up to commit 070babef. --- cfrontend/SimplExpr.v | 2 -- 1 file changed, 2 deletions(-) (limited to 'cfrontend') diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v index 1398317d..c7e57a54 100644 --- a/cfrontend/SimplExpr.v +++ b/cfrontend/SimplExpr.v @@ -226,8 +226,6 @@ Definition sd_seqbool_val (tmp: ident) (ty: type) := SDbase type_bool ty tmp. Definition sd_seqbool_set (ty: type) (sd: set_destination) := let tmp := sd_temp sd in SDcons type_bool ty tmp sd. -Definition sd_cast_set (ty: type) (sd: set_destination) := - let tmp := sd_temp sd in SDcons ty ty tmp sd. Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement * expr) := match a with -- cgit From c6b86fd5719388301295f9ab4b07b57653e0d8c6 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Thu, 25 Jun 2020 11:21:00 +0200 Subject: Improve printing of builtin function invocations In particular __builtin_sel. --- cfrontend/PrintCsyntax.ml | 3 +++ 1 file changed, 3 insertions(+) (limited to 'cfrontend') diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml index 03dc5837..97a00b09 100644 --- a/cfrontend/PrintCsyntax.ml +++ b/cfrontend/PrintCsyntax.ml @@ -268,6 +268,9 @@ let rec expr p (prec, e) = | Ebuiltin(EF_debug(kind,txt,_),_,args,_) -> fprintf p "__builtin_debug@[(%d,%S%a)@]" (P.to_int kind) (extern_atom txt) exprlist (false,args) + | Ebuiltin(EF_builtin(name, _), _, args, _) -> + fprintf p "%s@[(%a)@]" + (camlstring_of_coqstring name) exprlist (true, args) | Ebuiltin(_, _, args, _) -> fprintf p "@[(%a)@]" exprlist (true, args) | Eparen(a1, tycast, ty) -> -- cgit From faa1d7fbfd7c9d5aa333d9b353a6118e105c4428 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Sat, 25 Apr 2020 16:52:33 +0200 Subject: Remove the `can_reserve_register` function. The function is in fact just a call to the function`is_callee_save_register` from `Conventions1.v`. --- cfrontend/CPragmas.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'cfrontend') diff --git a/cfrontend/CPragmas.ml b/cfrontend/CPragmas.ml index ce2cfcf0..92cf4cec 100644 --- a/cfrontend/CPragmas.ml +++ b/cfrontend/CPragmas.ml @@ -56,7 +56,7 @@ let process_reserve_register_pragma name = | None -> C2C.error "unknown register in `reserve_register' pragma" | Some r -> - if Machregsaux.can_reserve_register r then + if Conventions1.is_callee_save r then reserved_registers := r :: !reserved_registers else C2C.error "cannot reserve this register (not a callee-save)" -- cgit From ad2ea9c2e701dd82c26e6cd3e8a777be9bdef2a2 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Wed, 29 Apr 2020 15:12:54 +0200 Subject: Move shared code in new file. The name_of_register and register_of_name function are shared between all architectures and can be moved in a common file. --- cfrontend/CPragmas.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'cfrontend') diff --git a/cfrontend/CPragmas.ml b/cfrontend/CPragmas.ml index 92cf4cec..22ab2b5a 100644 --- a/cfrontend/CPragmas.ml +++ b/cfrontend/CPragmas.ml @@ -52,7 +52,7 @@ let process_use_section_pragma classname id = let reserved_registers = ref ([]: Machregs.mreg list) let process_reserve_register_pragma name = - match Machregsaux.register_by_name name with + match Machregsnames.register_by_name name with | None -> C2C.error "unknown register in `reserve_register' pragma" | Some r -> -- cgit From 4cf2fc41657fac51d806c14fdf481c7047e39df3 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 25 Jul 2020 10:38:18 +0200 Subject: Add support for __builtin_fabsf --- cfrontend/C2C.ml | 2 ++ 1 file changed, 2 insertions(+) (limited to 'cfrontend') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 7f796fe3..75eeaf21 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -183,6 +183,8 @@ let builtins_generic = { (* Floating-point absolute value *) "__builtin_fabs", (TFloat(FDouble, []), [TFloat(FDouble, [])], false); + "__builtin_fabsf", + (TFloat(FFloat, []), [TFloat(FFloat, [])], false); (* Float arithmetic *) "__builtin_fsqrt", (TFloat(FDouble, []), [TFloat(FDouble, [])], false); -- cgit From bc20d7c0d16d07790fb6eb608bf608237b0abbc3 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 25 Jul 2020 17:47:25 +0200 Subject: Move declarations of __builtin_clz* and __builtin_ctz* to C2C.ml These functions are now available on all targets. --- cfrontend/C2C.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'cfrontend') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 75eeaf21..c7cd4937 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -180,6 +180,18 @@ let builtins_generic = { (TInt(IUInt, []), [TInt(IUInt, [])], false); "__builtin_bswap16", (TInt(IUShort, []), [TInt(IUShort, [])], false); + "__builtin_clz", + (TInt(IInt, []), [TInt(IUInt, [])], false); + "__builtin_clzl", + (TInt(IInt, []), [TInt(IULong, [])], false); + "__builtin_clzll", + (TInt(IInt, []), [TInt(IULongLong, [])], false); + "__builtin_ctz", + (TInt(IInt, []), [TInt(IUInt, [])], false); + "__builtin_ctzl", + (TInt(IInt, []), [TInt(IULong, [])], false); + "__builtin_ctzll", + (TInt(IInt, []), [TInt(IULongLong, [])], false); (* Floating-point absolute value *) "__builtin_fabs", (TFloat(FDouble, []), [TFloat(FDouble, [])], false); -- cgit From 77ce8ba291afa9f5629a160df440f9af6614f3ef Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 27 Jul 2020 09:54:00 +0200 Subject: Add __builtin_sqrt as synonymous for __builtin_fsqrt __builtin_sqrt (no "f") is the name used by GCC and Clang. --- cfrontend/C2C.ml | 2 ++ 1 file changed, 2 insertions(+) (limited to 'cfrontend') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index c7cd4937..2386eed9 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -200,6 +200,8 @@ let builtins_generic = { (* Float arithmetic *) "__builtin_fsqrt", (TFloat(FDouble, []), [TFloat(FDouble, [])], false); + "__builtin_sqrt", + (TFloat(FDouble, []), [TFloat(FDouble, [])], false); (* Block copy *) "__builtin_memcpy_aligned", (TVoid [], -- cgit From b1b853a2e9f7f2143fedd58772a702bc9c6a8ba1 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Fri, 30 Oct 2020 18:32:04 +0100 Subject: Add -main option to specify entrypoint function in interpreter mode (#374) When running unit tests with the CompCert reference interpreter, it's nice to be able to start execution at a given test function instead of having to write a main function. This PR adds a -main command-line option to give the name of the entry point function. The default is still main. Frama-C has a similar option. The function specified with -main is called with no arguments. If its return type is int, its return value is the exit status of the program. Otherwise, its return value is ignored and the program exits with status 0. --- cfrontend/C2C.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'cfrontend') diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml index 2386eed9..ef028255 100644 --- a/cfrontend/C2C.ml +++ b/cfrontend/C2C.ml @@ -1495,7 +1495,7 @@ let convertProgram p = let p' = { prog_defs = gl2; prog_public = public_globals gl2; - prog_main = intern_string "main"; + prog_main = intern_string !Clflags.main_function_name; prog_types = typs; prog_comp_env = ce } in Diagnostics.check_errors (); -- cgit