langs a-z

Task/Dining-philosophers/OxygenBasic/dining-philosophers.oxy

@@ -0,0 +1,101 @@
+'=========================
+class RoundTableWith5Seats
+'=========================
+
+  % hungry    0
+  % beingUsed 1
+  % putDown   0
+  % empty     0
+
+  sys fork[5], plate[5],chair[5],philosopher[5]
+  sys first
+
+  method AddPasta() as sys
+    function rand() as sys
+      static seed=0x12345678
+      mov eax,seed
+      rol eax,7
+      mul seed
+      xor eax,0x5335ABD9
+      mov seed,eax
+      return seed
+    end function
+    return 4+(rand() and 15)
+  end method
+
+  method dine()
+  first++ 'PRIORITY DINER
+  if first>5 then first-=5
+  for i=1 to 5
+    kl=first+i-1
+    kr=first+i
+    if kl>5 then kl-=5
+    if kr>5 then kr-=5
+    if philosopher(kl) = hungry then
+      if not fork(kl) or fork(kr) = beingUsed then
+        plate(kl) = AddPasta()
+        fork(kl)=beingUsed
+        fork(kr)=beingUsed
+      end if
+    end if
+    '
+  next
+  '
+  for kl=1 to 5
+    kr=kl+1 : if kr>5 then kr-=5
+    if plate(kl)
+      philosopher(kl)+=1 'PHILOSOPHER DINING
+      --plate(kl)
+      if plate(kl)=empty
+        fork(kl)=PutDown
+        fork(kr)=PutDown
+      end if
+    else
+      if philosopher(kl)>0
+        --philosopher(kl) 'PHILOSOPHER THINKING
+      end if
+    end if
+  next
+  '
+  end method
+
+  method show() as string
+  cr=chr(13)+chr(10) : tab=chr(9)
+  pr="philos" tab "activity" tab "plate" tab "fork L" tab "fork R" cr cr
+  for i=1 to 5
+  j=i+1 : if j>5 then j-=5
+  if plate(i)=0 then
+    if philosopher(i)=0 then
+      act="waiting"
+    else
+      act="thinks"
+    end if
+  else
+    act="dining"
+  end if
+  '
+  pr+=i tab act tab plate(i) tab fork(i) tab fork(j) cr
+  next
+  return pr
+  end method
+
+end class
+
+'TEST
+'====
+
+RoundTableWith5Seats Sopho
+for i=1 to 100
+  Sopho.dine
+next
+
+print Sopho.show
+'putfile "s.txt",Sopho.show
+
+'philos	action	plate	fork L	fork R
+'
+'1	waiting	0	0	1
+'2	dining	8	1	1
+'3	thinks	0	1	1
+'4	dining	8	1	1
+'5	thinks	0	1	0

Task/Dining-philosophers/Oz/dining-philosophers.oz

