← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/win32/tthread.inc

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/win32/tthread.inc
97
97
 
98
98
{ TThread }
99
99
 
100
 
function ThreadProc(ThreadObjPtr: Pointer): Integer;
101
 
var
102
 
  FreeThread: Boolean;
103
 
  Thread: TThread absolute ThreadObjPtr;
104
 
begin
105
 
  try
106
 
    Thread.Execute;
107
 
  except
108
 
    Thread.FFatalException := TObject(AcquireExceptionObject);
109
 
  end;
110
 
  FreeThread := Thread.FFreeOnTerminate;
111
 
  Result := Thread.FReturnValue;
112
 
  Thread.FFinished := True;
113
 
  Thread.DoTerminate;
114
 
  if FreeThread then Thread.Free;
115
 
end;
116
 
 
117
 
constructor TThread.Create(CreateSuspended: Boolean);
 
100
constructor TThread.Create(CreateSuspended: Boolean;
 
101
                           const StackSize: SizeUInt = DefaultStackSize);
118
102
var
119
103
  Flags: Integer;
120
104
begin
123
107
  FSuspended := CreateSuspended;
124
108
  Flags := 0;
125
109
  if CreateSuspended then Flags := CREATE_SUSPENDED;
126
 
  FHandle := BeginThread(nil, 0, @ThreadProc, pointer(self), Flags, FThreadID);
 
110
  FHandle := BeginThread(nil, StackSize, @ThreadProc, pointer(self), Flags,
 
111
                         FThreadID);
127
112
  FFatalException := nil;
128
113
end;
129
114
 
203
188
function TThread.WaitFor: Integer;
204
189
var
205
190
  Msg: TMsg;
 
191
  WaitHandles : array[0..1] of THandle;
206
192
begin
207
193
  if GetCurrentThreadID = MainThreadID then
208
 
    while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
209
 
      PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
 
194
    begin
 
195
      WaitHandles[0]:=FHandle;
 
196
      WaitHandles[1]:=THandle(SynchronizeTimeoutEvent);
 
197
      while true do
 
198
        begin
 
199
          case MsgWaitForMultipleObjects(2, WaitHandles, False, INFINITE, QS_SENDMESSAGE) of
 
200
            WAIT_OBJECT_0:
 
201
              break;
 
202
            WAIT_OBJECT_0+1:
 
203
              CheckSynchronize;
 
204
            WAIT_OBJECT_0+2:
 
205
              PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
 
206
          end;
 
207
        end;
 
208
    end
210
209
  else
211
210
    WaitForSingleObject(ulong(FHandle), INFINITE);
212
211
  GetExitCodeThread(FHandle, DWord(Result));
213
212
end;
214
 
{
215
 
  $Log: tthread.inc,v $
216
 
  Revision 1.8  2005/02/25 21:52:07  florian
217
 
    * "transfer to linux"-commit
218
 
 
219
 
  Revision 1.7  2005/02/25 21:41:09  florian
220
 
    * generic tthread.synchronize
221
 
    * delphi compatible wakemainthread
222
 
 
223
 
  Revision 1.6  2005/02/14 17:13:32  peter
224
 
    * truncate log
225
 
 
226
 
  Revision 1.5  2005/02/06 13:06:20  peter
227
 
    * moved file and dir functions to sysfile/sysdir
228
 
    * win32 thread in systemunit
229
 
 
230
 
}