Power-Programmierung/CD1.mdf/pascal/library/dos/multtsk/cpm25d/philo.pas

Pascal/Delphi Source File | 1994-04-28 | 8.6 KB | 315 lines

{$I cpmswitc.inc}
{$M 16384,0,655360 }

{--------------------------------------------------------------------------

PHILO.PAS  (Solution to the Dining Philosophers problem)

This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
5.0 or later.

January 1994

Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
Hypermetrics                    Christian Philipps Software-Technik
PO Box 9700 Suite 363           Duesseldorfer Str. 316
Austin, TX  78758-9700          D-47447 Moers
                                Germany

The Dining Philosophers problem is a classic problem in computer
science dealing with resource contention. For a good discussion
of it, see Computer Language magazine, September 1987.

---------------------------------------------------------------------------}

program DiningPhilosophers;

uses {.U-} CRT, CPMulti;

type   PhiloStateType = (Thinking, Hungry, Eating);

const  Philosophers = 8;
       PhiloPos     : array[1..Philosophers] of
                        record
                          left, top,
                          right, bottom : byte;
                        end
                    = ((left:35;top:1;right:45;bottom:3),
                       (left:56;top:3;right:66;bottom:5),
                       (left:65;top:9;right:75;bottom:11),
                       (left:56;top:15;right:66;bottom:17),
                       (left:35;top:17;right:45;bottom:19),
                       (left:14;top:15;right:24;bottom:17),
                       (left:5;top:9;right:15;bottom:11),
                       (left:14;top:3;right:24;bottom:5));

var    PhiloState : array[1..Philosophers] of PhiloStateType;
       PhiloSem   : array[1..Philosophers] of Pointer;
       Critical   : Pointer;                           { Semaphores }
       Critical1  : Pointer;
       N          : Byte;

{-------------------------------------------------------------------}

procedure Normal;
begin
  TextColor(White);
  TextBackground(Black);
end;

{-------------------------------------------------------------------}

procedure NormalBlink;
begin
  TextColor(White+Blink);
  TextBackground(Black);
end;

{-------------------------------------------------------------------}

procedure Reverse;
begin
  TextColor(Black);
  TextBackground(White);
end;

{-------------------------------------------------------------------}

procedure Frame (X1,Y1,X2,Y2:Byte);
var N : Byte;
begin
  GotoXY(X1,Y1);
  Write('╔');
  for N := 1 to X2-X1-1 do
    Write('═');
  Write('╗');
  for N := 1 to Y2-Y1-1 do
  begin
    GotoXY(X1,Y1+N);
    Write('║');
    GotoXY(X2,Y1+N);
    Write('║');
  end;
    GotoXY(X1,Y2);
  Write('╚');
  for N := 1 to X2-X1-1 do
    Write('═');
  Write('╝');
end;

{-------------------------------------------------------------------}

function Left(P:Byte):Byte;

{ Determine the left neighbor of a philosopher. }

begin
  if P = 1 then
    Left := Philosophers
  else
    Left := Pred(P);
end;

{-------------------------------------------------------------------}

function Right(P:Byte):Byte;

{ Determine the right neighbor of a philosopher. }

begin
  if P = Philosophers then
    Right := 1
  else
    Right := Succ(P);
end;

{-------------------------------------------------------------------}

procedure Contemplate(PhilNo:Byte);

{ This procedure is run when a philosopher thinks. }

begin
  with PhiloPos[PhilNo] do
  begin
    SemWait(Critical1);
    Normal;
    GotoXY(Succ(Left),Succ(Top));
    Write(' Think!! ');
    SemSignal(Critical1);
  end;
  Sleep(Seconds(3));
end;

{-------------------------------------------------------------------}

procedure Eat(PhilNo:Byte);

{ This procedure is run when a philosopher eats. }

begin
  with PhiloPos[PhilNo] do
  begin
    SemWait(Critical1);
    Reverse;
    GotoXY(Succ(Left),Succ(Top));
    Write(' Slurp!! ');
    SemSignal(Critical1);
  end;
  Sleep(Seconds(2));
end;

{-------------------------------------------------------------------}

procedure Check(PhilNo:Byte);

{ Check each neighbor of the philosopher, in order to determine
  whether the forks are free. This is always the case when neither
  neighbor is currently eating. }

