home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / THREADS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-13  |  6KB  |  198 lines
  1. UNIT Threads;
  2.  
  3. {
  4. ╔═══════════════════════════════════════════════════════════════════════════╗
  5. ║                                                                           ║
  6. ║ Speed-Pascal/2 Version 2.0                                                ║
  7. ║                                                                           ║
  8. ║ Portable Class Library (PCL) Version 1.0                                  ║
  9. ║                                                                           ║
  10. ║ This file: Threads and processes class definitions                        ║
  11. ║                                                                           ║
  12. ║ Last modified: 22.08.1995                                                 ║
  13. ║                                                                           ║
  14. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  15. ║                                                                           ║
  16. ╚═══════════════════════════════════════════════════════════════════════════╝
  17. }
  18.  
  19. INTERFACE
  20.  
  21. {$IFDEF OS2}
  22. USES BseDos;
  23. {$ELSE}
  24. Error: Wrong operating system
  25. {$ENDIF}
  26.  
  27. {$IFDEF OS2}
  28. TYPE
  29.     HThread  = TID;
  30. {$ELSE}
  31. Error: Wrong operating system
  32. {$ENDIF}
  33.  
  34.  
  35. TYPE
  36.     TThreadProc=PROCEDURE(ThreadParam1,ThreadParam2:POINTER);
  37.  
  38.     TThread name 'TThread'=CLASS(TObject)
  39.                        PRIVATE
  40.                              PThreadProc:TThreadProc;
  41.                              PThreadParam1:POINTER;
  42.                              PThreadParam2:POINTER;
  43.                              PStackSize:ULONG;
  44.                              PThreadTID:HThread;
  45.                              PSuspended:BOOLEAN;
  46.                        PRIVATE
  47.                              FUNCTION GetSuspended:BOOLEAN;
  48.                        PUBLIC
  49.                              CONSTRUCTOR Create(ThreadProc:TThreadProc;
  50.                                                 ThreadParam1:POINTER;
  51.                                                 ThreadParam2:POINTER;
  52.                                                 ThreadStack:LONGWORD);
  53.                              PROCEDURE Run;
  54.                              PROCEDURE Kill;
  55.                              PROCEDURE Suspend;
  56.                              PROCEDURE Resume;
  57.                              PROCEDURE ThreadProc;
  58.                              PROCEDURE SetPriority(PClass,PDelta:LONGWORD);
  59.                              FUNCTION HasEnded:BOOLEAN;
  60.                              PROCEDURE Sleep(ms:LONGWORD);
  61.                              DESTRUCTOR Destroy;VIRTUAL;
  62.                        PROPERTY
  63.                              Suspended:BOOLEAN      read GetSuspended;
  64.     END;
  65.  
  66. IMPLEMENTATION
  67.  
  68. {
  69. ╔═══════════════════════════════════════════════════════════════════════════╗
  70. ║                                                                           ║
  71. ║ Speed-Pascal/2 Version 2.0                                                ║
  72. ║                                                                           ║
  73. ║ Portable Class Library (PCL) Version 1.0                                  ║
  74. ║                                                                           ║
  75. ║ This section: TThread Class implementation                                ║
  76. ║                                                                           ║
  77. ║ Last modified: 22.08.1995                                                 ║
  78. ║                                                                           ║
  79. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  80. ║                                                                           ║
  81. ╚═══════════════════════════════════════════════════════════════════════════╝
  82. }
  83.  
  84. CONSTRUCTOR TThread.Create(ThreadProc:TThreadProc;
  85.                            ThreadParam1:POINTER;
  86.                            ThreadParam2:POINTER;ThreadStack:LONGWORD);
  87. BEGIN
  88.      PThreadProc:=ThreadProc;
  89.      PThreadParam1:=ThreadParam1;
  90.      PThreadParam2:=ThreadParam2;
  91.      IF ThreadStack<16384 THEN ThreadStack:=16384;
  92.      PStackSize:=ThreadStack;
  93.      PThreadTID:=0;
  94.      PSuspended:=FALSE;
  95. END;
  96.  
  97. PROCEDURE TThread.Sleep(ms:LONGWORD);
  98. BEGIN
  99.      {$IFDEF OS2}
  100.      DosSleep(ms);
  101.      {$ELSE}
  102.      Error: Wrong operating system
  103.      {$ENDIF}
  104. END;
  105.  
  106. FUNCTION TThread.GetSuspended:BOOLEAN;
  107. BEGIN
  108.      GetSuspended:=PSuspended;
  109. END;
  110.  
  111. PROCEDURE TThread.ThreadProc;CDECL;
  112. BEGIN
  113.      PThreadProc(PThreadParam1,PThreadParam2);
  114.      {Clear TID if Thread resumed}
  115.      PThreadTID:=0;
  116. END;
  117.  
  118. PROCEDURE TThread.Run;
  119. BEGIN
  120.      {$IFDEF OS2}
  121.      DosCreateThread(PThreadTID,@ThreadProc,POINTER(SELF),
  122.                      0{STACK_COMMITTED},PStackSize);
  123.      {$ELSE}
  124.      Error: Wrong operating system
  125.      {$ENDIF}
  126. END;
  127.  
  128. PROCEDURE TThread.Kill;
  129. VAR r:LONGWORD;
  130. LABEL l;
  131. BEGIN
  132.      {$IFDEF OS2}
  133.      IF PThreadTID<>0 THEN
  134.      BEGIN
  135.           IF PSuspended THEN Resume; {Cant kill a suspended thread}
  136. l:
  137.           r:=DosKillThread(PThreadTID);
  138.           IF r=170 THEN  {Thread busy}
  139.           BEGIN
  140.                DosSleep(50);  //wait a while
  141.                goto l;
  142.           END;
  143.      END;
  144.      {$ELSE}
  145.      Error: Wrong operating system
  146.      {$ENDIF}
  147.      PThreadTID:=0;
  148. END;
  149.  
  150. PROCEDURE TThread.Suspend;
  151. BEGIN
  152.      IF PThreadTID<>0 THEN IF not PSuspended THEN
  153.      BEGIN
  154.           {$IFDEF OS2}
  155.           DosSuspendThread(PThreadTID);
  156.           {$ELSE}
  157.           Error: Wrong operating system
  158.           {$ENDIF}
  159.           PSuspended:=TRUE;
  160.      END;
  161. END;
  162.  
  163. PROCEDURE TThread.Resume;
  164. BEGIN
  165.      IF PThreadTID<>0 THEN IF PSuspended THEN
  166.      BEGIN
  167.           {$IFDEF OS2}
  168.           DosResumeThread(PThreadTID);
  169.           {$ELSE}
  170.           Error: Wrong operating system
  171.           {$ENDIF}
  172.           PSuspended:=FALSE;
  173.      END;
  174. END;
  175.  
  176. PROCEDURE TThread.SetPriority(PClass,PDelta:LONGWORD);
  177. BEGIN
  178.      {$IFDEF OS2}
  179.      IF PThreadTID<>0 THEN
  180.        DosSetPriority(PRTYS_THREAD,PClass,PDelta,PThreadTID);
  181.      {$ELSE}
  182.      Error: Wrong operating system
  183.      {$ENDIF}
  184. END;
  185.  
  186. FUNCTION TThread.HasEnded:BOOLEAN;
  187. BEGIN
  188.      HasEnded:=PThreadTID=0;
  189. END;
  190.  
  191. DESTRUCTOR TThread.Destroy;
  192. BEGIN
  193.      Kill;
  194.  
  195.      Inherited Destroy;
  196. END;
  197.  
  198. END.