home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / library / tasking / diningph.mod < prev    next >
Text File  |  1986-07-22  |  6KB  |  226 lines

  1. MODULE DiningPhilosophers; (* test for time slicing and locks *)
  2.   (*
  3.     WARNING: Do not use ctrl-break on this program while it is running.
  4.       If you do, DOS may crash!
  5.       To stop this program, press any (normal) key and wait for the
  6.       program to terminate normally. It may take quite a while
  7.       if you are running many tasks.
  8.   *)
  9.  
  10.   FROM RandomNumbers IMPORT irand;
  11.   FROM Tasks IMPORT NewTask, NextTask;
  12.   FROM Locks IMPORT LockType, BusyLock, Lock, Unlock;
  13.   FROM DOSlock IMPORT LockDOS, UnlockDOS;
  14.   FROM ClockUtilities IMPORT TimeDifference;
  15.   FROM TimeDate IMPORT Time, GetTime;
  16.   FROM GetPSP IMPORT getarg;
  17.   FROM NumberConversion IMPORT CardToString, StringToCard;
  18.   FROM ScreenBIOS IMPORT WriteChDTD, ClearScreen, PutCursor, current;
  19.   FROM BIOSKeyboard IMPORT Check, Read;
  20.  
  21.   CONST
  22.     maxThinkers = 99;
  23.     wspSize = 1000; (* work space size (bytes) *)
  24.  
  25.   VAR
  26.     numThinkers: CARDINAL;
  27.     forks: ARRAY [1 .. maxThinkers] OF LockType;
  28.     realLock: LockType; (* IOTRANSFER does not save the state of the 8087 *)
  29.     screenLock: LockType;
  30.  
  31.   PROCEDURE thinker; (* main proc for the thinkers processes *)
  32.     VAR
  33.       id: CARDINAL;
  34.     BEGIN
  35.       getid(id);
  36.       LOOP (* forever *)
  37.         msg(id, "think ");
  38.         think;
  39.     msg(id, "hungry");
  40.     getforks(id);
  41.     msg(id, "eat   ");
  42.     eat;
  43.     msg(id, "full  ");
  44.     dropforks(id);
  45.       END;
  46.     END thinker;
  47.  
  48.   (*
  49.     Critical section to assign task id numbers.
  50.   *)
  51.   VAR
  52.     idlock: LockType;
  53.     idnums: CARDINAL;
  54.  
  55.   PROCEDURE getid(VAR idnum: CARDINAL);
  56.     BEGIN
  57.       Lock(idlock);
  58.       INC(idnums);
  59.       idnum := idnums;
  60.       Unlock(idlock);
  61.     END getid;
  62.  
  63.   PROCEDURE think;
  64.     (* think for 2.0 to 10.0 seconds *)
  65.     VAR
  66.       thinktime: REAL;
  67.     BEGIN
  68.       Lock(realLock);
  69.       thinktime := FLOAT(rand(800) + 200) / 100.0;
  70.       Unlock(realLock);
  71.       pause(thinktime);
  72.     END think;
  73.  
  74.   PROCEDURE eat;
  75.     (* eat for 2.0 to 10.0 seconds *)
  76.     VAR
  77.       eattime: REAL;
  78.     BEGIN
  79.       Lock(realLock);
  80.       eattime := FLOAT(rand(800) + 200) / 100.0;
  81.       Unlock(realLock);
  82.       pause(eattime);
  83.     END eat;
  84.  
  85.   PROCEDURE getforks(id: CARDINAL);
  86.     BEGIN
  87.       LOOP
  88.         Lock(forks[id]);
  89.     (* BusyLock returns TRUE if the lock was already locked *)
  90.     IF BusyLock(forks[id MOD numThinkers + 1]) THEN
  91.       Unlock(forks[id])
  92.     ELSE
  93.       EXIT
  94.     END;
  95.     Lock(forks[id MOD numThinkers + 1]);
  96.     IF BusyLock(forks[id]) THEN
  97.       Unlock(forks[id MOD numThinkers + 1])
  98.     ELSE
  99.       EXIT
  100.     END;
  101.       END;
  102.     END getforks;
  103.  
  104.   PROCEDURE dropforks(id: CARDINAL);
  105.     BEGIN
  106.       Unlock(forks[id]);
  107.       Unlock(forks[id MOD numThinkers + 1]);
  108.     END dropforks;
  109.  
  110.   PROCEDURE pause(secs: REAL);
  111.     VAR
  112.       strt, now: Time;
  113.       itsdone: BOOLEAN;
  114.     BEGIN
  115.       GetTimeX(strt);
  116.       REPEAT
  117.         NextTask;
  118.         GetTimeX(now);
  119.     Lock(realLock);
  120.     itsdone := TimeDifference(strt, now) >= secs;
  121.     Unlock(realLock);
  122.       UNTIL itsdone;
  123.     END pause;
  124.  
  125.   (* random number generator is a non-reentrant critical section too *)
  126.   (* think about it! *)
  127.   VAR
  128.     randlock: LockType;
  129.  
  130.   PROCEDURE rand(lim: CARDINAL): CARDINAL;
  131.     VAR
  132.       retval: CARDINAL;
  133.     BEGIN
  134.       Lock(randlock);
  135.       retval := irand(lim);
  136.       Unlock(randlock);
  137.       RETURN retval;
  138.     END rand;
  139.  
  140.   (*
  141.     MS-DOS is very non-reentrant.
  142.     You can't even read the clock and write to the screen at the same time
  143.     since both are devices and the device handler handler is non-reentrant
  144.   *)
  145.   PROCEDURE GetTimeX(VAR t: Time);
  146.     BEGIN
  147.       LockDOS;
  148.       GetTime(t);
  149.       UnlockDOS;
  150.     END GetTimeX;
  151.  
  152.   PROCEDURE msgn(id: CARDINAL);
  153.     VAR
  154.       nstr: ARRAY [0 .. 10] OF CHAR;
  155.     BEGIN
  156.       CardToString(id, nstr, 5);
  157.       Lock(screenLock);
  158.       PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20, 0);
  159.       WriteString(nstr);
  160.       Unlock(screenLock);
  161.     END msgn;
  162.  
  163.   PROCEDURE msg(id: CARDINAL; str: ARRAY OF CHAR);
  164.     BEGIN
  165.       Lock(screenLock);
  166.       PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20 + 7, 0);
  167.       WriteString(str);
  168.       Unlock(screenLock);
  169.     END msg;
  170.  
  171.   PROCEDURE WriteString(str: ARRAY OF CHAR);
  172.     VAR
  173.       i: CARDINAL;
  174.     BEGIN
  175.       i := 0;
  176.       LOOP
  177.         IF str[i] = 0c THEN EXIT END;
  178.     WriteChDTD(str[i], 7, 0);
  179.     INC(i);
  180.     IF i > HIGH(str) THEN EXIT END;
  181.       END;
  182.     END WriteString;
  183.  
  184.   VAR
  185.     i: CARDINAL;
  186.     ch: CHAR;
  187.     str: ARRAY [0 .. 6] OF CHAR;
  188.     itsdone: BOOLEAN;
  189.  
  190.   BEGIN (* main initialize *)
  191.     ClearScreen(current.attrib);
  192.     (* initialize locks by unlocking them *)
  193.     Unlock(randlock);
  194.     Unlock(idlock);
  195.     Unlock(realLock);
  196.     Unlock(screenLock);
  197.     getarg(1, str);
  198.     StringToCard(str, numThinkers, itsdone);
  199.     IF NOT itsdone OR (numThinkers < 2) OR (numThinkers > maxThinkers) THEN
  200.       numThinkers := 5;
  201.     END;
  202.     FOR i := 1 TO numThinkers DO (* initialize the forks locks *)
  203.       Unlock(forks[i]);
  204.     END;
  205.     idnums := 0;
  206.     FOR i := 1 TO numThinkers DO (* start up the tasks *)
  207.       msgn(i);
  208.       NewTask(thinker, wspSize);
  209.       REPEAT (* optional *)
  210.         NextTask;
  211.     Lock(idlock);
  212.     itsdone := i = idnums;
  213.     Unlock(idlock);
  214.       UNTIL itsdone;
  215.     END;
  216.     REPEAT (* Main process loop. Doesn't look like it does much eh? *)
  217.       NextTask;
  218.       Check(ch, ch, itsdone);
  219.     UNTIL itsdone;
  220.     (* get DOSlock, termination is a DOS function too! *)
  221.     LockDOS;
  222.     Read(ch, ch); (* gobble up the pressed key *)
  223.     Lock(screenLock);
  224.     ClearScreen(current.attrib);
  225.   END DiningPhilosophers.
  226.