Сел переписывать движок Doomed Game под потоки и... понял, что мои знания о потокобезопасности оставляют желать лучшего. Может быть кто-нибудь (volvo?) проведет несколько лекций на эту тему? Думаю, это не только меня может заинтересовать. Или может я просто задам свои вопросы?
Название темы -
Нет, пока лекций на тему потокобезопасности я читать не буду, лучше задавай вопросы, посмотрим, во что это выльется. Может вместе и смастерим какой-нибудь полезный FAQ, тем более на реальном примере...
Окей. Тогда рассмотрим пример. Мое приложение состоит из нескольких глобальных объектов. Не знаю, насколько это оправдано, но в свое время мне это показалось неплохим решением. Объекты примерно такие:
unit u_test;Так как с объектами могут взаимодействовать (вызывать их методы) сразу несколько потоков, их следует сделать потокобезопасными. Предлагаю это сделать . Если такая схема приложения кажется тебе неподходящей, можно ее пересмотреть.
{$mode objfpc}
interface
type
TTest = class
private
FData: Integer;
public
constructor Create;
destructor Destroy; override;
procedure OutputData;
procedure IncData(Value: Integer);
procedure RandomData;
property Data: Integer read FData write FData;
end;
var
Test: TTest = nil;
implementation
constructor TTest.Create;
begin
FData := 0;
end;
destructor TTest.Destroy;
begin
WriteLn('I''m dying!');
end;
procedure TTest.OutputData;
begin
WriteLn('Data: ', FData);
end;
procedure TTest.IncData(Value: Integer);
begin
Inc(FData, Value);
end;
procedure TTest.RandomData;
var
Temp: Integer;
begin
Temp := Random(10);
FData := Temp;
end;
initialization
Test := TTest.Create;
finalization
Test.Destroy;
end.
Какие методы планируется вызывать из разных потоков? Все? Как пытался сделать потокобезопасность? (ну, и более глобальный вопрос, как вообще обеспечивается межпоточное взаимодействие, знаешь?) Что именно (по-твоему) может быть опасного в тех методах, которые ты привел, почему нельзя прямо так взять и работать с объектом из разных потоков?
unit u_test;
{$mode objfpc}
interface
type
TTest = class
private
FData: Integer;
{Объявляем Mutex;}
function GetData: Integer;
procedure SetData(Value: Integer);
public
constructor Create;
destructor Destroy; override;
procedure OutputData;
procedure IncData(Value: Integer);
procedure RandomData;
property Data: Integer read GetData write SetData;
end;
var
Test: TTest = nil;
implementation
// private
function TTest.GetData: Integer;
begin
try
{Пытаемся захватить Mutex в течении N секунд.}
if {получилось} then
Result := FData
else begin
Result := 0;
WriteLn('Error reading.');
end;
finally
{Освобождаем Mutex.}
end;
end;
procedure TTest.SetData(Value: Integer);
begin
try
{Пытаемся захватить Mutex в течении N секунд;}
if {получилось} then
FData := Value;
else
WriteLn('Error writing.');
finally
{Освобождаем Mutex;}
end;
end;
// public
constructor TTest.Create;
begin
FData := 0;
{Создаем Mutex;}
end;
destructor TTest.Destroy;
begin
WriteLn('I''m dying!');
end;
procedure TTest.OutputData;
begin
WriteLn('Data: ', Data);
end;
procedure TTest.IncData(Value: Integer);
begin
Data := Data + Value;
end;
procedure TTest.RandomData;
var
Temp: Integer;
begin
Temp := Random(10);
Data := Temp;
end;
initialization
Test := TTest.Create;
finalization
Test.Destroy;
end.
try
{Пытаемся захватить Mutex в течении N секунд;}
if {получилось} then
FData := Value;
finally
{Освобождаем Mutex;}
end;
, если мьютекс уже установлен из другого потока, то будет облом, второй раз тебе установить его не дадут, и операция не произойдет Ты этого добивался, или тебе надо ждать, пока один закончит, и другой проделает эту операцию? Тогда CriticalSections в помощь...
{Пытаемся __установить__ Mutex в течении N секунд;}
if {получилось} then
FData := Value;
{Освобождаем Mutex;}
end;
unit u_test;Проверяй .
{$mode objfpc}
interface
type
TTest = class
private
FData: Integer;
CS: TRTLCriticalSection;
function GetData: Integer;
procedure SetData(Value: Integer);
public
constructor Create;
destructor Destroy; override;
procedure OutputData;
procedure IncData(Value: Integer);
procedure RandomData;
property Data: Integer read GetData write SetData;
end;
var
Test: TTest = nil;
implementation
// private
function TTest.GetData: Integer;
begin
try
EnterCriticalSection(CS);
Result := FData;
finally
LeaveCriticalSection(CS);
end;
end;
procedure TTest.SetData(Value: Integer);
begin
try
EnterCriticalSection(CS);
FData := Value;
finally
LeaveCriticalSection(CS);
end;
end;
// public
constructor TTest.Create;
begin
FData := 0;
InitCriticalSection(CS);
end;
destructor TTest.Destroy;
begin
DoneCriticalSection(CS);
WriteLn('I''m dying!');
end;
procedure TTest.OutputData;
begin
WriteLn('Data: ', Data);
end;
procedure TTest.IncData(Value: Integer);
begin
Data := Data + Value;
end;
procedure TTest.RandomData;
var
Temp: Integer;
begin
Temp := Random(10);
Data := Temp;
end;
initialization
Test := TTest.Create;
finalization
Test.Destroy;
end.
Обезопасил модуль u_log.pas. Теперь думаю над u_window.pas. Предпологается использовать этот объект только в одном потоке (в модуле u_graphics.pas), но WinProc - это же отдельный поток, верно? Значит вот так делать нельзя:
function TD3DWindow.MessageProc(Msg: UINT; WParam: WPARAM; LParam: LPARAM): LResult;Думаю, от этого вобще лучше избавиться и ловить клавиши исключительно в модуле u_controls.pas (его пока нет, но будет )
begin
case Msg of
WM_DESTROY: begin
PostQuitMessage(0);
end;
WM_SYSCOMMAND: begin
if (WParam = SC_SCREENSAVE) or (WParam = SC_MONITORPOWER) then
Result := 0
else
Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
end;
WM_SYSKEYUP: begin
if WParam = VK_RETURN then SetFullscreenMode(D3DPP.Windowed) { <- Тут прозреваю небезопасный вызов метода. }
else if Char(WParam) = '1' then SetMode('800x600x32') { <- И тут. }
else if Char(WParam) = '2' then SetMode('1024x768x32') { <- И тут. }
else if Char(WParam) = '3' then SetMode('1280x1024x32'); { <- И тут. }
end;
else
Result := DefWindowProc(WinHandle, Msg, WParam, LParam);
end;
end;
Продолжаю исправлять классы. Работу с текстурами я просто сокрыл внутри спрайтов. Так что теперь главное - сделать безопасную работу со спрайтами.
TSprite = class(TGraphicObject)Предпологается, что один поток будет делать SetMode и SetParams, а другой Update и Draw. Критические секции сделать не проблема, но не будет ли это слишком медленным? Все таки каждый кадр предпологается рисовать множество этих спрайтов.
private
Texture: TTexture;
CurrentMode: Integer;
FramesNum: Integer;
CurrentFrame: Integer;
FrameInterval: Double;
RepeatAnimation: Boolean;
FrameTime: Double;
SpriteCenter: TD3DXVECTOR3;
Scale: TD3DMATRIX;
Rotate: TD3DMATRIX;
Translate: TD3DMATRIX;
Transform: TD3DMATRIX;
FWidth, FHeight: Integer;
public
// Width, Height - размеры спрайта (в тайлах, могут быть дробными).
// Texture - имя файла с текстурой, которая должна быть наложена на спрайт.
// AWidth, AHeight - размеры спрайта (размеры одного кадра тектсуры в пикселах).
constructor Create(const TextureName: AnsiString; AWidth, AHeight: Integer);
// Деструктор автоматически пытается удалить объект из контейнера Sprites.
destructor Destroy; override;
// Установка параметров анимации. Параметры:
// Mode - номер анимации. Frame - номер текущего кадра. Frames - число кадров.
// CenterX, CenterY - координаты центра спрайта, относительно которого отсчитываются
// координаты и происходит поворот.
// Interval - время показа кадра в мс, 0, если анимация не нужна.
// RepeatAni - повторять ли анимацию.
procedure SetMode(Mode, Frame, Frames, CenterX, CenterY, Interval: Integer; RepeatAni: Boolean);
// Установить параметры: координаты, угол поворота, масштаб.
procedure SetParams(X, Y, Z, Angle, ScaleX, ScaleY: Single);
// Нарисаовать спрайт.
procedure Draw;
// Обработчик спрайта. Принимает время, прошедшее с предыдущего вызова в мс.
procedure Update(Delta: Double); override;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
end;
Что-то не так... Смотри:
uses sysutils, classes,- простейший тест, правда? Примерно одинаковое количество раз в файле должно присутствовать каждое сообщение. Теперь смотри на вывод:
u_test;
type
tmythread = class(tthread)
private
msg: string;
num: string;
protected
procedure execute; override;
public
constructor create(s, n: string);
end;
constructor tmythread.create(s, n: string);
begin
msg := s; num := n;
inherited create(false);
end;
procedure tmythread.execute;
begin
repeat
Log.Write(num, msg);
until terminated;
end;
const n = 50;
var
thrds: array[1 .. n] of TMyThread;
i: integer;
begin
for i := 1 to n do begin
thrds[i] := TMyThread.Create('message #' + IntToStr(i), IntToStr(i));
end;
readln;
for i := n downto 1 do begin
thrds[i].Terminate; thrds[i].Destroy;
end;
end.
Странно, я у себя в том же тесте таких ужасов не наблюдаю. Только в конце 1 повторяется, но там их всего ~2-3 потоков осталось. Может менеджер процессов Windows шалит?
Прикрепленные файлы
threads.txt ( 100.26 килобайт )
Кол-во скачиваний: 304
unit u_test;(код тестирующего приложения не меняется), то шалить моментально перестает?
{$mode objfpc}
interface
uses
windows, sysutils;
type
TLog = class
private
FLogFile: Text;
FLock: TMultiReadExclusiveWriteSynchronizer;
procedure WriteString(const Str: string);
public
constructor Create(const FileName: string);
destructor Destroy; override;
procedure Write(const SenderName, Str: string);
end;
var
Log: TLog;
implementation
const
TimeFormat = 'yyyy-mm-dd hh:mm:ss.zzz';
// TLog -----
// private
procedure TLog.WriteString(const Str: string);
begin
FLock.BeginWrite;
try
{$I-}
WriteLn(FLogFile, Str);
Flush(FLogFile);
{$I+}
if IOResult <> 0 then begin
MessageBox(0, 'Can''t write to log file. Program halted.', 'File error', MB_OK);
Halt(0);
end;
finally
FLock.EndWrite;
end;
end;
// public
constructor TLog.Create(const FileName: string);
begin
FLock := TMultiReadExclusiveWriteSynchronizer.Create;
{$I-}
Assign(FLogFile, FileName);
if FileExists(FileName) then Append(FLogFile) else Rewrite(FLogFile);
{$I+}
if (IOResult = 0) and (FileName <> '') then begin
WriteString('');
WriteString('*** Start session ***');
end else begin
MessageBox(0, 'Can''t create or open log file. Program halted.', 'File error', MB_OK);
Halt(0);
end;
end;
destructor TLog.Destroy;
begin
WriteString('*** End session ***');
Close(FLogFile);
FLock.Free;
end;
procedure TLog.Write(const SenderName, Str: string);
begin
WriteString(FormatDateTime(TimeFormat, Now) + ' Note: "' + SenderName + '" - ' + Str);
end;
initialization
Log := TLog.Create('threads.txt');
finalization
Log.Destroy;
end.
А в чем разница? Разве что в TMultiReadExclusiveWriteSynchronizer используется Mutex, а не CriticalSection.
Так... Меняем стратегию...
Модуль:
u_test.pas ( 3.41 килобайт )
Кол-во скачиваний: 470
Тестовая программа:
__main.pas ( 898 байт )
Кол-во скачиваний: 440
(С) Рихтер + --Ins--
Проверяй на наличие вот таких последовательностей (да и вообще на наличие временнЫх несоответствий). Правда переносимостью пока пришлось пожертвовать...
Долго не отвечал, потому что устраивался на летнюю практику. Проверил новый тест. Теперь последовательности не появляются, время строго по неубыванию. Более того, когда все потоки созданы, каждый номер начинает появляться ровно через 50 позиций. Улучшения налицо.
Стоит ли мне курить этот код и медитировать, или будем упрощать и продолжать тестировать?