Перейти к содержанию
  • Регистрация

ddr 2

Пользователи
  • Публикаций

    5
  • Зарегистрирован

  • Посещение

Информация о ddr 2

  • Звание
    Новичок
  1. Добрый день! Заметил неприятный эффект(баг, особенность либо моё недопонимание чего либо). Через некоторое непродолжительно время работы PopItem( в версии возвращающей TWaitResult) перестаёт ожидать данные из очереди, и перестаёт "усыплять" на(до) TThreadedQueue.FPopTimeout мсек, поток из которого была вызвана, а возвращает wrTimeout без ожидания(менее 100 тактов). Ниже тестовый код, который демонстрирует этот эффект. Описание теста: основной поток, создаёт поток с условным названием FirstDepthThread, который: -запускает MaxThread(константа)+1 потоков( по умолчанию их 10) с условными названиями SecondDepthThread_X ; - c интервалом в 2-5 секунды в каждую из очередей записывается константный идентификатор. Кол-во очередей =MaxThread+1(в каждом из потоков SecondDepthThread_X есть поле с очередью) . Функционал потоков SecondDepthThread_X - ждать данных извлекать их из очереди. В Procedure TSecondDepthThread.Execute есть 2-а условия( помечены в тексте, как {жучок 1} и {жучок 2}), которые в моём понимании никогда не должны выполняться, но...выполняются. Понимание, как обойти этот эффект есть, но очень хочется разобраться, что не так с указанной реализацией? Буду рад мнениям. Условия тестирования: Delphi 10.3.1., W10.1903. Так же рекомендуется попробовать разные значения MaxThread( при MaxThread=2, эффект может и не наступить,при MaxThread= 9, на 3-х разные cpu Intel эффект наступает через ,5-5 секунд, на стареньком AMD FX-8300 лишь через 2-10 минут. при MaxThread=14, AMDешный cpu так же "сдаётся" за несколько секунд). В отладчике смотрим окно Events. Если без отладчика, то в виндовом диспетчере задач, как только загрузка процессора у данного процесс подскочила от 0 к 100%, значит эффект достигнут. unit UThreadedQueue; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,System.Generics.Collections; Const MaxThread=9; type TSecondDepthThread=class(TThread) Protected FThreadNomber:integer; FError:boolean; Procedure Execute;override; Public TickSending:Cardinal; TickInterval:Cardinal; SendingDataQuery:TThreadedQueue<TBytes>; constructor Create(AThreadCount:integer); Destructor Destroy;override; Property ThreadNomber:integer read FThreadNomber; end; TFirstDepthThread=class(TThread) Protected FSecondDepthThreads:array[0..MaxThread] of TSecondDepthThread; Procedure Execute;override; Public SendingDataQuery:TThreadedQueue<TBytes>; constructor Create; Destructor Destroy;override; end; TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FFirstDepthThread:TFirstDepthThread; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses SyncObjs,TypInfo; {$R *.dfm} Constructor TSecondDepthThread.Create(AThreadCount: Integer); begin FError:=false; TickInterval:=2000+random(3000); FThreadNomber:=AThreadCount; SendingDataQuery:=TThreadedQueue<TBytes>.Create(100, 1, 1); //инициализация очереди FreeOnTerminate := false; Inherited Create(false); end; Destructor TSecondDepthThread.Destroy; begin FreeAndNil(SendingDataQuery); inherited; end; Procedure TSecondDepthThread.Execute; var iCounterPerSec,TimeStart, TimeFinish: TLargeInteger; QSize:integer; WaitResult:TWaitResult; ReceivedData:TBytes; ElapsedTime:double; begin NameThreadForDebugging('SecondDepthThread_'+inttostr(FThreadNomber)); while (not Terminated)do begin QueryPerformanceFrequency(iCounterPerSec); QueryPerformanceCounter(TimeStart); WaitResult:=SendingDataQuery.PopItem(QSize,ReceivedData); QueryPerformanceCounter(TimeFinish); ElapsedTime:= (TimeFinish - TimeStart)/iCounterPerSec; if (ElapsedTime<0.000082)and(WaitResult=TWaitResult.wrTimeout)and(not FError) then begin {жучок 1} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' Всё.., началось! Ответ(состояние) очереди='+ GetEnumName(TypeInfo(TWaitResult), Ord(WaitResult))+' выполнение за '+ FormatFloat('0.000000', ElapsedTime) + ' сек., а должно быть более 0.001 сек')); FError:=true; // дальше сообщения с wrTimeout не выводим, т.к. их слишком много end; if (WaitResult=TWaitResult.wrSignaled)and(length(ReceivedData)>0) then begin if ReceivedData[0]=100+FThreadNomber then {OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' ,есть корректные данные'))}; if ReceivedData[0]<>100+FThreadNomber then {жучок 2} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ 'некорректные данные, должно прийти'+ inttostr(100+FThreadNomber)+' ,а пришло '+inttostr(ReceivedData[0]))); if ReceivedData[0]=0 then {подвид 2-го жука} OutputDebugString(pchar('Поток№ '+inttostr(FThreadNomber)+ ' Такого быть не должно! Ответ(состояние) очереди='+ GetEnumName(TypeInfo(TWaitResult), Ord(WaitResult))+ ' сигнал о наличии данных есть, а данных нет,'+ ' выполнение за '+FormatFloat('0.000000', ElapsedTime) )); ReceivedData[0]:=0; // для контроля извлекаемых из очереди данных. end end; end; Constructor TFirstDepthThread.Create; Var Count:integer; begin for count := 0 to MaxThread do FSecondDepthThreads[Count]:=TSecondDepthThread.Create(Count); FreeOnTerminate := false; Inherited Create(false); end; Destructor TFirstDepthThread.Destroy; Var Count:integer; begin for Count := 0 to MaxThread do begin FSecondDepthThreads[Count].Terminate; FSecondDepthThreads[Count].WaitFor; FSecondDepthThreads[Count].Free; end; inherited; end; Procedure TFirstDepthThread.Execute; var Count:integer; SendingData:Tbytes; begin NameThreadForDebugging('FirstDepthThread'); Setlength(SendingData,1); while not terminated do begin for Count := 0 to MaxThread do with FSecondDepthThreads[Count] do if GetTickCount-TickSending>TickInterval then begin SendingData[0]:=100+ThreadNomber; SendingDataQuery.PushItem(SendingData); TickSending:=GetTickCount; end; sleep(1); //yield; end; end; procedure TForm1.FormCreate(Sender: TObject); begin FFirstDepthThread:=TFirstDepthThread.Create; end; procedure TForm1.FormDestroy(Sender: TObject); begin FFirstDepthThread.Terminate; FFirstDepthThread.WaitFor; FFirstDepthThread.Free; end; end.
  2. Таймер был моей самой первой реализацией, но он негативно сказывается на отзывчивости интерфейса. В качестве стресс-теста на отзывчивость - в Windows перемещение окна мышкой. Таймер вызывает лаг(и) при перемещении окна. OnIdle, я раньше не пробовал. Попробовал- работает "мягче"- лаг не замечен. Кстати этот стресс-тест создаёт "пропуск" пакетов на экране, но это не критично и решается созданием более длинной очереди(1). Это зависит от того, какого эффекта надо добиться. Извините, я не правильно сформулировал вопрос. Меня заботило, то, что при закрытии формы, в момент, когда мы в FormDestroy завершаем поток TMyThread, у нас в очереди могут быть(остаться) сообщения/пакеты, которые никогда не будут обработаны, т.е. фактически это потерянные данные. Если в TMyThread.Execute, убрать sleep(random(800)), то данный эффект наблюдается, как в моём предыдущем варианте с подпиской на сообщения, так и в варианте Евгения. И на решении этой локальной задачи, я признал, вариант Евгения лучшим из имеющихся, потому, что в его варианте эта задача решается достаточно просто(ниже), а в варианте с подпиской, возможно решение и существует, но я пас. Вариант решения задачи "потерянных данных"(2), заменяем procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Terminate; FMyThread.WaitFor; FMyThread.Free; FMyQueueIn.Free; FMyQueueOut.Free end; на procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var TempBoolean:Boolean; begin FMyThread.Terminate; FMyThread.WaitFor; onIdle(Sender,TempBoolean); end; procedure TForm1.FormDestroy(Sender: TObject); begin FMyThread.Free; FMyQueueIn.Free; FMyQueueOut.Free end; Так же для оптимизации, в TForm1.OnIdle заменил условие выполнения цикла(3). procedure TForm1.OnIdle(Sender: TObject; var Done: Boolean); Var AMyMessage : TMyMessage; S : String; begin while FMyQueueIn.QueueSize>0 do begin AMyMessage:=FMyQueueIn.PopItem; S:='Пакет№ ' + AMyMessage.PackedNumber.ToString + ' X=' + AMyMessage.X.ToString + ' Y=' + AMyMessage.Y.ToString + ' Z=' + AMyMessage.Z.ToString + ' ' + AMyMessage.StringMessage; Memo.BeginUpdate; Memo.Lines.Add(S); Memo.GoToTextEnd; Memo.EndUpdate; end; end; В новом варианте при каждом вызове OnIdle, если в очереди(TThreadedQueue) нет "сообщений"/элементов, то происходит лишь обращение к полю и сравнение, а ранее был вызов метода TThreadedQueue.PopItem в котором выполняется много всего и большая часть в критической секции. Вместо резюме: Всем спасибо за ответы! Для себя в решении задачи двустороннего обмена сообщениями между формой и потоком, остановился на варианте Евгения с правками (1)(2)(3) Углубившись в проблематику, пришёл к выводу, что в кроссплатформенном FMX лучше избегать архитектуры двусторонней связи формы с потоком, а пользоваться передачей данный из формы в запускаемый поток, через конструктор потока, а обратно, через обработчик onTerminate.
  3. Поставил бряк, посмотрел стек, да Вы правы, вызов идет из потока mythread. Я хотел реализовать "PostMessage" из потока в главный поток, которого FMX нет. Нашёл подсказку Переделал.Все работает и вызов ReciveMessage происходит из главного потока(MainThread). Правильно ли я понимаю, что в подобной реализации "PostMessage"(речь не про данный код, а про сам подход) нужно учитывать и контролировать, что бы поток не завершился раньше, чем все "сообщения" будут обработаны основным потоком? Буду рад услышать, о других возможных реализация "PostMessage" unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,System.Messaging, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls,System.Generics.Collections; type tmythread=class(TThread) public constructor Create; protected PackedNumber:integer; procedure PostMessage; procedure Execute; override; end; TForm2 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private mythread:tmythread; { Private declarations } public procedure ReciveMessage; { Public declarations } end; var Form2: TForm2; qqueue: TThreadedQueue<string>; implementation constructor tmythread.Create; begin PackedNumber:=0; FreeOnTerminate := true; inherited create(false); end; procedure tmythread.Execute; var strmessage:string; begin while (not Terminated) do begin inc(PackedNumber); strmessage:='Пакет№ '+inttostr(PackedNumber)+' значение X='+inttostr(random(1000))+ ' значение Y='+inttostr(random(1000))+' значение Z='+inttostr(random(1000)); qqueue.PushItem(strmessage); Tthread.Queue(nil,PostMessage); sleep(random(800)); end; end; {$R *.fmx} procedure TForm2.ReciveMessage; var stringrecive:string; begin stringrecive:=qqueue.PopItem; label1.Text:=stringrecive; label2.Text:=stringrecive; memo1.Lines.Add(stringrecive);memo1.GoToTextEnd; end; procedure tmythread.PostMessage; begin Form2.ReciveMessage; end; procedure TForm2.FormCreate(Sender: TObject); begin qqueue := TThreadedQueue<string>.Create(5, 1000); memo1.StyledSettings:=[] ; memo1.TextSettings.Font.Size:=8; label1.StyledSettings:=[]; label1.TextSettings.Font.Size:=8; label2.StyledSettings:=[]; label2.TextSettings.Font.Size:=8; mythread:=tmythread.Create; end; end.
  4. Не знал про TThreadedQueue. Полезный функционал, спасибо! Полагаю, что отсылку сообщения из потока в форму можно/нужно делать через TMessageManager. Написал небольшой тест(ниже по тексту- поток посылает сообщения, а форма принимает их и отображает ). Увы, но тест работает не корректно. При запуске под Windows, в процедуре обработке принятого сообщения выскакивает исключение, где-то в районе label1.Text:=stringrecive; . Если в процедуре TForm2._ReciveMessage закоментировать строчки label1.Text:=stringrecive; и label2.Text:=stringrecive ,то оставшиеся добавление строки в memo работает, но явно "не здорово" подмаргивает. При запуске под Android, изменение текста в метках работает, но memo так же дергается и моргает. Применение TThreadedQueue никак не влияет на результат и в тексте закоментировано. Прошу помощи, в чем ошибка? unit Unit2; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,System.Messaging, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, FMX.StdCtrls,System.Generics.Collections; type tmythread=class(TThread) public constructor Create; protected packetnomber:integer; procedure Execute; override; end; TForm2 = class(TForm) Memo1: TMemo; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); private mythread:tmythread; procedure _ReciveMessage(const Sender: TObject; const M: TMessage); { Private declarations } public { Public declarations } end; var Form2: TForm2; // qqueue: TThreadedQueue<string>; implementation constructor tmythread.Create; begin packetnomber:=0; FreeOnTerminate := true; inherited create(false); end; procedure tmythread.Execute; var strmessage:string; MessageManager: TMessageManager;_Message: TMessage; begin while (not Terminated) do begin inc(packetnomber); strmessage:='Пакет№ '+inttostr(packetnomber)+' значение X='+inttostr(random(1000))+ ' значение Y='+inttostr(random(1000))+' значение Z='+inttostr(random(1000)); //qqueue.PushItem(strmessage); _Message:=TMessage<String>.Create(strmessage); MessageManager := TMessageManager.DefaultManager; MessageManager.SendMessage(self, _Message, true); sleep(random(800)); end; end; {$R *.fmx} procedure TForm2._ReciveMessage(const Sender: TObject; const M: TMessage); var stringrecive:string; begin stringrecive:=(M as TMessage<String>).Value; //stringrecive:=qqueue.PopItem; label1.Text:=stringrecive; label2.Text:=stringrecive; memo1.Lines.Add(stringrecive);memo1.GoToTextEnd; end; procedure TForm2.FormCreate(Sender: TObject); var SubscriptionId: Integer; MessageManager: TMessageManager; begin // qqueue := TThreadedQueue<string>.Create(5, 1000); memo1.StyledSettings:=[] ; memo1.TextSettings.Font.Size:=8; label1.StyledSettings:=[]; label1.TextSettings.Font.Size:=8; label2.StyledSettings:=[]; label2.TextSettings.Font.Size:=8; mythread:=tmythread.Create; MessageManager := TMessageManager.DefaultManager; SubscriptionId := MessageManager.SubscribeToMessage(TMessage<String>,self._ReciveMessage); end; end.
  5. Привет Под WIN32/64: - сообщение из формы в поток отправлял PostThreadMessage(myThread.ThreadID, WM_user+1, nativeuint(@data1),nativeuint(@data2)); - сообщение из потока в форму SendMessage(FormHandle,WM_user+2,nativeuint(@data1),nativeuint(@data2)); В Android такого нет. Подскажите, как организовать обмен сообщениями между формой и потоками в Android?
×
×
  • Создать...