(* Tux Commander - UGlibThreads - Threading support through the GLIB library Copyright (C) 2007-2008 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UGlibThreads; interface uses glib2; type TGlibThreadMethod = procedure of object; TGlibThread = class private FHandle: PGThread; FCreateSuspended: Boolean; FTerminated: Boolean; FSuspended: Boolean; FReturnValue: Integer; FFreeOnTerminate: Boolean; // FFinished: Boolean; // procedure SetSuspended(Value: Boolean); protected // procedure DoTerminate; virtual; procedure Execute; virtual; abstract; property Terminated: Boolean read FTerminated; public constructor Create(CreateSuspended: Boolean); destructor Destroy; override; // procedure AfterConstruction; override; procedure Resume; { procedure Suspend; procedure Terminate; } function WaitFor: LongWord; property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate; { property Suspended: Boolean read FSuspended write SetSuspended; } property ReturnValue: Integer read FReturnValue write FReturnValue; end; TGlibCriticalSection = class private FGMutex: TGStaticMutex; public constructor Create; destructor Destroy;override; procedure Enter; procedure Leave; procedure Acquire; procedure Release; end; implementation uses Classes, SysUtils, UCoreUtils; function xg_thread_func(data: gpointer): gpointer; cdecl; var Thread: TGlibThread; FreeThread: Boolean; begin DebugMsg(['(II) TGlibThread.g_thread_func']); Result := nil; try Thread := TGlibThread(data); if Assigned(Thread) and (Thread is TGlibThread) then begin Thread.Execute; Result := gpointer(Thread.FReturnValue); FreeThread := Thread.FreeOnTerminate; if FreeThread then Thread.Free; end else DebugMsg(['(EE) TGlibThread.g_thread_func: wrong data argument']); except on E: Exception do DebugMsg(['(EE) TGlibThread.g_thread_func: Exception ', E.ClassName, ': ', E.Message]); end; end; constructor TGlibThread.Create(CreateSuspended: Boolean); begin inherited Create; DebugMsg(['(II) TGlibThread.Create']); FSuspended := CreateSuspended; FCreateSuspended := CreateSuspended; FHandle := nil; FReturnValue := 0; FFreeOnTerminate := False; if not CreateSuspended then Resume; end; destructor TGlibThread.Destroy; begin DebugMsg(['(II) TGlibThread.Destroy']); { if (FHandle <> nil) and not FFinished then begin Terminate; if FCreateSuspended then Resume; WaitFor; end; } inherited Destroy; end; procedure TGlibThread.Resume; var err: PGError; begin DebugMsg(['(II) TGlibThread.Resume']); err := nil; FHandle := g_thread_create(@xg_thread_func, Self, True, @err); if FHandle = nil then begin DebugMsg(['(EE) TGlibThread.Resume: Error creating new thread: ', err.message]); g_error_free(err); end; end; function TGlibThread.WaitFor: LongWord; begin if FHandle <> nil then g_thread_join(FHandle); Result := FReturnValue; end; (**********************************************************************************************************************) constructor TGlibCriticalSection.Create; begin inherited Create; FGMutex := nG_STATIC_MUTEX_INIT; end; destructor TGlibCriticalSection.Destroy; begin inherited Destroy; end; procedure TGlibCriticalSection.Enter; begin Acquire; end; procedure TGlibCriticalSection.Leave; begin Release; end; procedure TGlibCriticalSection.Acquire; begin g_static_mutex_lock(@FGMutex); end; procedure TGlibCriticalSection.Release; begin g_static_mutex_unlock(@FGMutex); end; (**********************************************************************************************************************) initialization if not g_thread_supported then g_thread_init(nil); finalization end.