Data commit

Task/Dining-philosophers/VBA/dining-philosophers.vba

@@ -0,0 +1,96 @@
+'The combination of holding to the second fork
+'(HOLDON=True) and all philosophers start
+'with same hand (DIJKSTRASOLUTION=False) leads
+'to a deadlock. To prevent deadlock
+'set HOLDON=False, and DIJKSTRASOLUTION=True.
+Public Const HOLDON = False
+Public Const DIJKSTRASOLUTION = True
+Public Const X = 10 'chance to continue eating/thinking
+Public Const GETS = 0
+Public Const PUTS = 1
+Public Const EATS = 2
+Public Const THKS = 5
+Public Const FRSTFORK = 0
+Public Const SCNDFORK = 1
+Public Const SPAGHETI = 0
+Public Const UNIVERSE = 1
+Public Const MAXCOUNT = 100000
+Public Const PHILOSOPHERS = 5
+Public semaphore(PHILOSOPHERS - 1) As Integer
+Public positi0n(1, PHILOSOPHERS - 1) As Integer
+Public programcounter(PHILOSOPHERS - 1) As Long
+Public statistics(PHILOSOPHERS - 1, 5, 1) As Long
+Public names As Variant
+Private Sub init()
+    names = [{"Aquinas","Babbage","Carroll","Derrida","Erasmus"}]
+    For j = 0 To PHILOSOPHERS - 2
+        positi0n(0, j) = j + 1 'first fork in right hand
+        positi0n(1, j) = j     'second fork in left hand
+    Next j
+    If DIJKSTRASOLUTION Then
+        positi0n(0, PHILOSOPHERS - 1) = j '  first fork in left hand
+        positi0n(1, PHILOSOPHERS - 1) = 0 'second fork in right hand
+    Else
+        positi0n(0, PHILOSOPHERS - 1) = 0 'first fork in right hand
+        positi0n(1, PHILOSOPHERS - 1) = j 'second fork in left hand
+    End If
+End Sub
+Private Sub philosopher(subject As Integer, verb As Integer, objekt As Integer)
+    statistics(subject, verb, objekt) = statistics(subject, verb, objekt) + 1
+    If verb < 2 Then
+        If semaphore(positi0n(objekt, subject)) <> verb Then
+            If Not HOLDON Then
+                'can't get a fork, release first fork if subject has it, and
+                'this won't toggle the semaphore if subject hasn't firt fork
+                semaphore(positi0n(FRSTFORK, subject)) = 1 - objekt
+                'next round back to try to get first fork
+                programcounter(subject) = 0
+            End If
+        Else
+            'just toggle semaphore and move on
+            semaphore(positi0n(objekt, subject)) = 1 - verb
+            programcounter(subject) = (programcounter(subject) + 1) Mod 6
+        End If
+    Else
+        'when eating or thinking, (100*(X-1)/X)% continue eating or thinking
+        '(100/X)% advance program counter
+        programcounter(subject) = IIf(X * Rnd > 1, verb, verb + 1) Mod 6
+    End If
+End Sub
+Private Sub dine()
+    Dim ph As Integer
+    Do While TC < MAXCOUNT
+        For ph = 0 To PHILOSOPHERS - 1
+            Select Case programcounter(ph)
+                Case 0: philosopher ph, GETS, FRSTFORK
+                Case 1: philosopher ph, GETS, SCNDFORK
+                Case 2: philosopher ph, EATS, SPAGHETI
+                Case 3: philosopher ph, PUTS, FRSTFORK
+                Case 4: philosopher ph, PUTS, SCNDFORK
+                Case 5: philosopher ph, THKS, UNIVERSE
+            End Select
+            TC = TC + 1
+        Next ph
+    Loop
+End Sub
+Private Sub show()
+    Debug.Print "Stats", "Gets", "Gets", "Eats", "Puts", "Puts", "Thinks"
+    Debug.Print "", "First", "Second", "Spag-", "First", "Second", "About"
+    Debug.Print "", "Fork", "Fork", "hetti", "Fork", "Fork", "Universe"
+    For subject = 0 To PHILOSOPHERS - 1
+        Debug.Print names(subject + 1),
+        For objekt = 0 To 1
+            Debug.Print statistics(subject, GETS, objekt),
+        Next objekt
+        Debug.Print statistics(subject, EATS, SPAGHETI),
+        For objekt = 0 To 1
+            Debug.Print statistics(subject, PUTS, objekt),
+        Next objekt
+        Debug.Print statistics(subject, THKS, UNIVERSE)
+    Next subject
+End Sub
+Public Sub main()
+    init
+    dine
+    show
+End Sub