(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
(****************************************************************)
(*           The Calculus of Inductive Constructions            *)
(*                       COQ v5.10                              *)
(*                                                              *)
(* Laurent Arditi.  Laboratoire I3S. CNRS ura 1376.             *)
(* Universite de Nice - Sophia Antipolis                        *)
(* arditi@unice.fr, http://wwwi3s.unice.fr/~arditi/lolo.html    *)
(*                                                              *)
(* date: november 1995                                          *)
(* file: Fill_spec.v                                            *)
(* contents: proof of a memory block instruction: Fills cx words*)
(* in memory starting at address di with value al.              *)
(* Specification level                                          *)
(****************************************************************)
Require Export Fill_defs.
(* Specification:  cx: register a_size di: register a_size al: register d_size mem: memory of d_size bit words, addresses of a_size bits  while not(cx=0) do begin mem[di] <- al di <- di+1 cx <- cx-1 end *)
(****************************************************************)
Fixpoint di (st : nat) : BV -> BV -> BV -> Memo -> BV :=
fun (di0 cx0 al0 : BV) (mem0 : Memo) =>
match st return BV with
| O => di0
| S t =>
match IsNull (cx t di0 cx0 al0 mem0) return BV with
| true => di t di0 cx0 al0 mem0
| false => BV_increment (di t di0 cx0 al0 mem0)
end
end
with cx (st : nat) : BV -> BV -> BV -> Memo -> BV :=
fun (di0 cx0 al0 : BV) (mem0 : Memo) =>
match st return BV with
| O => cx0
| S t =>
match IsNull (cx t di0 cx0 al0 mem0) return BV with
| true => cx t di0 cx0 al0 mem0
| false => BV_decrement (cx t di0 cx0 al0 mem0)
end
end
with al (st : nat) : BV -> BV -> BV -> Memo -> BV :=
fun (di0 cx0 al0 : BV) (mem0 : Memo) =>
match st return BV with
| O => al0
| S t =>
match IsNull (cx t di0 cx0 al0 mem0) return BV with
| true => al t di0 cx0 al0 mem0
| false => al t di0 cx0 al0 mem0
end
end
with mem (st : nat) : BV -> BV -> BV -> Memo -> Memo :=
fun (di0 cx0 al0 : BV) (mem0 : Memo) =>
match st return Memo with
| O => mem0
| S t =>
match IsNull (cx t di0 cx0 al0 mem0) return Memo with
| true => mem t di0 cx0 al0 mem0
| false =>
MemoWrite (mem t di0 cx0 al0 mem0)
(BV_to_nat (di t di0 cx0 al0 mem0)) (al t di0 cx0 al0 mem0)
end
end.
(****************************************************************)
(* Valeurs generales des registres *)
auto.
Qed.
auto.
Qed.
auto.
Qed.
simple induction t. auto.
intros. rewrite al_t. elim (IsNull (cx n di0 cx0 al0 mem0)). apply H. apply H.
Qed.
auto.
Qed.
(****************************************************************)
(* Longueurs des registres *)
simple induction t. simpl in |- *. exact di_initsize.
intros.
rewrite di_t. elim (IsNull (cx n di_init cx_init al_init mem_init)). exact H.
rewrite length_BV_increment. exact H.
Qed.
simple induction t. simpl in |- *. exact cx_initsize.
intros.
rewrite cx_t. elim (IsNull (cx n di_init cx_init al_init mem_init)). exact H.
rewrite length_BV_decrement. exact H.
Qed.

Lemma length_al :
forall t : nat, lengthbv (al t di_init cx_init al_init mem_init) = d_size.