home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / MODULA2 / PROCON.MOD < prev    next >
Text File  |  2000-06-30  |  2KB  |  58 lines
  1. (*
  2.  *    Producer/Consumer Test Module
  3.  *
  4.  *    This module tests the WAIT and SEND functions
  5.  *    found in the Processes module and is adapted
  6.  *    from code found on page 346 of Advanced Modula-2
  7.  *    by Herber Schildt available from McGraw-Hill.
  8.  *
  9.  *)
  10.  
  11. MODULE ProCon;
  12.  
  13. FROM Terminal IMPORT WriteLn,WriteString;
  14. FROM SYSTEM IMPORT WORD,PROCESS,ADR,NEWPROCESS,TRANSFER;
  15. FROM Processes IMPORT WAIT,SEND,StartProcess,Init,SIGNAL;
  16.  
  17. VAR
  18.   buf: ARRAY[0..100] OF CHAR;
  19.   S: SIGNAL;
  20.  
  21. PROCEDURE Consumer;
  22. BEGIN
  23.   LOOP
  24.     WriteString("waiting"); (* This portion of the loop is *)
  25.     WriteLn;                (* executed only once !!!      *)
  26.     WAIT(S);            (* Wait for characters from buffer *)
  27.     WriteLn;                (* Subsequent SEND's cause looping on the *)
  28.     WriteString(buf);       (* WAIT rather than going to the statement *)
  29.   END;                      (* after the LOOP? is it a bug or the way its *)
  30. END Consumer;               (* supposed to work? *)
  31.  
  32. PROCEDURE Producer;
  33. VAR
  34.   count: CARDINAL;
  35.   ch: CHAR;
  36.  
  37. BEGIN
  38.   count := 0;
  39.   LOOP
  40.     READ(ch);                   (* Clear character buffer *)
  41.     IF (ch <> CHR(13)) AND (count < 99) THEN
  42.       buf[count] := ch;
  43.       WRITE(ch);
  44.       INC(count);
  45.     ELSE
  46.       buf[count] := CHR(0);    (* Null terminator *)
  47.       count := 0;
  48.       SEND(S);
  49.     END;
  50.   END;
  51. END Producer;
  52.  
  53. BEGIN
  54.   Init(S);
  55.   StartProcess(Consumer,1000);
  56.   Producer;
  57.   
  58. END ProCon.