changeset 721:2abfce56523a

init 5 phils done without infinite loop
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 22 May 2022 19:07:20 +0900
parents e9d781c38629
children b088fa199d3d
files ModelChecking.agda
diffstat 1 files changed, 28 insertions(+), 85 deletions(-) [+]
line wrap: on
line diff
--- a/ModelChecking.agda	Mon May 16 17:55:19 2022 +0900
+++ b/ModelChecking.agda	Sun May 22 19:07:20 2022 +0900
@@ -94,6 +94,8 @@
 --
 -- Data Gear
 --
+--      waiting / pointer / available
+--
 data Data : Set where
    -- D_AtomicNat :  AtomicNat → ℕ → Data
    D_AtomicNat :  AtomicNat → Data
@@ -140,12 +142,11 @@
     ... | tri> ¬a ¬b _  = next (AtomicNat-API.fail api) c
     f_cas a bt    = next ( Context.fail c ) c       -- type error / panic
 
-
+-- putdown_rfork : Phil → (? → t) → t
+-- putdown_rfork p next = goto p->lfork->cas( 0 , putdown_lfork, putdown_lfork ) , next
 
--- putdown_rfork p next = f_set (Phil.right p) 0 ( λ f → putdown_lfork record p { right = f } next )
---               goto p->cas( 0 , putdown_lfork )
 Phil_putdown_rfork_sub : {n : Level} {t : Set n} → Context  → ( Code → Context → t ) → t
-Phil_putdown_rfork_sub c next = next C_cas_int record c { 
+Phil_putdown_rfork_sub c next = next C_cas_int record c {
     c_AtomicNat-API = record { impl = Phil.right phil ; value =  0 ; fail = C_putdown_lfork ; next = C_putdown_lfork } }  where
     phil : Phil
     phil = Phil-API.impl ( Context.c_Phil-API c )
@@ -228,89 +229,31 @@
     a : ℕ → AtomicNat
     a ptr = record { ptr = ptr ; value = 0 }
 
-init-Phil-1 : (ps : List Context) → (left right : AtomicNat ) → List Context
-init-Phil-1 ps left right = new-data (c1 ps) ( λ ptr → D_Phil (p ptr) )  $ λ c ptr → record c { c_Phil-API = record { next = C_thinking ; impl = p ptr }} ∷ ps where
-    p : ℕ → Phil
-    p ptr = record  init-Phil { ptr = ptr ; left = left ; right = right }  
-    c1 :  List Context → Context
-    c1 [] =  init-context
-    c1 (c2 ∷ ct) =  c2
-
-test-j0 : {n : Level} {t : Set n} → Context → (Context → AtomicNat → t) → t
-test-j0 c next = init-AtomicNat1 c next
-
-test-j2 : AtomicNat  
-test-j2 = test-j0 init-context (λ c f → f )
-
-test-i1 : Context → Context 
-test-i1 c = init-AtomicNat1 c $ λ c f → c
-
-test-i0 : Context
-test-i0 = test-i1 init-context
-
-test-i2 : Context
-test-i2 = test-i1 test-i0
-
-test20 : bt (Data)
-test20 = init-AtomicNat1 init-context $  λ c1 left → alloc-data c1
- $ λ c n → Context.memory c
-
--- infinite loop
-test21 : bt (Data)
-test21 = init-AtomicNat1 init-context $  λ c1 left → alloc-data c1
- $ λ c n → insertTree ( Context.memory c)  2 (D_AtomicNat record { ptr = 2 ; value = 0 }) $ λ t → t   
-
--- Ok
-test212  : bt Data
-test212 = insertTree   (node 1 (D_AtomicNat record { ptr = 1 ; value = 0 }) leaf leaf  ) 2 (D_AtomicNat record { ptr = 2 ; value = 0 })
-     $ λ t → t 
-
-open _∧_
-
-test213 : bt Data
-test213 = insertTree (test20)  2 (D_AtomicNat record { ptr = 2 ; value = 0 }) $ λ t → t
+init-Phil-1 : (c1 : Context) → Context
+init-Phil-1 c1 = record c1 { memory = mem2 $ mem1 $ mem ; mbase = n + 3 } where
+   n : ℕ
+   n = Context.mbase c1
+   left  = record { ptr = suc n ; value = 0}
+   right = record { ptr = suc (suc n) ; value = 0}
+   mem : bt Data
+   mem = insertTree ( Context.memory c1) (suc n) (D_AtomicNat left)
+      $ λ t →  t
+   mem1 : bt Data → bt Data
+   mem1 t = insertTree t (suc (suc n)) (D_AtomicNat right )
+      $ λ t →  t
+   mem2 : bt Data → bt Data
+   mem2 t = insertTree t (n + 3) (D_Phil record { ptr = n + 3 ; left = left ; right = right })  
+      $ λ t →  t
+     
+test-i0 : bt Data
+test-i0 =  Context.memory (init-Phil-1 init-context)
 
-test2 : List Context 
-test2 = init-AtomicNat1 init-context $  λ c left → alloc-data c
- $ λ c n → insertTree (Context.memory c) n  (D_AtomicNat (a n))
- $ λ bt → record c { memory = bt } ∷ [] where
-    a : ℕ → AtomicNat
-    a ptr = record { ptr = ptr ; value = 0 }
-
-test-newdata : bt Data
-test-newdata = new-data  init-context ( λ ptr → D_AtomicNat (a ptr) ) $ λ c n → Context.memory c where
-    a : ℕ → AtomicNat
-    a ptr = record { ptr = ptr ; value = 0 }
-
-test0 : List Context 
-test0 = init-AtomicNat1 init-context $ λ c left → c ∷ []
+make-phil : ℕ → Context
+make-phil zero = init-context
+make-phil (suc n) = init-Phil-1 ( make-phil n )
 
-test01 : bt Data 
-test01  = alloc-data init-context  $ λ c1 n → insertTree (Context.memory c1) n (D_AtomicNat (a n)) ( λ bt → next1 bt record c1 { memory = bt } n ) where
-    a : ℕ → AtomicNat
-    a ptr = record { ptr = ptr ; value = 0 }
-    next1 :  bt Data → Context  → ℕ → bt Data
-    next1 t c1 n = t
-
-test01-tree : bt Data
-test01-tree = node 1 (D_AtomicNat record { ptr = 1 ; value = 0 } ) leaf leaf
-
-test01-assert : test01-tree ≡ test01
-test01-assert = refl
-
-tail1 :  Maybe (List (bt Data)) →  Maybe (List (bt Data)) 
-tail1 (just x) = tail x
-tail1 nothing = nothing
-
-test22 : Context 
-test22 = init-AtomicNat1 init-context $ λ c left → init-AtomicNat1 c $ λ c1 right → c1
-
-test : List Context 
-test = init-AtomicNat1 init-context $ λ c left → init-AtomicNat1 c $ λ c1 right → init-Phil-1 (c1 ∷ []) left right
-
-test1 : List Context 
-test1 = init-AtomicNat1 init-context $ λ c left → init-AtomicNat1 c $ λ c1 right → step (init-Phil-1 (c1 ∷ []) left right) (λ ps → ps )
-
+test-i5 : bt Data
+test-i5 =  Context.memory (make-phil 5)
 
 -- loop exexution