langs a-z

Task/Atomic-updates/Oz/atomic-updates-1.oz

@@ -0,0 +1,98 @@
+declare
+  %%
+  %% INIT
+  %%
+  NBuckets = 100
+  StartVal = 50
+  ExpectedSum = NBuckets * StartVal
+
+  %% Makes a tuple and calls Fun for every field
+  fun {Make Label N Fun}
+     R = {Tuple.make Label N}
+  in
+     for I in 1..N do R.I = {Fun} end
+     R
+  end
+
+  Buckets = {Make buckets NBuckets fun {$} {Cell.new StartVal} end}
+  Locks = {Make locks NBuckets Lock.new}
+  LockList = {Record.toList Locks}
+
+  %%
+  %% DISPLAY
+  %%
+  proc {Display}
+     Snapshot = {WithLocks LockList
+                 fun {$}
+                    {Record.map Buckets Cell.access}
+                 end
+                }
+     Sum = {Record.foldL Snapshot Number.'+' 0}
+  in
+     {Print Snapshot}
+     {System.showInfo "  sum: "#Sum}
+     Sum = ExpectedSum %% assert
+  end
+
+  %% Calls Fun with multiple locks locked and returns the result of Fun.
+  fun {WithLocks Ls Fun}
+     case Ls of L|Lr then
+        lock L then
+           {WithLocks Lr Fun}
+        end
+     [] nil then {Fun}
+     end
+  end
+
+  %%
+  %% MANIPULATE
+  %%
+  proc {Smooth I J}
+     Diff = @(Buckets.I) - @(Buckets.J) %% reading without lock: by design
+     Amount = Diff div 4
+  in
+     {Transfer I J Amount}
+  end
+
+  proc {Roughen I J}
+     Amount = @(Buckets.I) div 3 %% reading without lock: by design
+  in
+     {Transfer I J Amount}
+  end
+
+  %% Atomically transfer an amount from From to To.
+  %% Negative amounts are allowed;
+  %% will never make a bucket negative.
+  proc {Transfer From To Amount}
+     if From \= To then
+        %% lock in order (to avoid deadlocks)
+        Smaller = {Min From To}
+        Bigger = {Max From To}
+     in
+        lock Locks.Smaller then
+           lock Locks.Bigger then
+              FromBucket = Buckets.From
+              ToBucket = Buckets.To
+              NewFromValue = @FromBucket - Amount
+              NewToValue = @ToBucket + Amount
+           in
+              if NewFromValue >= 0 andthen NewToValue >= 0 then
+                 FromBucket := NewFromValue
+                 ToBucket := NewToValue
+              end
+           end
+        end
+     end
+   end
+
+  %% Returns a random bucket index.
+  fun {Pick}
+     {OS.rand} mod NBuckets + 1
+  end
+in
+  %%
+  %% START
+  %%
+  thread for do {Smooth {Pick} {Pick}} end end
+  thread for do {Roughen {Pick} {Pick}} end end
+  for do {Display} {Time.delay 50} end

Task/Atomic-updates/Oz/atomic-updates-2.oz

@@ -0,0 +1,7 @@
+buckets(50 50 50 50 50 50 50 50 50 50 ,,,)  sum: 5000
+buckets(24 68 58 43 78 85 43 66 14 48 ,,,)  sum: 5000
+buckets(36 33 59 38 39 23 55 51 43 45 ,,,)  sum: 5000
+buckets(64 32 62 26 50 82 38 70 16 43 ,,,)  sum: 5000
+buckets(51 51 49 50 51 51 51 49 49 49 ,,,)  sum: 5000
+buckets(43 28 27 60 77 41 36 48 72 70 ,,,)  sum: 5000
+...

Task/Atomic-updates/PureBasic/atomic-updates.purebasic

@@ -0,0 +1,84 @@
+#Buckets=9
+#TotalAmount=200
+Global Dim Buckets(#Buckets)
+Global BMutex=CreateMutex()
+Global Quit=#False
+
+Procedure max(x,y)
+  If x>=y:  ProcedureReturn x
+  Else:     ProcedureReturn y
+  EndIf
+EndProcedure
+
+Procedure Move(WantedAmount, From, Dest)
+  Protected RealAmount
+  If from<>Dest
+    LockMutex(BMutex)
+    RealAmount=max(0, Buckets(from)-WantedAmount)
+    Buckets(From)-RealAmount
+    Buckets(Dest)+RealAmount
+    UnlockMutex(BMutex)
+  EndIf
+  ProcedureReturn RealAmount
+EndProcedure
+
+Procedure Level(A,B)
+  Protected i, j, t
+  If A<>B
+    LockMutex(BMutex)
+    t=Buckets(A)+Buckets(B)
+    i=t/2: j=t-i
+    Buckets(A)=i
+    Buckets(B)=j
+    UnlockMutex(BMutex)
+  EndIf
+EndProcedure
+
+Procedure DoInvent(Array A(1))
+  Protected i, sum
+  LockMutex(BMutex)
+  For i=0 To ArraySize(Buckets())
+    A(i)=Buckets(i)
+    sum+A(i)
+  Next i
+  UnlockMutex(BMutex)
+  ProcedureReturn sum
+EndProcedure
+
+Procedure MixingThread(arg)
+  Repeat
+    Move(Random(#TotalAmount),Random(#Buckets),Random(#Buckets))
+  Until Quit
+EndProcedure
+
+Procedure LevelingThread(arg)
+  Repeat
+    Level(Random(#Buckets),Random(#Buckets))
+  Until Quit
+EndProcedure
+
+If OpenWindow(0,0,0,100,150,"Atomic updates",#PB_Window_SystemMenu)
+  Define Thread1=CreateThread(@MixingThread(),0)
+  Define Thread2=CreateThread(@MixingThread(),0)
+  Define i, Event
+  Dim Inventory(#Buckets)
+  ; Set up a small GUI
+  For i=0 To 9
+    TextGadget(i, 0,i*15,50, 15,"Bucket #"+Str(i))
+  Next i
+  TextGadget(10,55,135,40,15,"=")
+  AddWindowTimer(0,0,500)
+  Buckets(0)=#TotalAmount
+  Repeat
+    Event=WaitWindowEvent()
+    If Event=#PB_Event_Timer
+      i=DoInvent(Inventory())
+      SetGadgetText(10,"="+Str(i))
+      For i=0 To #Buckets
+        SetGadgetText(i, Str(Inventory(i)))
+      Next i
+    EndIf
+  Until Event=#PB_Event_CloseWindow
+  Quit=#True  ; Tell threads to shut down
+  WaitThread(Thread1): WaitThread(Thread2)
+EndIf

Task/Atomic-updates/Run-BASIC/atomic-updates.run

@@ -0,0 +1,34 @@
+DIM bucket(10)
+FOR i = 1 TO 10 : bucket(i) = int(RND(0)*100) : NEXT
+
+a = display("       Display:")	' show original array
+a = flatten(a)			' flatten the array
+a = display("       Flatten:")	' show flattened array
+a = transfer(3,5)		' transfer some amount from 3 to 5
+a = display(a;" from 3 to 5:")	' Show transfer array
+end
+
+FUNCTION display(a$)
+  print a$;" ";chr$(9);
+    for i = 1 to 10
+      display = display + bucket(i)
+      print bucket(i);chr$(9);
+    next i
+  print " Total:";display
+END FUNCTION
+
+FUNCTION flatten(f)
+   f1 = int((f / 10) + .5)
+   for i = 1 to 10
+    bucket(i)	= f1
+    f2		= f2 + f1
+   next i
+   bucket(10)	= bucket(10) + f - f2
+END FUNCTION
+
+
+FUNCTION transfer(a1,a2)
+transfer	= int(rnd(0) * bucket(a1))
+bucket(a1)	= bucket(a1) - transfer
+bucket(a2)	= bucket(a2) + transfer
+END FUNCTION