home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / LEXMPSRC.RAR / THREADS.PAS < prev    next >
Pascal/Delphi Source File  |  2000-08-15  |  3KB  |  111 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal for Linux                         █}
  4. {█      Test example for thread handling                 █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1999 Joerg Pleumann                █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. {$S+}
  11.  
  12. (**
  13.  * This program does the following:
  14.  *
  15.  * - It creates a secondary thread in addition to the
  16.  *   main hread. The secondary thread is created in
  17.  *   suspended state.
  18.  *
  19.  * - Both threads call a function ThreadFunc which
  20.  *   basically counts to fifty.
  21.  *
  22.  * - The current counter value of each thread is stored
  23.  *   in the global variable Value, which is a threadvar,
  24.  *   so each thread has its own incarnation of the
  25.  *   variable.
  26.  *
  27.  * - When thread 1 enconters a specific value, it does
  28.  *   something with thread 2:
  29.  *
  30.  *   - Value = 10: thread 2 is started.
  31.  *   - Value = 20: thread 2 is suspended.
  32.  *   - Value = 30: thread 2 is restarted again.
  33.  *   - Value = 40: thread 2 is killed.
  34.  *)
  35.  
  36. program Threads;
  37.  
  38. uses
  39.   VpSysLow;
  40.  
  41. threadvar
  42.   Value: LongInt;
  43.  
  44. function ThreadFunc(Args: Pointer): LongInt;
  45. var
  46.   Loop, Dummy: LongInt;
  47. begin
  48.   WriteLn('Thread function invoked for thread ', GetThreadID, '.');
  49.  
  50.   Value := 1;
  51.  
  52.   while Value <= 50 do
  53.   begin
  54.     WriteLn('- Thread ', GetThreadID, ' has counted to ', Value, '.');
  55.     SysCtrlSleep(100);
  56.  
  57.     if GetThreadID = 1 then
  58.     begin
  59.       if (Value = 10) then
  60.       begin
  61.         WriteLn('Thread 1 starts thread 2.');
  62.         ResumeThread(2);
  63.       end;
  64.  
  65.       if (Value = 20) then
  66.       begin
  67.         WriteLn('Thread 1 suspends thread 2.');
  68.         SuspendThread(2);
  69.       end;
  70.  
  71.       if (Value = 30) then
  72.       begin
  73.         WriteLn('Thread 1 restarts thread 2.');
  74.         ResumeThread(2);
  75.       end;
  76.  
  77.       if (Value = 40) then
  78.       begin
  79.         WriteLn('Thread 1 kills thread 2.');
  80.         KillThread(2);
  81.       end;
  82.     end;
  83.  
  84.     Inc(Value);
  85.   end;
  86. end;
  87.  
  88. var
  89.   Err, Tid: LongInt;
  90.  
  91. begin
  92.   WriteLn;
  93.   WriteLn('<-- Thread handling / thread local storage demonstration program -->');
  94.   WriteLn('(See source code if you want to know what it really does.)');
  95.  
  96.   Err := BeginThread(nil, 8192, ThreadFunc, nil, 1, Tid);
  97.   if Err < 0 then
  98.   begin
  99.     WriteLn('Error ', Err, ' creating secondary thread.');
  100.     Halt;
  101.   end;
  102.  
  103.   WriteLn('Thread ', Tid, ' successfully created in suspended state.');
  104.  
  105.   ThreadFunc(nil);
  106.  
  107.   WriteLn('Program is finished.');
  108.   WriteLn;
  109. end.
  110.  
  111.