home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / filosoof / semaphor.mod < prev   
Text File  |  1996-01-04  |  3KB  |  127 lines
  1. (********************************************************************
  2.   SEMAPHOR.MOD   
  3.  
  4.   Copyright (c) 1995 by Johan Terryn (CompuServe 100421,3024)
  5. *********************************************************************)
  6.  
  7. IMPLEMENTATION MODULE Semaphore;
  8. FROM   InOut       IMPORT   WriteLn, WriteString;
  9. FROM   Queue       IMPORT   define, empty, insert, makeempty,
  10.                             queue, remove;
  11. FROM   SYSTEM      IMPORT   ADDRESS, NEWPROCESS, TRANSFER;
  12. FROM   Storage     IMPORT   ALLOCATE;
  13.  
  14. TYPE SIGNAL = POINTER TO semaphore;
  15.      semaphore = RECORD
  16.        value : CARDINAL;
  17.        procs : queue
  18.      END;
  19.      ProcessId = POINTER TO ADDRESS;
  20.  
  21.  
  22. VAR readyqueue : queue;
  23.     activeprocess : CARDINAL;
  24.  
  25. PROCEDURE Init( VAR s:SIGNAL);
  26.  
  27. BEGIN
  28.   NEW(s);
  29.   s^.value := 0;
  30.   define(s^.procs);
  31.   makeempty(s^.procs);
  32. END Init;
  33.  
  34. PROCEDURE VSem( VAR s:SIGNAL);
  35.  VAR prevproc : ProcessId;
  36.  
  37.   BEGIN
  38.     IF NOT empty(s^.procs) THEN
  39.       insert(readyqueue,currentprocess);
  40.       prevproc := currentprocess;
  41.       remove(s^.procs,currentprocess);
  42.       TRANSFER(prevproc^,currentprocess^)
  43.     ELSE
  44.       INC(s^.value);
  45.       IF NOT empty(readyqueue) THEN
  46.         insert(readyqueue,currentprocess);
  47.         prevproc := currentprocess;
  48.         remove(readyqueue,currentprocess);
  49.         TRANSFER(prevproc^,currentprocess^)
  50.       END
  51.     END
  52. END VSem;
  53.  
  54. PROCEDURE PSem( VAR s:SIGNAL);
  55.  
  56.  VAR prevproc : ProcessId;
  57.  
  58. BEGIN
  59.   IF s^.value > 0 THEN
  60.     DEC(s^.value)
  61.   ELSIF NOT empty(readyqueue) THEN
  62.     insert(s^.procs,currentprocess);
  63.     prevproc := currentprocess;
  64.     remove(readyqueue,currentprocess);
  65.     TRANSFER(prevproc^,currentprocess^)
  66.   ELSE
  67.     WriteString("Deadlock !!!!");
  68.     WriteLn;
  69.   END
  70. END PSem;
  71.  
  72. PROCEDURE Waiting( VAR s:SIGNAL): BOOLEAN;
  73.  
  74. BEGIN
  75.   RETURN NOT empty(s^.procs)
  76. END Waiting;
  77.  
  78. PROCEDURE StartP(p : PROC; wssize : CARDINAL);
  79.  
  80. VAR workspace : ADDRESS;
  81.     prevproc  : ProcessId;
  82.  
  83. BEGIN
  84.   ALLOCATE(workspace,wssize);
  85.   INC(activeprocess);
  86.   insert(readyqueue,currentprocess);
  87.   prevproc := currentprocess;
  88.   NEW(currentprocess);
  89.   NEWPROCESS(p,workspace,wssize,currentprocess^);
  90.   TRANSFER(prevproc^,currentprocess^);
  91.  
  92. END StartP;
  93.  
  94. PROCEDURE TermP;
  95.  
  96. VAR prevproc : ProcessId;
  97. BEGIN
  98.   DEC(activeprocess);
  99.   IF (activeprocess=0) AND NOT empty(Idle^.procs) THEN
  100.     remove(Idle^.procs,prevproc);
  101.     insert(readyqueue,prevproc);
  102.   END;
  103.   IF NOT empty(readyqueue) THEN
  104.     prevproc := currentprocess;
  105.     remove(readyqueue,currentprocess);
  106.     TRANSFER(prevproc^,currentprocess^);
  107.   ELSE
  108.     WriteString("Deadlock !!!!");WriteLn;
  109.   END
  110. END TermP;
  111.  
  112. PROCEDURE equal (p1,p2 : ProcessId):BOOLEAN;
  113.  
  114.  
  115.  BEGIN
  116.    RETURN p1= p2
  117. END equal;
  118.  
  119. BEGIN
  120.   Init(Idle);
  121.   define(readyqueue);
  122.   makeempty(readyqueue);
  123.   Null := NIL;
  124.   NEW(currentprocess);
  125.   activeprocess := 0;
  126. END Semaphore.
  127.