Надежное программирование в разрезе языков. Часть 2 — Претенденты02.03.2019 22:47

MODULE Philo;
(* Dining Philosophers Example from Active Oberon Language Report by Patrik Reali *)
(* Adapted for running in AOS by Siemargl *)


IMPORT Semaphores :=  Example8, Out;

CONST
        NofPhilo = 5; (* number of philosophers *)
        
VAR
        fork: ARRAY NofPhilo OF Semaphores.Semaphore;
        i: LONGINT;
        
TYPE
        Philosopher = OBJECT
                VAR
                        first, second: LONGINT;
                        (* forks used by this philosopher *)

                PROCEDURE & Init(id: LONGINT);
                BEGIN
                        IF id # NofPhilo-1 THEN
                                first := id; second := (id+1)
                        ELSE
                                first := 0; second := NofPhilo-1
                        END
                END Init;
                
                PROCEDURE Think;  (* Need lock console output *)
                BEGIN {EXCLUSIVE}
                        Out.Int(first); Out.String(".... Think....");   Out.Ln;
                END Think;

                PROCEDURE Eat;
                BEGIN {EXCLUSIVE}
                        Out.Int(first); Out.String(".... Eat....");     Out.Ln;
                END Eat;

                
        BEGIN {ACTIVE}
                LOOP
                        Think;
                        fork[first].P; fork[second].P;
                        
                        Eat;
                        fork[first].V; fork[second].V
                END
        END Philosopher;
        
VAR
        philo: ARRAY NofPhilo OF Philosopher;
        
BEGIN
        FOR i := 0 TO NofPhilo DO
                NEW(fork[i], INTEGER(i));
                NEW(philo[i], i);
        END;
END Philo.

Philo.Philo1 ~

-- Code from https://rosettacode.org/wiki/Dining_philosophers#Ordered_mutexes
-- ADA95 compatible so can run in ideone.com

with Ada.Numerics.Float_Random;  use Ada.Numerics.Float_Random;
with Ada.Text_IO;                use Ada.Text_IO;
 