@@ -0,0 +1,117 @@
+declare
+  Philosophers = [aristotle kant spinoza marx russell]
+
+  proc {Start}
+     Forks = {MakeList {Length Philosophers}}
+  in
+     {ForAll Forks NewFork}
+     for
+        Name in Philosophers
+        LeftFork in Forks
+        RightFork in {RightShift Forks}
+     do
+        thread
+           {Philosopher Name LeftFork RightFork}
+        end
+     end
+  end
+
+  proc {Philosopher Name LeftFork RightFork}
+     for do
+        {ShowInfo Name#" is hungry."}
+
+        {TakeForks [LeftFork RightFork]}
+        {ShowInfo Name#" got forks."}
+        {WaitRandom}
+        {ReleaseFork LeftFork}
+        {ReleaseFork RightFork}
+
+        {ShowInfo Name#" is thinking."}
+        {WaitRandom}
+     end
+  end
+
+  proc {WaitRandom}
+     {Delay 1000 + {OS.rand} mod 4000} %% 1-5 seconds
+  end
+
+  proc {TakeForks Forks}
+     {ForAll Forks WaitForFork}
+     case {TryAtomically proc {$}
+                            {ForAll Forks TakeFork}
+                         end}
+     of true then
+        {ForAll Forks InitForkNotifier}
+     [] false then
+        {TakeForks Forks}
+     end
+  end
+
+  %%
+  %% Fork type
+  %%
+
+  %% A fork is a mutable reference to a pair
+  fun {NewFork}
+     {NewCell
+      unit(taken:_     %% a fork is taken by setting this value to a unique value
+           notify:unit %% to wait for a taken fork
+	  )}
+  end
+
+  proc {TakeFork F}
+     (@F).taken = {NewName}
+  end
+
+  proc {InitForkNotifier F}
+     %% we cannot do this in TakeFork
+     %% because side effect are not allowed in subordinate spaces
+     New Old
+  in
+     {Exchange F Old New}
+     New = unit(taken:Old.taken notify:_)
+  end
+
+  proc {ReleaseFork F}
+     New Old
+  in
+     {Exchange F Old New}
+     New = unit(taken:_ notify:unit)
+     Old.notify = unit %% notify waiters
+  end
+
+  proc {WaitForFork F}
+     {Wait (@F).notify}  %% returns immediatly if fork is free, otherwise blocks
+  end
+
+  %%
+  %% Helpers
+  %%
+
+  %% Implements transactions on data flow variables
+  %% with computation spaces. Returns success.
+  fun {TryAtomically P}
+     try
+	S = {Space.new
+	     proc {$ Sync}
+		{P}
+		Sync = unit
+	     end}
+     in
+	{Space.askVerbose S} \= failed = true
+	{Wait {Space.merge S}}
+	true
+     catch _ then
+	false
+     end
+  end
+
+  fun {RightShift Xs} %% circular
+     case Xs of nil then nil
+     else {Append Xs.2 [Xs.1]}
+     end
+  end
+
+  ShowInfo = System.showInfo
+in
+  {Start}

Task/Dining-philosophers/Pike/dining-philosophers.pike

@@ -0,0 +1,94 @@
+class Philosopher
+{
+    string name;
+    object left;
+    object right;
+
+    void create(string _name, object _left, object _right)
+    {
+        name = _name;
+        left = _left;
+        right = _right;
+    }
+
+    void take_forks()
+    {
+        if (left->take(this) && right->take(this))
+        {
+            write("%s is EATING\n", name);
+            call_out(drop_forks, random(30));
+        }
+        else
+        {
+            write("%s is WAITING\n", name);
+            if (random(10) >= 8)
+                drop_forks();
+            call_out(take_forks, random(10));
+        }
+    }
+
+    void drop_forks()
+    {
+        left->drop(this);
+        right->drop(this);
+        write("%s is THINKING\n", name);
+        call_out(take_forks, random(30));
+    }
+}
+
+class Fork
+{
+    int number;
+    Philosopher user;
+
+    void create(int _number)
+    {
+        number = _number;
+    }
+
+    int take(object new_user)
+    {
+        if (!user)
+        {
+            write("%s takes fork %d\n", new_user->name, number);
+            user = new_user;
+            return 1;
+        }
+        else if (new_user == user)
+        {
+            write("%s has fork %d\n", new_user->name, number);
+            return 1;
+        }
+        else
+            write("%s tries to take fork %d from %s\n", new_user->name, number, user->name);
+    }
+
+    void drop(object old_user)
+    {
+        if (old_user == user)
+        {
+            write("%s drops fork %d\n", old_user->name, number);
+            user = 0;
+        }
+    }
+}
+
+int main(int argc, array argv)
+{
+
+  array forks = ({ Fork(1), Fork(2), Fork(3), Fork(4), Fork(5) });
+  array philosophers = ({
+                           Philosopher("einstein", forks[0], forks[1]),
+                           Philosopher("plato", forks[1], forks[2]),
+                           Philosopher("sokrates", forks[2], forks[3]),
+                           Philosopher("chomsky", forks[3], forks[4]),
+                           Philosopher("archimedes", forks[4], forks[0]),
+                        });
+
+  call_out(philosophers[0]->take_forks, random(5));
+  call_out(philosophers[1]->take_forks, random(5));
+  call_out(philosophers[2]->take_forks, random(5));
+  call_out(philosophers[3]->take_forks, random(5));
+  call_out(philosophers[4]->take_forks, random(5));
+  return -1;
+}

Task/Dining-philosophers/PureBasic/dining-philosophers.purebasic

@@ -0,0 +1,117 @@
+Macro Tell(Mutex, Message) ; Make a macro to easy send info back to main thread
+  LockMutex(Mutex)
+    LastElement(Queue())
+    AddElement(Queue())
+    Queue() = Message
+    SignalSemaphore(Semaphore)
+  UnlockMutex(Mutex)
+EndMacro
+
+;Set up a data structure to pass needed info into the threads
+Structure Thread_Parameters
+  Name.s
+  fork1.i
+  fork2.i
+EndStructure
+
+; Declare function to be used
+Declare.i TryFork(n)
+Declare   PutDownFork(n)
+Declare   Invite(Namn.s, Fork1, Fork2)
+Declare   _philosophers(*arg.Thread_Parameters)
+
+Global Semaphore = CreateSemaphore()
+Global Mutex1     = CreateMutex() ; Eg. fork 1
+Global Mutex2     = CreateMutex() ; Eg. fork 2
+Global Mutex3     = CreateMutex() ; Eg. fork 3
+Global Mutex4     = CreateMutex() ; Eg. fork 4
+Global Mutex5     = CreateMutex() ; Eg. fork 5
+Global Mutex_main = CreateMutex() ; locking communication with the main thread which do all output.
+Global NewList Queue.s()
+
+If OpenConsole()
+  Invite("Aristotle",1,2)  ; Get all Philosophers activated
+  Invite("Kant",     2,3)
+  Invite("Spinoza",  3,4)
+  Invite("Marx",     4,5)
+  Invite("Russell",  5,1)
+  CompilerIf #PB_Compiler_OS=#PB_OS_Windows
+    SetConsoleTitle_("Dining philosophers, by Jofur")   ; Using a Windows-API here, so checking before
+  CompilerEndIf
+  ; Wait and see if any Philosophers want to tell me anything
+  Repeat
+    WaitSemaphore(Semaphore)
+    LockMutex(Mutex_main)
+      ForEach Queue()
+        PrintN( Queue() )  ; Print what the Philosopher(s) told me
+        i-1
+      Next Queue()
+      ClearList(Queue())
+    UnlockMutex(Mutex_main)
+  ForEver
+EndIf
+
+Procedure TryFork(n)  ; Se is fork #n is free and if so pick it up
+  Select n
+    Case 1: ProcedureReturn TryLockMutex(Mutex1)
+    Case 2: ProcedureReturn TryLockMutex(Mutex2)
+    Case 3: ProcedureReturn TryLockMutex(Mutex3)
+    Case 4: ProcedureReturn TryLockMutex(Mutex4)
+    Default:ProcedureReturn TryLockMutex(Mutex5)
+  EndSelect
+EndProcedure
+
+Procedure PutDownFork(n) ; put down fork #n and free it to be used by neighbors.
+  Select n
+    Case 1: UnlockMutex(Mutex1)
+    Case 2: UnlockMutex(Mutex2)
+    Case 3: UnlockMutex(Mutex3)
+    Case 4: UnlockMutex(Mutex4)
+    Default:UnlockMutex(Mutex5)
+  EndSelect
+EndProcedure
+
+Procedure Invite(Namn.s, Fork1, Fork2)
+  Protected *arg.Thread_Parameters ;create the structure containing the parameters
+  Protected Thread
+  *arg = AllocateMemory(SizeOf(Thread_Parameters))
+  *arg\Name = Namn
+  *arg\fork1 = Fork1
+  *arg\fork2 = Fork2
+  Thread=CreateThread(@_philosophers(), *arg) ;send the thread a pointer to our structure
+  ProcedureReturn Thread
+EndProcedure
+
+Procedure _philosophers(*arg.Thread_Parameters)
+  Protected Iam.s=*arg\Name, j=*arg\fork1, k=*arg\fork2
+  Protected f1, f2
+  ClearStructure(*arg, Thread_Parameters)
+  FreeMemory(*arg)
+  ;
+  Repeat
+    Tell(Mutex_main,Iam+": Going to the table")
+    Repeat          ;Trying to get my two forks
+      f1=TryFork(j)
+      If f1
+        f2=TryFork(k)
+        If Not f2   ; I got only one fork
+          PutDownFork(j)
+          f1=0
+        EndIf
+      EndIf
+      If Not f2
+        Delay(Random(100))  ; Take a short breath, then try the forks in the other order
+        Swap j,k
+      EndIf
+    Until f1 And f2
+    Tell(Mutex_main,Iam+": I have fork #"+Str(j)+" & #"+Str(k)+" and I'm eating now")
+    Delay(Random(1500)+15)
+    Tell(Mutex_main,Iam+": release fork #"+Str(j)+" & #"+Str(k)+"")
+    Delay(Random(45)+15)
+    PutDownFork(j)
+    PutDownFork(k)
+    f1=0:f2=0
+    Tell(Mutex_main,Iam+": Thinking about the nature of the universe...")
+    Delay(Random(2500)+25)
+  ForEver
+EndProcedure

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-1.visual

@@ -0,0 +1,50 @@
+Imports System.Threading
+Module Module1
+   Public rnd As New Random
+
+   Sub Main()
+       'Aristotle, Kant, Spinoza, Marx, and Russel
+       Dim f1 As New Fork(1)
+       Dim f2 As New Fork(2)
+       Dim f3 As New Fork(3)
+       Dim f4 As New Fork(4)
+       Dim f5 As New Fork(5)
+
+       Console.WriteLine("1: Deadlock")
+       Console.WriteLine("2: Live lock")
+       Console.WriteLine("3: Working")
+       Select Console.ReadLine
+           Case "1"
+               Using _
+                   Aristotle As New SelfishPhilosopher("Aristotle", f1, f2), _
+                   Kant As New SelfishPhilosopher("Kant", f2, f3), _
+                   Spinoza As New SelfishPhilosopher("Spinoza", f3, f4), _
+                   Marx As New SelfishPhilosopher("Marx", f4, f5), _
+                   Russel As New SelfishPhilosopher("Russel", f5, f1)
+
+                   Console.ReadLine()
+               End Using
+           Case "2"
+               Using _
+                   Aristotle As New SelflessPhilosopher("Aristotle", f1, f2), _
+                   Kant As New SelflessPhilosopher("Kant", f2, f3), _
+                   Spinoza As New SelflessPhilosopher("Spinoza", f3, f4), _
+                   Marx As New SelflessPhilosopher("Marx", f4, f5), _
+                   Russel As New SelflessPhilosopher("Russel", f5, f1)
+
+                   Console.ReadLine()
+               End Using
+           Case "3"
+               Using _
+                   Aristotle As New WisePhilosopher("Aristotle", f1, f2), _
+                   Kant As New WisePhilosopher("Kant", f2, f3), _
+                   Spinoza As New WisePhilosopher("Spinoza", f3, f4), _
+                   Marx As New WisePhilosopher("Marx", f4, f5), _
+                   Russel As New WisePhilosopher("Russel", f5, f1)
+
+                   Console.ReadLine()
+               End Using
+       End Select
+   End Sub
+
+End Module

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-2.visual

@@ -0,0 +1,11 @@
+Class Fork
+   Private ReadOnly m_Number As Integer
+   Public Sub New(ByVal number As Integer)
+       m_Number = number
+   End Sub
+   Public ReadOnly Property Number() As Integer
+       Get
+           Return m_Number
+       End Get
+   End Property
+End Class

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-3.visual

@@ -0,0 +1,31 @@
+MustInherit Class PhilosopherBase
+   Implements IDisposable
+
+   Protected m_Disposed As Boolean
+   Protected ReadOnly m_Left As Fork
+   Protected ReadOnly m_Right As Fork
+   Protected ReadOnly m_Name As String
+   Public Sub New(ByVal name As String, ByVal right As Fork, ByVal left As Fork)
+       m_Name = name
+       m_Right = right
+       m_Left = left
+       Dim t As New Thread(AddressOf MainLoop)
+       t.IsBackground = True
+       t.Start()
+   End Sub
+   Protected Overridable Sub Dispose(ByVal disposing As Boolean)
+       m_Disposed = True
+   End Sub
+
+   Public Sub Dispose() Implements IDisposable.Dispose
+       Dispose(True)
+       GC.SuppressFinalize(Me)
+   End Sub
+   Public ReadOnly Property Name() As String
+       Get
+           Return m_Name
+       End Get
+   End Property
+
+   Public MustOverride Sub MainLoop()
+End Class

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-4.visual

@@ -0,0 +1,31 @@
+Class SelfishPhilosopher
+   Inherits PhilosopherBase
+   Public Sub New(ByVal name As String, ByVal right As Fork, ByVal left As Fork)
+       MyBase.New(name, right, left)
+   End Sub
+
+   Public Overrides Sub MainLoop()
+       Do
+           Console.WriteLine(Name & " sat down")
+           SyncLock m_Left
+               Console.WriteLine(Name & " picked up fork " & m_Left.Number)
+
+               SyncLock m_Right
+                   Console.WriteLine(Name & " picked up fork " & m_Right.Number)
+
+                   Console.WriteLine(Name & " ate!!!!")
+
+                   Console.WriteLine(Name & " put down fork " & m_Right.Number)
+               End SyncLock
+
+
+               Console.WriteLine(Name & " put down fork " & m_Left.Number)
+           End SyncLock
+
+           Console.WriteLine(Name & " stood up")
+
+           Thread.Sleep(rnd.Next(0, 10000))
+       Loop Until m_Disposed
+   End Sub
+
+End Class

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-5.visual

@@ -0,0 +1,41 @@
+Class SelflessPhilosopher
+   Inherits PhilosopherBase
+
+   Public Sub New(ByVal name As String, ByVal right As Fork, ByVal left As Fork)
+       MyBase.New(name, right, left)
+   End Sub
+
+   Public Overrides Sub MainLoop()
+       Do
+           Console.WriteLine(Name & " sat down")
+           Dim needDelay = False
+TryAgain:
+           If needDelay Then Thread.Sleep(rnd.Next(0, 10000))
+           Try
+               Monitor.Enter(m_Left)
+               Console.WriteLine(Name & " picked up fork " & m_Left.Number)
+
+               If Monitor.TryEnter(m_Right) Then
+                   Console.WriteLine(Name & " picked up fork " & m_Right.Number)
+
+                   Console.WriteLine(Name & " ate!!!!!!")
+
+                   Console.WriteLine(Name & " put down fork " & m_Right.Number)
+                   Monitor.Exit(m_Right)
+               Else
+                   Console.WriteLine(Name & " is going to wait")
+                   needDelay = True
+                   GoTo TryAgain
+               End If
+           Finally
+               Console.WriteLine(Name & " put down fork " & m_Left.Number)
+           End Try
+
+           Console.WriteLine(Name & " stood up")
+
+           Thread.Sleep(rnd.Next(0, 10000))
+
+       Loop Until m_Disposed
+   End Sub
+
+End Class

Task/Dining-philosophers/Visual-Basic-.NET/dining-philosophers-6.visual

@@ -0,0 +1,41 @@
+Class WisePhilosopher
+   Inherits PhilosopherBase
+   Public Sub New(ByVal name As String, ByVal right As Fork, ByVal left As Fork)
+       MyBase.New(name, right, left)
+   End Sub
+
+   Public Overrides Sub MainLoop()
+       Do
+           Console.WriteLine(Name & " sat down")
+
+           Dim first As Fork, second As Fork
+           If m_Left.Number > m_Right.Number Then
+               first = m_Left
+               second = m_Right
+           Else
+               first = m_Right
+               second = m_Left
+           End If
+
+           SyncLock first
+               Console.WriteLine(Name & " picked up fork " & m_Left.Number)
+
+               SyncLock second
+                   Console.WriteLine(Name & " picked up fork " & m_Right.Number)
+
+                   Console.WriteLine(Name & " ate!!!!")
+
+                   Console.WriteLine(Name & " put down fork " & m_Right.Number)
+               End SyncLock
+
+
+               Console.WriteLine(Name & " put down fork " & m_Left.Number)
+           End SyncLock
+
+           Console.WriteLine(Name & " stood up")
+
+           Thread.Sleep(rnd.Next(0, 10000))
+       Loop Until m_Disposed
+   End Sub
+
+End Class