begin
  if PhiloState[PhilNo] <> Hungry then             { We're busy. }
    Exit;

  if (PhiloState[Left(PhilNo)]  <> Eating) and
     (PhiloState[Right(PhilNo)] <> Eating) then
  begin
    PhiloState[PhilNo] := Eating;      { OK, we can eat.        }
    SemSignal(PhiloSem[PhilNo]);       { Increase signal count. }
  end;
end;

{-------------------------------------------------------------------}

procedure GrabForks(PhilNo:Byte);

{ Pick up the forks lying to the right and left of the
  philosopher's plate.  If a fork is not available,
  the philosopher languishes in the wait-state and is
  seized by terrible hunger!  }

begin
  SemWait(Critical);                     { Critical section. }
  with PhiloPos[PhilNo] do
  begin
    NormalBlink;
    GotoXY(Succ(Left),Succ(Top));
    Write(' Hungry! ');
    Sleep(Seconds(1) shr 1);
  end;
  PhiloState[PhilNo] := Hungry;         { We're hungry. }
  Check(PhilNo);                        { Can we eat??? }
  SemSignal(Critical);                  { Release critical section. }
  SemWait(PhiloSem[PhilNo]);            { If not, let's wait. }
end;

{-------------------------------------------------------------------}

procedure LayForksDown(PhilNo:Byte);

{ Lay down the forks and yield to our neighbor, in case he can
  eat now. }

begin
  SemWait(Critical);                     { Critical section.            }
  PhiloState[PhilNo] := Thinking;        { We're thinking again.        }
  Check(Left(PhilNo));                   { Test left neighbor.          }
  Check(Right(PhilNo));                  { Test right neighbor.         }
  SemSignal(Critical);                   { End of the critical section. }
end;

{-------------------------------------------------------------------}

{$F+}
procedure Philosoph(P:Pointer);

{
  The body of the philosopher task.
  This procedure demonstrates that Turbo Pascal tasks
  are fundamentally able to run while code-sharing.
  The prerequisite is that every philosopher should have
  his own stack; this is guaranteed by CreateTask.
}

var MyNo : Byte;
begin
  MyNo := Byte(P);
  with PhiloPos[MyNo] do
  begin
    SemWait(Critical1);
    Normal;
    Frame(left,top,right,bottom);
    GotoXY(Succ(left),Succ(Top));
    Write(' Think!! ');
    SemSignal(Critical1);
  end;
  repeat                              { The life of a philosopher:      }
    Contemplate(MyNo);                { We think a little...            }
    GrabForks(MyNo);                  { ...reach for our forks...       }
    Eat(MyNo);                        { ...eat a couple of mouthfuls... }
    LayForksDown(MyNo);               { ...and relinquish the forks.    }
  until False;
end;
{$F-}

{-------------------------------------------------------------------}

procedure DrawTable;

{ Set up the demo. }

begin
  Normal;
  ClrScr;
  Frame(20,6,60,14);
  Window(22,8,58,13);
  Writeln('   The Dining Philosophers Problem');
  Writeln('      ─────────────────────────');
  Writeln('           (Dijkstra 1965)'^J);
  Writeln('      Christian Philipps,  6/88');
  Window(1,20,80,25);
  Writeln('Every philosopher has a plate of spaghetti in front of him. Between each');
  Writeln('two plates lies a fork. Every philosopher needs two forks, if he wants');
  Writeln('to eat from his pile of slippery spaghetti...');
  Writeln('A philosopher thinks for 3 seconds and eats for 2 seconds. The transition');
  Write  ('(hunger) is for demonstration purposes at least 1/2 seconds long!');
  Window(1,1,80,25);
end;

{-------------------------------------------------------------------}

begin
  DrawTable;
  if CreateSem(Critical) <> Sem_OK then
  begin
    Writeln('Error in the creation of Critical semaphore!');
    Halt;
  end;
  if CreateSem(Critical1) <> Sem_OK then
  begin
    Writeln('Error in the creation of Critical1 semaphore!');
    Halt;
  end;
  for N := 1 to Philosophers do
  begin
    PhiloState[N] := Thinking;
    if CreateSem(PhiloSem[N]) <> Sem_OK then
    begin
      Writeln('Error in the creation of PhiloSem[',N,']');
      Halt;
    end
    else
      SemClear(PhiloSem[N]);
  end;
  for N := 1 to Philosophers do
    if CreateTask(Philosoph,Pointer(N),Pri_User,500) < 0 then
    begin
      Writeln('Error in the creation of philosopher #',N,'!');
      Halt;
    end;
  repeat
    Sleep(Seconds(1));
  until KeyPressed;
  Normal;
end.