home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpmult / demo / philo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-07  |  8.6 KB  |  302 lines
  1. {$R-,S-,I-,D-,F-,V-,B-,N-,L- }
  2. {$M 16384,0,655360 }
  3. PROGRAM Philo;
  4.  
  5. { Lösung des Dining-Philosophers-Problems
  6.  
  7.   Stand: 01/89
  8.   Autor: Christian Philipps Software-Technik
  9.          Düsseldorfer Str. 316
  10.          4130 Moers 1
  11. }
  12.  
  13. USES {.U-} Crt, CpMulti;
  14.  
  15. TYPE   PhiloStateType = (denkend, hungrig, essend);
  16.  
  17. CONST  Philosophers = 8;
  18.        PhiloPos   : ARRAY[1..Philosophers] OF RECORD
  19.                                                 left, top,
  20.                                                 right, bottom : byte;
  21.                                               END
  22.                   = ((left:35;top:1;right:45;bottom:3),
  23.                      (left:56;top:3;right:66;bottom:5),
  24.                      (left:65;top:9;right:75;bottom:11),
  25.                      (left:56;top:15;right:66;bottom:17),
  26.                      (left:35;top:17;right:45;bottom:19),
  27.                      (left:14;top:15;right:24;bottom:17),
  28.                      (left:5;top:9;right:15;bottom:11),
  29.                      (left:14;top:3;right:24;bottom:5));
  30.  
  31. VAR    PhiloState : ARRAY[1..Philosophers] OF PhiloStateType;
  32.        PhiloSem   : ARRAY[1..Philosophers] OF Pointer;
  33.        Critical   : Pointer;                           {Semaphore}
  34.        Critical1  : Pointer;                           {Semaphore}
  35.        N          : Byte;
  36.  
  37. {-------------------------------------------------------------------}
  38.  
  39. PROCEDURE Normal;
  40.  
  41. BEGIN {Normal}
  42.   TextColor(White);
  43.   TextBackground(Black);
  44. END;  {Normal}
  45.  
  46. {-------------------------------------------------------------------}
  47.  
  48. PROCEDURE NormalBlink;
  49.  
  50. BEGIN {NormalBlink}
  51.   TextColor(White+Blink);
  52.   TextBackground(Black);
  53. END;  {NormalBlink}
  54.  
  55. {-------------------------------------------------------------------}
  56.  
  57. PROCEDURE Reverse;
  58.  
  59. BEGIN {Reverse}
  60.   TextColor(Black);
  61.   TextBackground(White);
  62. END;  {Reverse}
  63.  
  64. {-------------------------------------------------------------------}
  65.  
  66. PROCEDURE Frame (X1,Y1,X2,Y2:BYTE);
  67.  
  68. VAR N : BYTE;
  69.  
  70. BEGIN { Frame }
  71.   GotoXY(X1,Y1);
  72.   Write('╔');
  73.   FOR N := 1 TO X2-X1-1 DO
  74.     Write('═');
  75.   Write('╗');
  76.   FOR N := 1 TO Y2-Y1-1 DO
  77.   BEGIN
  78.     GotoXY(X1,Y1+N);
  79.     Write('║');
  80.     GotoXY(X2,Y1+N);
  81.     Write('║');
  82.   END;
  83.     GotoXY(X1,Y2);
  84.   Write('╚');
  85.   FOR N := 1 TO X2-X1-1 DO
  86.     Write('═');
  87.   Write('╝');
  88. END;  { Frame }
  89.  
  90. {-------------------------------------------------------------------}
  91.  
  92. FUNCTION Left(P:Byte):Byte;
  93.  
  94. { Ermitteln des linken Nachbarn eines Philiosophen }
  95.  
  96. BEGIN {Left}
  97.   IF P = 1
  98.      THEN Left := Philosophers
  99.      ELSE Left := Pred(P);
  100. END;  {Left}
  101.  
  102. {-------------------------------------------------------------------}
  103.  
  104. FUNCTION Right(P:Byte):Byte;
  105.  
  106. { Ermitteln des rechten Nachbarn eines Philiosophen }
  107.  
  108. BEGIN {Right}
  109.   IF P = Philosophers
  110.      THEN Right := 1
  111.      ELSE Right := Succ(P);
  112. END;  {Right}
  113.  
  114. {-------------------------------------------------------------------}
  115.  
  116. PROCEDURE DenkeNach(PhilNo:Byte);
  117.  
  118. { Diese Prozedur wird durchlaufen, wenn ein Philosoph nachdenkt }
  119.  
  120. BEGIN {DenkeNach}
  121.   WITH PhiloPos[PhilNo] DO
  122.   BEGIN
  123.     SemWait(Critical1);
  124.     Normal;
  125.     GotoXY(Succ(Left),Succ(Top));
  126.     Write(' DENK!!! ');
  127.     SemSignal(Critical1);
  128.   END;
  129.   Sleep(Seconds(3));
  130. END;  {DenkeNach}
  131.  
  132. {-------------------------------------------------------------------}
  133.  
  134. PROCEDURE Iss(PhilNo:Byte);
  135.  
  136. { Diese Prozedur wird durchlaufen, wenn ein Philosoph ißt }
  137.  
  138. BEGIN {Iss}
  139.   WITH PhiloPos[PhilNo] DO
  140.   BEGIN
  141.     SemWait(Critical1);
  142.     Reverse;
  143.     GotoXY(Succ(Left),Succ(Top));
  144.     Write(' MAMPF!! ');
  145.     SemSignal(Critical1);
  146.   END;
  147.   Sleep(Seconds(2));
  148. END;  {Iss}
  149.  
  150. {-------------------------------------------------------------------}
  151.  
  152. PROCEDURE Ueberpruefe(PhilNo:Byte);
  153.  
  154. { Überprüfe die Nachbarn des Philosophen, um festzustellen,
  155.   ob die Gabeln frei sind.  Dies ist immer dann der Fall,
  156.   wenn beide Nachbarn gerade nicht essen }
  157.  
  158. BEGIN {Ueberpruefe}
  159.   IF PhiloState[PhilNo] <> hungrig             {wir sind beschäftigt}
  160.      THEN Exit;
  161.  
  162.   IF (PhiloState[Left(PhilNo)]  <> essend) AND
  163.      (PhiloState[Right(PhilNo)] <> essend)
  164.      THEN BEGIN
  165.             PhiloState[PhilNo] := essend;      {O.K. wir können essen}
  166.             SemSignal(PhiloSem[PhilNo]);       {erhöhe Signal-Count}
  167.           END;
  168. END;  {Ueberpruefe}
  169.  
  170. {-------------------------------------------------------------------}
  171.  
  172. PROCEDURE NimmGabeln(PhilNo:Byte);
  173.  
  174. { Aufheben der Gabeln, die rechts und links vom Teller der
  175.   Philosophen liegen.  Ist eine Gabel gerade nicht
  176.   verfügbar, so verfällt der Philosoph in den Wartezustand
  177.   und ist schlicht und ergreifend furchtbar hungrig!  }
  178.  
  179. BEGIN {NimmGabeln}
  180.   SemWait(Critical);                     {kritischen Bereich abriegeln}
  181.   WITH PhiloPos[PhilNo] DO
  182.   BEGIN
  183.     NormalBlink;
  184.     GotoXY(Succ(Left),Succ(Top));
  185.     Write(' HUNGER! ');
  186.     Sleep(Seconds(1) SHR 1);
  187.   END;
  188.   PhiloState[PhilNo] := hungrig;         {wir sind hungrig}
  189.   Ueberpruefe(PhilNo);                   {können wir essen?}
  190.   SemSignal(Critical);                   {kritischen Bereich freigeben}
  191.   SemWait(PhiloSem[PhilNo]);             {wenn nicht, dann warten wir}
  192. END;  {NimmGabeln}
  193.  
  194. {-------------------------------------------------------------------}
  195.  
  196. PROCEDURE LegGabelnHin(PhilNo:Byte);
  197.  
  198. { Ablegen der Gabeln und freigeben der Nachbarn, falls diese
  199.   nun essen können}
  200.  
  201. BEGIN {LegGabelnHin}
  202.   SemWait(Critical);                     {kritischer Bereich}
  203.   PhiloState[PhilNo] := denkend;         {wir denken nun wieder nach}
  204.   Ueberpruefe(Left(PhilNo));             {teste linken Nachbarn}
  205.   Ueberpruefe(Right(PhilNo));            {teste rechten Nachbarn}
  206.   SemSignal(Critical);                   {Ende des kritischen Bereiches}
  207. END;  {LegGabelnHin}
  208.  
  209. {-------------------------------------------------------------------}
  210.  
  211. {$F+}
  212. PROCEDURE Philosoph(P:Pointer);
  213.  
  214. { Der Körper des Philosophen.
  215.   Diese Prozedur demonstriert, daß Turbo-Pascal-Tasks
  216.   prinzipiell sogar im Code-Sharing ablaufen können.
  217.   Voraussetzung ist, daß jeder Philosoph seinen eigenen
  218.   Stack besitzt, und dies ist durch CreateTask
  219.   gewährleistet}
  220.  
  221. VAR MyNo : Byte;
  222.  
  223. BEGIN {Philosoph}
  224.   MyNo := Byte(P);
  225.   WITH PhiloPos[MyNo] DO
  226.   BEGIN
  227.     SemWait(Critical1);
  228.     Normal;
  229.     Frame(left,top,right,bottom);
  230.     GotoXY(Succ(left),Succ(Top));
  231.     Write(' DENK!!! ');
  232.     SemSignal(Critical1);
  233.   END;
  234.   REPEAT                                 {Das Leben eines Philosophen:}
  235.     DenkeNach(MyNo);                     {wir denken ein wenig...}
  236.     NimmGabeln(MyNo);                    {...greifen zum Werkzeug...}
  237.     Iss(MyNo);                           {...essen ein paar Happen...}
  238.     LegGabelnHin(MyNo);                  {...und kommen ins Grübeln.}
  239.   UNTIL False;
  240. END;  {Philosoph}
  241. {$F-}
  242.  
  243. {-------------------------------------------------------------------}
  244.  
  245. PROCEDURE DrawTable;
  246.  
  247. { Aufbau der Anzeige }
  248.  
  249. BEGIN {DrawTable}
  250.   Normal;
  251.   ClrScr;
  252.   Frame(20,6,60,14);
  253.   Window(22,8,58,13);
  254.   Writeln('   The Dining-Philosophers Problem');
  255.   Writeln('      ─────────────────────────');
  256.   Writeln('           (Dijkstra 1965)'^J);
  257.   Writeln('   Autor: Christian Philipps  6/88');
  258.   Window(1,20,80,25);
  259.   Writeln('Jeder Philosoph hat einen Teller mit Spaghetti vor sich stehen. Zwischen je');
  260.   Writeln('zwei Tellern liegt eine Gabel. Nun benötigt jeder Philosoph zwei Gabeln, wenn');
  261.   Writeln('er von seinen schlüpfrigen Spaghetti essen möchte!! - That''s it!');
  262.   Writeln('Ein Philosoph denkt je 3 Sekunden und ißt je 2 Sekunden. Die Übergangsphase');
  263.   Write  ('(Hungern) ist zu Demonstrationszwecken mindestens 1/2 Sekunde lang!');
  264.   Window(1,1,80,25);
  265. END;  {DrawTable}
  266.  
  267. {-------------------------------------------------------------------}
  268.  
  269. BEGIN {Main}
  270.   DrawTable;
  271.   IF CreateSem(Critical) <> Sem_Ok
  272.      THEN BEGIN
  273.             Writeln('Fehler beim Erzeugen der Critical-Semaphore');
  274.             Halt;
  275.           END;
  276.   IF CreateSem(Critical1) <> Sem_Ok
  277.      THEN BEGIN
  278.             Writeln('Fehler beim Erzeugen der Critical-Semaphore 1');
  279.             Halt;
  280.           END;
  281.   FOR N := 1 TO Philosophers DO
  282.   BEGIN
  283.     PhiloState[n] := denkend;
  284.     IF CreateSem(PhiloSem[n]) <> Sem_Ok
  285.        THEN BEGIN
  286.               Writeln('Fehler beim Erzeugen der Semaphore: ',n);
  287.               Halt;
  288.             END
  289.        ELSE SemClear(PhiloSem[n]);
  290.   END;
  291.   FOR N := 1 TO Philosophers DO
  292.     IF CreateTask(Philosoph,Pointer(n),Pri_User,500) < 0
  293.        THEN BEGIN
  294.               Writeln('Fehler beim Erzeugen des Philosophen: ',n);
  295.               Halt;
  296.             END;
  297.   REPEAT
  298.     Sleep(Seconds(1));
  299.   UNTIL KeyPressed;
  300.   Normal;
  301. END.  {Main}
  302.