96 lines
3.6 KiB
Text
96 lines
3.6 KiB
Text
'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
|