Programmer 7500/MAX_PROGRAMMERS.iso/CLIPPER/MISC/TASKING.ZIP/DININGPH.MOD

Text File | 1986-07-23 | 5.5 KB | 226 lines

MODULE DiningPhilosophers; (* test for time slicing and locks *)
  (*
    WARNING: Do not use ctrl-break on this program while it is running.
      If you do, DOS may crash!
      To stop this program, press any (normal) key and wait for the
      program to terminate normally. It may take quite a while
      if you are running many tasks.
  *)

  FROM RandomNumbers IMPORT irand;
  FROM Tasks IMPORT NewTask, NextTask;
  FROM Locks IMPORT LockType, BusyLock, Lock, Unlock;
  FROM DOSlock IMPORT LockDOS, UnlockDOS;
  FROM ClockUtilities IMPORT TimeDifference;
  FROM TimeDate IMPORT Time, GetTime;
  FROM GetPSP IMPORT getarg;
  FROM NumberConversion IMPORT CardToString, StringToCard;
  FROM ScreenBIOS IMPORT WriteChDTD, ClearScreen, PutCursor, current;
  FROM BIOSKeyboard IMPORT Check, Read;

  CONST
    maxThinkers = 99;
    wspSize = 1000; (* work space size (bytes) *)

  VAR
    numThinkers: CARDINAL;
    forks: ARRAY [1 .. maxThinkers] OF LockType;
    realLock: LockType; (* IOTRANSFER does not save the state of the 8087 *)
    screenLock: LockType;

  PROCEDURE thinker; (* main proc for the thinkers processes *)
    VAR
      id: CARDINAL;
    BEGIN
      getid(id);
      LOOP (* forever *)
        msg(id, "think ");
        think;
    msg(id, "hungry");
    getforks(id);
    msg(id, "eat   ");
    eat;
    msg(id, "full  ");
    dropforks(id);
      END;
    END thinker;

  (*
    Critical section to assign task id numbers.
  *)
  VAR
    idlock: LockType;
    idnums: CARDINAL;

  PROCEDURE getid(VAR idnum: CARDINAL);
    BEGIN
      Lock(idlock);
      INC(idnums);
      idnum := idnums;
      Unlock(idlock);
    END getid;

  PROCEDURE think;
    (* think for 2.0 to 10.0 seconds *)
    VAR
      thinktime: REAL;
    BEGIN
      Lock(realLock);
      thinktime := FLOAT(rand(800) + 200) / 100.0;
      Unlock(realLock);
      pause(thinktime);
    END think;

  PROCEDURE eat;
    (* eat for 2.0 to 10.0 seconds *)
    VAR
      eattime: REAL;
    BEGIN
      Lock(realLock);
      eattime := FLOAT(rand(800) + 200) / 100.0;
      Unlock(realLock);
      pause(eattime);
    END eat;

  PROCEDURE getforks(id: CARDINAL);
    BEGIN
      LOOP
        Lock(forks[id]);
    (* BusyLock returns TRUE if the lock was already locked *)
    IF BusyLock(forks[id MOD numThinkers + 1]) THEN
      Unlock(forks[id])
    ELSE
      EXIT
    END;
    Lock(forks[id MOD numThinkers + 1]);
    IF BusyLock(forks[id]) THEN
      Unlock(forks[id MOD numThinkers + 1])
    ELSE
      EXIT
    END;
      END;
    END getforks;

  PROCEDURE dropforks(id: CARDINAL);
    BEGIN
      Unlock(forks[id]);
      Unlock(forks[id MOD numThinkers + 1]);
    END dropforks;

  PROCEDURE pause(secs: REAL);
    VAR
      strt, now: Time;
      itsdone: BOOLEAN;
    BEGIN
      GetTimeX(strt);
      REPEAT
        NextTask;
        GetTimeX(now);
    Lock(realLock);
    itsdone := TimeDifference(strt, now) >= secs;
    Unlock(realLock);
      UNTIL itsdone;
    END pause;

  (* random number generator is a non-reentrant critical section too *)
  (* think about it! *)
  VAR
    randlock: LockType;

  PROCEDURE rand(lim: CARDINAL): CARDINAL;
    VAR
      retval: CARDINAL;
    BEGIN
      Lock(randlock);
      retval := irand(lim);
      Unlock(randlock);
      RETURN retval;
    END rand;

  (*
    MS-DOS is very non-reentrant.
    You can't even read the clock and write to the screen at the same time
    since both are devices and the device handler handler is non-reentrant
  *)
  PROCEDURE GetTimeX(VAR t: Time);
    BEGIN
      LockDOS;
      GetTime(t);
      UnlockDOS;
    END GetTimeX;

  PROCEDURE msgn(id: CARDINAL);
    VAR
      nstr: ARRAY [0 .. 10] OF CHAR;
    BEGIN
      CardToString(id, nstr, 5);
      Lock(screenLock);
      PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20, 0);
      WriteString(nstr);
      Unlock(screenLock);
    END msgn;

  PROCEDURE msg(id: CARDINAL; str: ARRAY OF CHAR);
    BEGIN
      Lock(screenLock);
      PutCursor((id - 1) MOD 25, (id - 1) DIV 25 * 20 + 7, 0);
      WriteString(str);
      Unlock(screenLock);
    END msg;

  PROCEDURE WriteString(str: ARRAY OF CHAR);
    VAR
      i: CARDINAL;
    BEGIN
      i := 0;
      LOOP
        IF str[i] = 0c THEN EXIT END;
    WriteChDTD(str[i], 7, 0);
    INC(i);
    IF i > HIGH(str) THEN EXIT END;
      END;
    END WriteString;

  VAR
    i: CARDINAL;
    ch: CHAR;
    str: ARRAY [0 .. 6] OF CHAR;
    itsdone: BOOLEAN;

  BEGIN (* main initialize *)
    ClearScreen(current.attrib);
    (* initialize locks by unlocking them *)
    Unlock(randlock);
    Unlock(idlock);
    Unlock(realLock);
    Unlock(screenLock);
    getarg(1, str);
    StringToCard(str, numThinkers, itsdone);
    IF NOT itsdone OR (numThinkers < 2) OR (numThinkers > maxThinkers) THEN
      numThinkers := 5;
    END;
    FOR i := 1 TO numThinkers DO (* initialize the forks locks *)
      Unlock(forks[i]);
    END;
    idnums := 0;
    FOR i := 1 TO numThinkers DO (* start up the tasks *)
      msgn(i);
      NewTask(thinker, wspSize);
      REPEAT (* optional *)
        NextTask;
    Lock(idlock);
    itsdone := i = idnums;
    Unlock(idlock);
      UNTIL itsdone;
    END;
    REPEAT (* Main process loop. Doesn't look like it does much eh? *)
      NextTask;
      Check(ch, ch, itsdone);
    UNTIL itsdone;
    (* get DOSlock, termination is a DOS function too! *)
    LockDOS;
    Read(ch, ch); (* gobble up the pressed key *)
    Lock(screenLock);
    ClearScreen(current.attrib);
  END DiningPhilosophers.