home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / mtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-28  |  3.4 KB  |  131 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. MTEST.PAS  (Program for testing message-passing)
  6.  
  7. This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
  8. 5.0 or later.
  9.  
  10. January 1994
  11.  
  12. Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
  13. Hypermetrics                    Christian Philipps Software-Technik
  14. PO Box 9700 Suite 363           Duesseldorfer Str. 316
  15. Austin, TX  78758-9700          D-47447 Moers
  16.                                 Germany
  17.  
  18. This demo illustrates the most basic use of the message-passing
  19. functions of the CPMulti kernel.
  20.  
  21. ---------------------------------------------------------------------------}
  22.  
  23. program MTest;
  24.  
  25. uses Dos, Crt, CpMulti;
  26.  
  27. var MessageBuffer : String;
  28.     SubNo         : TaskNoType;
  29.     BeepNo        : TaskNoType;
  30.  
  31. {-----------------------------------------------------------------------------}
  32.  
  33. procedure TaskMsgOut(Txt : string);
  34.  
  35. { Safe output of a string. }
  36.  
  37. begin
  38.   BindCPU;
  39.   Writeln(txt);
  40.   ReleaseCPU;
  41. end;
  42.  
  43. {-----------------------------------------------------------------------------}
  44.  
  45. {$F+}
  46. procedure Beep(P:Pointer);
  47.  
  48. { First subtask. }
  49.  
  50. begin
  51.   repeat
  52.     Sound(200);
  53.     Delay(5);
  54.     NoSound;
  55.   until Keypressed;
  56.  
  57.   TaskMsgOut('Beep: Sending to SubTask...');
  58.   if Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK then
  59.     Writeln('Beep: Receive status not OK.')
  60.   else
  61.     Writeln('Beep: Message was received correctly!');
  62.  
  63.   TaskMsgOut('Beep: Terminating the demo...');
  64.   Terminate;
  65. end;
  66.  
  67. {-----------------------------------------------------------------------------}
  68.  
  69. procedure SubTask(P:Pointer);
  70.  
  71. { Second subtask. }
  72.  
  73. var Message : String;
  74.  
  75. begin
  76.   TaskMsgOut('SubTask: Started! - Sleeping for 5 seconds!');
  77.   Sleep(Seconds(5));
  78.  
  79.   TaskMsgOut('SubTask: Attempting to Receive with Wait...');
  80.   if Receive(BeepNo,@Message,Wait) <> Task_OK then
  81.     TaskMsgOut('SubTask: Error in Receive!')
  82.   else 
  83.     TaskMsgOut('SubTask: Received: '+Message);
  84.  
  85.   TaskMsgOut('SubTask: Getting a message from the sender, if available...');
  86.   if Receive(AnyTask,@Message,NoWait) <> Task_OK then
  87.     TaskMsgOut('SubTask: Error in Receive!')
  88.   else
  89.     TaskMsgOut('SubTask: Received: '+Message);
  90.  
  91.   Writeln('SubTask: Message came from task #',ReceivedFrom);
  92.   TaskMsgOut('SubTask: Terminating...!');
  93.   Terminate;
  94. end;
  95. {$F-}
  96.  
  97. {-----------------------------------------------------------------------------}
  98.  
  99. begin
  100.   ClrScr;
  101.   MessageBuffer := 'This is a message.';
  102.  
  103.   Writeln('MasterTask: Starting the Beep task!');
  104.   BeepNo := CreateTask(Beep,NIL,Pri_User,500);
  105.   if BeepNo < 0 then
  106.     Writeln('MasterTask: Error in creating the Beep task!');
  107.  
  108.   Writeln('MasterTask: Start of SubTask!');
  109.   SubNo := CreateTask(SubTask,NIL,Pri_User,1000);
  110.   if SubNo < 0 then
  111.   begin
  112.     Writeln('MasterTask: Error in creating SubTask!');
  113.     Halt;
  114.   end;
  115.  
  116.   Sleep(Seconds(1));   { Let SubTask become active. }
  117.  
  118.   Writeln('MasterTask: Now we are waiting for receipt of the message.');
  119.   if Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK then
  120.     Writeln('MasterTask: Receive status not OK.')
  121.   else 
  122.     Writeln('MasterTask: Message was received correctly!');
  123.  
  124.   Writeln('MasterTask: Sleeping for 2 seconds...');
  125.   Sleep(Seconds(2));
  126.  
  127.   Writeln('MasterTask: <RETURN> will terminate the demo.');
  128.   Readln;
  129.   NoSound;
  130. end.
  131.