| @@ -0,0 +1,209 @@ |
| 1 | +theory Reuse |
| 2 | + imports Snapshot |
| 3 | +begin |
| 4 | + |
| 5 | +definition vacant :: "nat \<Rightarrow> pager \<Rightarrow> nat \<Rightarrow> bool" where |
| 6 | + "vacant slots s f = list_all (\<lambda>k. ptable s k \<noteq> f) [0..<slots]" |
| 7 | + |
| 8 | +lemma vacant_iff [simp]: |
| 9 | + "vacant slots s f \<longleftrightarrow> (\<forall>k<slots. ptable s k \<noteq> f)" |
| 10 | + by (auto simp: vacant_def list_all_iff) |
| 11 | + |
| 12 | +definition copy_frame :: "pager \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> pager" where |
| 13 | + "copy_frame s k f = s\<lparr>ptable := (ptable s)(k := f), |
| 14 | + physical := (physical s)(f := view s k), writable := (writable s)(k := True), |
| 15 | + frontier := max (frontier s) (Suc f)\<rparr>" |
| 16 | + |
| 17 | +definition clear_slot :: "nat \<Rightarrow> pager \<Rightarrow> nat \<Rightarrow> pager" where |
| 18 | + "clear_slot pages s k = s\<lparr>ptable := (ptable s)(k := k mod pages), |
| 19 | + physical := (physical s)(ptable s k := (\<lambda>_. 0)), writable := (writable s)(k := False)\<rparr>" |
| 20 | + |
| 21 | +definition pooled :: "nat \<Rightarrow> nat \<Rightarrow> pager \<Rightarrow> nat list \<Rightarrow> bool" where |
| 22 | + "pooled pages slots s available \<longleftrightarrow> |
| 23 | + invariant slots s \<and> private_frames pages slots s \<and> distinct available \<and> |
| 24 | + (\<forall>f\<in>set available. pages \<le> f \<and> f < frontier s \<and> |
| 25 | + vacant slots s f \<and> physical s f = (\<lambda>_. 0))" |
| 26 | + |
| 27 | +definition reserve :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> pager \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> (pager \<times> nat list) option" where |
| 28 | + "reserve pages slots capacity s available k = |
| 29 | + (let f = (case available of [] \<Rightarrow> frontier s | x # xs \<Rightarrow> x) in |
| 30 | + if 0 < pages \<and> k < slots \<and> \<not> writable s k \<and> pages \<le> f \<and> |
| 31 | + f < capacity \<and> vacant slots s f |
| 32 | + then Some (copy_frame s k f, tl available) else None)" |
| 33 | + |
| 34 | +definition reclaim :: "nat \<Rightarrow> nat \<Rightarrow> pager \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> (pager \<times> nat list) option" where |
| 35 | + "reclaim pages slots s available k = |
| 36 | + (if 0 < pages \<and> k < slots \<and> writable s k \<and> pages \<le> ptable s k \<and> |
| 37 | + ptable s k \<notin> set available \<and> |
| 38 | + list_all (\<lambda>j. j = k \<or> ptable s j \<noteq> ptable s k) [0..<slots] |
| 39 | + then Some (clear_slot pages s k, ptable s k # available) else None)" |
| 40 | + |
| 41 | +lemma initial_pooled: |
| 42 | + "0 < pages \<Longrightarrow> pooled pages slots (initial pages contents) []" |
| 43 | + by (simp add: pooled_def initial_invariant initial_private) |
| 44 | + |
| 45 | +lemma copy_view: |
| 46 | + "vacant slots s f \<Longrightarrow> j < slots \<Longrightarrow> view (copy_frame s k f) j = view s j" |
| 47 | + by (auto simp: view_def copy_frame_def) |
| 48 | + |
| 49 | +lemma copy_bounded: |
| 50 | + "bounded slots s \<Longrightarrow> bounded slots (copy_frame s k f)" |
| 51 | + by (auto simp: bounded_def copy_frame_def max_def) |
| 52 | + |
| 53 | +lemma copy_exclusive: |
| 54 | + "exclusive slots s \<Longrightarrow> vacant slots s f \<Longrightarrow> exclusive slots (copy_frame s k f)" |
| 55 | + by (auto simp: exclusive_def copy_frame_def split: if_splits) |
| 56 | + |
| 57 | +lemma copy_invariant: |
| 58 | + "invariant slots s \<Longrightarrow> vacant slots s f \<Longrightarrow> invariant slots (copy_frame s k f)" |
| 59 | + by (simp add: invariant_def copy_bounded copy_exclusive) |
| 60 | + |
| 61 | +lemma copy_private: |
| 62 | + "private_frames pages slots s \<Longrightarrow> pages \<le> f \<Longrightarrow> |
| 63 | + private_frames pages slots (copy_frame s k f)" |
| 64 | + by (auto simp: private_frames_def copy_frame_def max_def) |
| 65 | + |
| 66 | +lemma copy_original: |
| 67 | + "pages \<le> f \<Longrightarrow> original < pages \<Longrightarrow> |
| 68 | + physical (copy_frame s k f) original = physical s original" |
| 69 | + by (auto simp: copy_frame_def) |
| 70 | + |
| 71 | +lemma clear_bounded: |
| 72 | + "0 < pages \<Longrightarrow> bounded slots s \<Longrightarrow> pages \<le> frontier s \<Longrightarrow> |
| 73 | + bounded slots (clear_slot pages s k)" |
| 74 | + by (auto simp: bounded_def clear_slot_def intro: less_le_trans[OF mod_less_divisor]) |
| 75 | + |
| 76 | +lemma clear_exclusive: |
| 77 | + "0 < pages \<Longrightarrow> exclusive slots s \<Longrightarrow> private_frames pages slots s \<Longrightarrow> |
| 78 | + exclusive slots (clear_slot pages s k)" |
| 79 | + by (auto simp: exclusive_def private_frames_def clear_slot_def split: if_splits; metis mod_less_divisor not_le) |
| 80 | + |
| 81 | +lemma clear_private: |
| 82 | + "private_frames pages slots s \<Longrightarrow> private_frames pages slots (clear_slot pages s k)" |
| 83 | + by (auto simp: private_frames_def clear_slot_def) |
| 84 | + |
| 85 | +lemma clear_invariant: |
| 86 | + "0 < pages \<Longrightarrow> invariant slots s \<Longrightarrow> private_frames pages slots s \<Longrightarrow> |
| 87 | + invariant slots (clear_slot pages s k)" |
| 88 | + by (metis invariant_def private_frames_def clear_bounded clear_exclusive) |
| 89 | + |
| 90 | +lemma clear_vacant: |
| 91 | + "0 < pages \<Longrightarrow> exclusive slots s \<Longrightarrow> k < slots \<Longrightarrow> |
| 92 | + writable s k \<Longrightarrow> pages \<le> ptable s k \<Longrightarrow> |
| 93 | + vacant slots (clear_slot pages s k) (ptable s k)" |
| 94 | + by (auto simp: exclusive_def clear_slot_def; metis mod_less_divisor not_le) |
| 95 | + |
| 96 | +lemma clear_other_view: |
| 97 | + "exclusive slots s \<Longrightarrow> k < slots \<Longrightarrow> writable s k \<Longrightarrow> |
| 98 | + j < slots \<Longrightarrow> j \<noteq> k \<Longrightarrow> view (clear_slot pages s k) j = view s j" |
| 99 | + by (auto simp: exclusive_def clear_slot_def view_def) |
| 100 | + |
| 101 | +lemma clear_target_view: |
| 102 | + "0 < pages \<Longrightarrow> pages \<le> ptable s k \<Longrightarrow> |
| 103 | + view (clear_slot pages s k) k = physical s (k mod pages)" |
| 104 | + by (auto simp: clear_slot_def view_def; metis mod_less_divisor not_le) |
| 105 | + |
| 106 | +lemma clear_original: |
| 107 | + "pages \<le> ptable s k \<Longrightarrow> f < pages \<Longrightarrow> |
| 108 | + physical (clear_slot pages s k) f = physical s f" |
| 109 | + by (auto simp: clear_slot_def) |
| 110 | + |
| 111 | +theorem reclaim_zero: |
| 112 | + "reclaim pages slots s available k = Some (t, remaining) \<Longrightarrow> |
| 113 | + physical t (ptable s k) = (\<lambda>_. 0)" |
| 114 | + by (auto simp: reclaim_def clear_slot_def split: if_splits) |
| 115 | + |
| 116 | +theorem reclaim_unmapped: |
| 117 | + assumes pool: "pooled pages slots s available" |
| 118 | + and step: "reclaim pages slots s available k = Some (t, remaining)" |
| 119 | + shows "vacant slots t (ptable s k)" |
| 120 | + using pool step |
| 121 | + by (auto simp: reclaim_def pooled_def invariant_def split: if_splits; metis clear_vacant vacant_iff) |
| 122 | + |
| 123 | +theorem reclaim_views: |
| 124 | + assumes "pooled pages slots s available" |
| 125 | + "reclaim pages slots s available k = Some (t, remaining)" "j < slots" |
| 126 | + shows "view t j = (if j = k then physical s (k mod pages) else view s j)" |
| 127 | + using assms clear_other_view clear_target_view |
| 128 | + by (auto simp: pooled_def reclaim_def invariant_def split: if_splits) |
| 129 | + |
| 130 | +theorem reclaim_pool: |
| 131 | + assumes pool: "pooled pages slots s available" |
| 132 | + and step: "reclaim pages slots s available k = Some (t, remaining)" |
| 133 | + shows "pooled pages slots t remaining" |
| 134 | +proof - |
| 135 | + have positive: "0 < pages" and valid: "k < slots" and writable: "writable s k" |
| 136 | + and private_frame: "pages \<le> ptable s k" and fresh: "ptable s k \<notin> set available" |
| 137 | + and result: "t = clear_slot pages s k" "remaining = ptable s k # available" |
| 138 | + using step by (auto simp: reclaim_def split: if_splits) |
| 139 | + have inv: "invariant slots s" and owned: "private_frames pages slots s" |
| 140 | + using pool by (auto simp: pooled_def) |
| 141 | + have new_inv: "invariant slots t" and new_owned: "private_frames pages slots t" |
| 142 | + using clear_invariant[OF positive inv owned] clear_private[OF owned] result by auto |
| 143 | + have unused: "vacant slots t (ptable s k)" |
| 144 | + using reclaim_unmapped[OF pool step] . |
| 145 | + have clean: "physical t (ptable s k) = (\<lambda>_. 0)" |
| 146 | + using reclaim_zero[OF step] . |
| 147 | + show ?thesis |
| 148 | + using pool fresh result positive valid private_frame inv new_inv new_owned unused clean |
| 149 | + by (auto simp: pooled_def clear_slot_def bounded_def invariant_def split: if_splits; metis mod_less_divisor not_le) |
| 150 | +qed |
| 151 | + |
| 152 | +theorem reserve_views: |
| 153 | + "reserve pages slots capacity s available k = Some (t, remaining) \<Longrightarrow> |
| 154 | + j < slots \<Longrightarrow> view t j = view s j" |
| 155 | + by (auto simp: reserve_def Let_def split: list.splits if_splits intro: copy_view) |
| 156 | + |
| 157 | +theorem reserve_pool: |
| 158 | + assumes pool: "pooled pages slots s available" |
| 159 | + and step: "reserve pages slots capacity s available k = Some (t, remaining)" |
| 160 | + shows "pooled pages slots t remaining" |
| 161 | +proof (cases available) |
| 162 | + case Nil |
| 163 | + then have fresh: "vacant slots s (frontier s)" |
| 164 | + using pool by (auto simp: pooled_def invariant_def bounded_def) |
| 165 | + have owned: "pages \<le> frontier s" using pool by (auto simp: pooled_def private_frames_def) |
| 166 | + show ?thesis |
| 167 | + using step pool fresh owned Nil copy_invariant copy_private |
| 168 | + by (auto simp: reserve_def Let_def pooled_def split: if_splits) |
| 169 | +next |
| 170 | + case (Cons f rest) |
| 171 | + have fresh: "vacant slots s f" and owned: "pages \<le> f" |
| 172 | + and distinct: "f \<notin> set rest" |
| 173 | + using pool Cons by (auto simp: pooled_def) |
| 174 | + have result: "t = copy_frame s k f" "remaining = rest" |
| 175 | + using step Cons by (auto simp: reserve_def Let_def split: if_splits) |
| 176 | + have inv: "invariant slots t" and own: "private_frames pages slots t" |
| 177 | + using pool result fresh owned copy_invariant copy_private by (auto simp: pooled_def) |
| 178 | + show ?thesis |
| 179 | + using pool Cons distinct result inv own |
| 180 | + by (auto simp: pooled_def copy_frame_def max_def split: if_splits) |
| 181 | +qed |
| 182 | + |
| 183 | +theorem reserve_original: |
| 184 | + "reserve pages slots capacity s available k = Some (t, remaining) \<Longrightarrow> |
| 185 | + f < pages \<Longrightarrow> physical t f = physical s f" |
| 186 | + by (auto simp: reserve_def Let_def split: list.splits if_splits intro: copy_original) |
| 187 | + |
| 188 | +theorem reclaim_original: |
| 189 | + "reclaim pages slots s available k = Some (t, remaining) \<Longrightarrow> |
| 190 | + f < pages \<Longrightarrow> physical t f = physical s f" |
| 191 | + by (auto simp: reclaim_def split: if_splits intro: clear_original) |
| 192 | + |
| 193 | +theorem pooled_unmapped: |
| 194 | + "pooled pages slots s available \<Longrightarrow> f \<in> set available \<Longrightarrow> |
| 195 | + j < slots \<Longrightarrow> ptable s j \<noteq> f" |
| 196 | + by (auto simp: pooled_def) |
| 197 | + |
| 198 | +theorem pooled_clean: |
| 199 | + "pooled pages slots s available \<Longrightarrow> f \<in> set available \<Longrightarrow> |
| 200 | + physical s f offset = 0" |
| 201 | + by (auto simp: pooled_def) |
| 202 | + |
| 203 | +theorem pooled_store: |
| 204 | + assumes "pooled pages slots s available" "k < slots" "writable s k" |
| 205 | + shows "pooled pages slots (store s k offset byte) available" |
| 206 | + using assms write_invariant[of slots s k offset byte] store_private[of pages slots s k offset byte] |
| 207 | + by (auto simp: pooled_def store_def prepare_def Let_def) |
| 208 | + |
| 209 | +end |