procedure Test_Dining_Philosophers is
   type Philosopher is (Aristotle, Kant, Spinoza, Marx, Russel);
   protected type Fork is
      entry Grab;
      procedure Put_Down;
   private
      Seized : Boolean := False;
   end Fork;
   protected body Fork is
      entry Grab when not Seized is
      begin
         Seized := True;
      end Grab;
      procedure Put_Down is
      begin
         Seized := False;
      end Put_Down;
   end Fork;
 
   Life_Span : constant := 20;    -- In his life a philosopher eats 20 times
 
   task type Person (ID : Philosopher; First, Second : not null access Fork);
   task body Person is
      Dice : Generator;
   begin
      Reset (Dice);
      for Life_Cycle in 1..Life_Span loop
         Put_Line (Philosopher'Image (ID) & " is thinking");
         delay Duration (Random (Dice) * 0.100);
         Put_Line (Philosopher'Image (ID) & " is hungry");
         First.Grab;
         Second.Grab;
         Put_Line (Philosopher'Image (ID) & " is eating");
         delay Duration (Random (Dice) * 0.100);
         Second.Put_Down;
         First.Put_Down;
      end loop;
      Put_Line (Philosopher'Image (ID) & " is leaving");
   end Person;
 
   Forks : array (1..5) of aliased Fork; -- Forks for hungry philosophers
                                         -- Start philosophers
   Ph_1 : Person (Aristotle, Forks (1)'Access, Forks (2)'Access);
   Ph_2 : Person (Kant,      Forks (2)'Access, Forks (3)'Access);
   Ph_3 : Person (Spinoza,   Forks (3)'Access, Forks (4)'Access);
   Ph_4 : Person (Marx,      Forks (4)'Access, Forks (5)'Access);
   Ph_5 : Person (Russel,    Forks (1)'Access, Forks (5)'Access);
begin
   null; -- Nothing to do in the main task, just sit and behold
end Test_Dining_Philosophers;

// compile dmd -betterC 

import core.sys.windows.windows;
import core.stdc.stdio;
import core.stdc.stdlib : rand;
//import std.typecons; // -impossible (
//import std.string;  - impossible



extern (Windows) alias btex_fptr = void function(void*) /*nothrow*/;
//extern (C) uintptr_t _beginthreadex(void*, uint, btex_fptr, void*, uint, uint*) nothrow;
/* Dining Philosophers example for a habr.com 
*  by Siemargl, 2019
*  BetterC variant. Compile >dmd -betterC Philo_BetterC.d
*/

extern (C) uintptr_t _beginthread(btex_fptr, uint stack_size, void *arglist) nothrow;

alias HANDLE    uintptr_t;
alias HANDLE    Fork;

const philocount = 5;
const cycles = 20;

HANDLE[philocount]  forks;


struct Philosopher
{
    const(char)* name;
    Fork left, right;
    HANDLE lifethread; 
}
Philosopher[philocount]  philos;


extern (Windows) 
void PhilosopherLifeCycle(void* data) nothrow
{
    Philosopher* philo = cast(Philosopher*)data;

    
    for (int age = 0; age++ < cycles;)
    {
        printf("%s is thinking\n", philo.name);
        Sleep(rand() % 100);
        printf("%s is hungry\n", philo.name);

        WaitForSingleObject(philo.left, INFINITE);
        WaitForSingleObject(philo.right, INFINITE);

        printf("%s is eating\n", philo.name);
        Sleep(rand() % 100);
        ReleaseMutex(philo.right);
        ReleaseMutex(philo.left);
    }

    printf("%s is leaving\n", philo.name);
}

extern (C) int main() 
{
    version(Windows){} else { static assert(false, "OS not supported"); }

    philos[0] = Philosopher ("Aristotlet".ptr, forks[0], forks[1], null);
    philos[1] = Philosopher ("Kant".ptr, forks[1], forks[2], null);
    philos[2] = Philosopher ("Spinoza".ptr, forks[2], forks[3], null);
    philos[3] = Philosopher ("Marx".ptr, forks[3], forks[4], null);
    philos[4] = Philosopher ("Russel".ptr, forks[0], forks[4], null);

    foreach(ref f; forks)
    {
        f = CreateMutex(null, false, null);
        assert(f);  
    }

    foreach(ref ph; philos)
    {
        ph.lifethread = _beginthread(&PhilosopherLifeCycle, 0, &ph);
        assert(ph.lifethread);  
    }

    foreach(ref ph; philos)
        WaitForSingleObject(ph.lifethread, INFINITE);

    // Close thread and mutex handles
    for( auto i = 0; i < philocount; i++ )
    {
        CloseHandle(philos[i].lifethread);
        CloseHandle(forks[i]);
    }
    
    
        return 0;
}

(* Dining Philosophers example for a habr.com 
*  by Siemargl, 2019
*  ISO61131 ST language variant. Must be specialized 4 ur PLC 
* )
CONFIGURATION PLC_1

VAR_GLOBAL
        Forks : USINT;
        Philo_1: Philosopher;  (* Instance block - static vars *)
        Philo_2: Philosopher;
        Philo_3: Philosopher;
        Philo_4: Philosopher;
        Philo_5: Philosopher;
END_VAR

RESOURCE Station_1 ON CPU_1
        TASK Task_1 (INTERVAL := T#100MS, PRIORITY := 1);
        TASK Task_2 (INTERVAL := T#100MS, PRIORITY := 1);
        TASK Task_3 (INTERVAL := T#100MS, PRIORITY := 1);
        TASK Task_4 (INTERVAL := T#100MS, PRIORITY := 1);
        TASK Task_5 (INTERVAL := T#100MS, PRIORITY := 1);

        PROGRAM Life_1 WITH Task_1: 
                Philo_1(Name := 'Kant', 0, 1, Forks);
        PROGRAM Life2 WITH Task_2: 
                Philo_2(Name := 'Aristotel', 1, 2, Forks);
        PROGRAM Life3 WITH Task_3: 
                Philo_3(Name := 'Spinoza', 2, 3, Forks);
        PROGRAM Life4 WITH Task_4: 
                Philo_4(Name := 'Marx', 3, 4, Forks);
        PROGRAM Life5 WITH Task_5: 
                Philo_5(Name := 'Russel', 4, 0, Forks);

END_RESOURCE

END_CONFIGURATION

FUNCTION_BLOCK Philosopher;
USING SysCpuHandling.library;
VAR_INPUT
        Name: STRING;
        Left: UINT; 
        Right: UINT;
END_VAR
VAR_IN_OUT
        Forks: USINT;
END_VAR
VAR
        Thinking:       BOOL := TRUE;  (* States *)
        Hungry: BOOL;
        Eating: BOOL;
        
        HaveLeftFork:   BOOL;
        TmThink:        TON;
        TmEating:       TON;
END_VAR
        TmThink(In := Thinking; PT := T#3s);
        TmEating(In := Eating; PT := T#5s);
        IF Thinking THEN  (* Just waiting Timer *)
                Thinking := NOT TmThink.Q;
                Hungry := TmThink.Q;
        ELSIF Hungry (* Try Atomic Lock Forks *)
                IF HaveLeftFork 
                        IF SysCpuTestAndSetBit(Address := Forks, Len := 1, iBit := Right, bSet := 1) = ERR_OK THEN
                                Hungry := FALSE;
                                Eating := TRUE;
                        ELSE
                                RETURN;
                        END_IF
                ELSIF
                        IF SysCpuTestAndSetBit(Address := Forks, Len := 1, iBit := Left, bSet := 1) = ERR_OK THEN
                                HaveLeftFork := TRUE; 
                        ELSE
                                RETURN;
                        END_IF
                END_IF
        ELSIF Eating  (* Waiting Timer, then lay forks *)
                IF TmEating.Q THEN
                        Thinking := TRUE;
                        Eating := FALSE;
                        HaveLeftFork := FALSE;
                        SysCpuTestAndSetBit(Address := Forks, Len := 1, iBit := Right, bSet := 0);
                        SysCpuTestAndSetBit(Address := Forks, Len := 1, iBit := Left, bSet := 0);
                END_IF
        END_IF
END_FUNCTION_BLOCK

/* Dining Philosophers example for a habr.com 
*  by Siemargl, 2019
*  Safe-C variant. Compile >mk.exe philosafec.c
*/

from std use console, thread, random;

enum philos (ushort) { Aristotle, Kant, Spinoza, Marx, Russell, };
const int cycles = 10;
const ushort NUM = 5;
uint  lived = NUM;


packed struct philosopher // 32-bit
{
        philos  name;
        byte left, right;
}

philosopher philo_body[NUM];

SHARED_OBJECT forks[NUM];

void philosopher_life(philosopher philo) 
{
        int age;
    for (age = 0; age++ < cycles; )
    {
        printf("%s is thinking\n", philo.name'string);
        delay((uint)rnd(1, 100));
        printf("%s is hungry\n", philo.name'string);

                enter_shared_object(ref forks[philo.left]);
                enter_shared_object(ref forks[philo.right]);

        printf("%s is eating\n", philo.name'string);
        delay((uint)rnd(1, 100));

                leave_shared_object(ref forks[philo.right]);
                leave_shared_object(ref forks[philo.left]);
    }

    printf("%s is leaving\n", philo.name'string);
    InterlockedExchange(ref lived, lived-1);
}


void main()
{
        philos i;

        assert philosopher'size == 4;
        philo_body[0] = {Aristotle, 0, 1};
        philo_body[1] = {Kant, 1, 2};
        philo_body[2] = {Spinoza, 2, 3};
        philo_body[3] = {Marx, 3, 4};
        philo_body[4] = {Russell, 0, 4};
        
        for (i = philos'first; i <= philos'last; i++)
        {
                assert run philosopher_life(philo_body[(uint)i]) == 0;
        }

        while (lived > 0) sleep 0; // until all dies

        for (i = philos'first; i <= philos'last; i++)
        {
                destroy_shared_object(ref forks[(uint)i]);
        }
}