Текущий архив: 2006.07.02;
Скачать: CL | DM;

Вниз

Причина ошибки Access Violation   Найти похожие ветки 

← →
Balkon   (2006-06-09 14:03) [0]

Здраствуйте.
В многопоточном приложении иногда (повторяемости пока добиться не удалось) возникает Access Violation по одному и томуже адресу. Алгоритмы все пересмотрены, доступ к совместным данным в критических секциях.... Подскажите идею, как отловить причину ошибки или отследить участок кода где это происходит?
Спасибо за внимание.

---

← →
Сергей М. ©   (2006-06-09 14:05) [1]

> отследить участок кода где это происходит?


см. меню Search -> Find Error..

---

← →
Kolan ©   (2006-06-09 14:09) [2]

MemProof...

---

← →
Balkon   (2006-06-09 14:39) [3]

Спасибо.
Search -> Find Error привело меня в окно CPU...
А отследить участок кода паскалевского возможо?

---

← →
Сергей М. ©   (2006-06-09 14:53) [4]

А ты какой адрес вводил ?
Из там два, в сообщении об AV, нужно вводить первый ..

Кстати, чему он равен ? Это важно ..

---

← →
Balkon   (2006-06-09 15:01) [5]

Первый: 00402A0D
Второй: 1000FFFC

вводил первый

---

← →
Balkon   (2006-06-09 15:11) [6]

Прошу прощения, вываливаюсь из форума.
Если не затруднит оставьте сообщение.
Прочитаю по прибытии.

Заранее спасибо.

---

← →
Сергей М. ©   (2006-06-09 15:11) [7]

Хм..

$00402A0D у меня (тот же D7) указывает на вполне конкретнуб строчку:

if IsMultiThread then LeaveCriticalSection(heapLock); (GETMEM.INC)

И это , кстати, кое о чем уже говорит...

Как создашь потоки  - CreateThread ? BeginThread ? Класс TThread ?

---

← →
Balkon   (2006-06-13 06:17) [8]

Приветствую.
Потоки создаю с помощью CreateThread. Класс TThread.

Обмен данными между потоками происходит через очереди команд и ответов,
которые описаны в следующем классе. Может в нем чтото не так?

//TThreadQueue
procedure TThreadQueue.Clear;
begin
 LockQueue;
 try
   While FQueue.Count > 0 do
     FQueue.Pop;
 finally
   UnlockQueue;
 end;
end;

function TThreadQueue.Count;
begin
 LockQueue;
 try
   Result := FQueue.Count;
 finally
   UnlockQueue;
 end;
end;

function TThreadQueue.Push(AItem: Pointer): Pointer;
begin
 LockQueue;
 try
   Result := FQueue.Push(AItem);
 finally
   UnlockQueue;
 end;
end;

function TThreadQueue.Pop: Pointer;
begin
 LockQueue;
 try
   Result := FQueue.Pop;
 finally
   UnlockQueue;
 end;
end;

function TThreadQueue.Peek: Pointer;
begin
 LockQueue;
 try
   Result := FQueue.Peek;
 finally
   UnlockQueue;
 end;
end;

procedure TThreadQueue.LockQueue;
begin
 EnterCriticalSection(FLock);
end;

procedure TThreadQueue.UnlockQueue;
begin
 LeaveCriticalSection(FLock);
end;

constructor TThreadQueue.Create;
begin
 inherited Create;
 InitializeCriticalSection(FLock);
 FQueue := TQueue.Create;
end;

destructor TThreadQueue.Destroy;
begin
 LockQueue;
 try
   FQueue.Free;
   inherited Destroy;
 finally
   UnlockQueue;
   DeleteCriticalSection(FLock);
 end;
end;

---

← →
Balkon   (2006-06-13 06:29) [9]

 TThreadQueue = class
 private
   FQueue: TQueue;
   FLock: TRTLCriticalSection;
   procedure LockQueue;
   procedure UnlockQueue;
 public
   constructor Create;
   destructor Destroy; override;
   function Push(AItem: Pointer): Pointer;
   function Pop: Pointer;
   function Peek: Pointer;
   function Count: integer;
   procedure Clear;
 end;

---

← →
Сергей М. ©   (2006-06-13 08:13) [10]

> Потоки создаю с помощью CreateThread. Класс TThread


Так все-таки CreateThread тобой явный вызывается или ты используешь класс TThread ?
Это принципиально ..

---

← →
Balkon   (2006-06-13 08:20) [11]

Сорри...
Использую класс.

---

← →
Сергей М. ©   (2006-06-13 08:28) [12]

Сборку проекта осуществляешь со всеми опциями отладки ?

---

← →
Balkon   (2006-06-13 08:42) [13]

На вкладке Linker повесил два последних флажка. (До этого были сняты)
Это имеется ввиду?

Теперь при той самой ошибке приложение влетает в asm вставку процедуры Move модуля System.

---

← →
Сергей М. ©   (2006-06-13 08:50) [14]

Не на вкладке "Linker", а на вкладке "Compiler" !

см. справку по теме "debugging, generating debug information"

---

← →
Balkon   (2006-06-13 09:00) [15]

Справку прочел, спасибо.
На панели Debugging вкладки Compiler установлены все флажки.

---

← →
Сергей М. ©   (2006-06-13 09:02) [16]

Что теперь показывает [1] ?

---

← →
Balkon   (2006-06-13 09:06) [17]

asm вставка процедуры Move модуля System

---

← →
Balkon   (2006-06-13 09:12) [18]

регулярно появляющийся код 00402A0D - вдет к asm вставке процедуры Move модуля System

идиножды возникший 004022E4 - в процедуру SysGetMem из упомянутого GETMEM.INC

---

← →
Сергей М. ©   (2006-06-13 09:15) [19]

На какую конкретно строчку ?

---

← →
Сергей М. ©   (2006-06-13 09:19) [20]

Вообще покажи код своего поточного класса ..
Кр.того покажи код создания-уничтожения экз-ров этого класса ..

---

← →
Balkon   (2006-06-13 09:22) [21]

00402A0D:
 
 ...
 @@down:
       LEA     ESI,[ESI+ECX-4] { point ESI to last dword of source     }
       LEA     EDI,[EDI+ECX-4] { point EDI to last dword of dest       }

       SAR     ECX,2           { copy count DIV 4 dwords       }
       JS      @@exit
       STD
       REP     MOVSD

       MOV     ECX,EAX
       AND     ECX,03H         { copy count MOD 4 bytes        }
       ADD     ESI,4-1         { point to last byte of rest    }
       ADD     EDI,4-1
       REP     MOVSB
       CLD

004022E4:

    if f <> nil then begin
       u := PUsed(PChar(f) + size);
       u.sizeFlags := u.sizeFlags and not cPrevFreeFlag;
       next := f.next;
       if next = f then
         smallTab[size div cAlign] := nil
       else begin
         smallTab[size div cAlign] := next;
         prev := f.prev;
         prev.next := next;
         next.prev := prev;
       end;
       u := PUsed(f);
       u.sizeFlags := f.size or cThisUsedFlag;
       result := PChar(u) + sizeof(TUsed);
       Inc(AllocMemCount);
       Inc(AllocMemSize,size - sizeof(TUsed));
       exit;
     end;

---

← →
Balkon   (2006-06-13 10:00) [22]

Поточный класс:
unit Unit_AKRThread;

interface

type
 TAKRThread = class(TThread)
 private
   FOwner: THandle;
   FComNumber: Integer;
   FPortHandle: THandle;
   FComandPackage: TAKRPackage;
   FAnswerPackage: TAKRPackage;
   FAnswerChecked: Boolean;
   FStackPackage: TStackPackage;
   FAnswerQueue: TThreadQueue;
   FRepeatCount: integer;
 protected
   procedure SendAnswer;
   procedure AddAnswerToQueue(AnswerPackage: TAKRPackage);
   function GetCantContactPackage: TAKRPackage;

   procedure OpenPort(ComNumber: Integer);
   procedure ClosePort;
   зrocedure ApplyComSettings;

   function WriteAKRComand: boolean;
   procedure RepeatAKRComand;

   procedure CheckBytes(TmpPackage: TReadPackage; Count: Word);
   function CheckTheAnswer(AnswerPackage: TAKRPackage): boolean;
   function ExtractAnswerPackage(StackPackage: TStackPackage;
     var AnswerPackage: TAKRPackage): boolean;
 protected
   procedure CleanUpThread(Sender: TObject);
   procedure Execute; override;
 public
   constructor Create(CreateSuspended: boolean; AOwner:THandle;
     AComNumber: Integer; AAnswerQueue: TThreadQueue; AComandPackage: TAKRPackage);
 end;

implementation

uses SysUtils,Unit_AKRManager,Unit_DeviceManager,Forms;

procedure TAKRThread.CleanUpThread(Sender: TObject);
begin
 ClosePort;
end;

procedure TAKRThread.SendAnswer;
begin
 if FAnswerChecked then
   AddAnswerToQueue(FAnswerPackage)
 else
   AddAnswerToQueue(GetCantContactPackage);
 Terminate;
end;

procedure TAKRThread.AddAnswerToQueue(AnswerPackage: TAKRPackage);
var
 P: PAKRPackage;
begin
 New(P);
 P^ := AnswerPackage;
 FAnswerQueue.Push(P);
 PostMessage(FOwner,WM_CANGETAKRANSWER,0,0);
end;

procedure TAKRThread.RepeatAKRComand;
begin
 if FRepeatCount <= 3 then
 begin
   inc(FRepeatCount);
   WriteAKRComand;
 end
 else
   SendAnswer;
end;

function TAKRThread.WriteAKRComand: boolean;
var
 wParam,lParam: Integer;

 Signaled, RealWrite, BytesTrans : Cardinal;
 WriteOL : TOverLapped;
begin
 FillChar(WriteOL, SizeOf(WriteOL), 0);
 WriteOL.hEvent:= CreateEvent(nil, True, True, nil);
 Try
   WriteFile(FPortHandle, FComandPackage, SizeOf(FComandPackage), RealWrite, @WriteOL);
   Signaled:= WaitForSingleObject(WriteOL.hEvent, INFINITE);
   Result := (Signaled = WAIT_OBJECT_0) and
     GetOverlappedResult(FPortHandle, WriteOL, BytesTrans, False);
 Finally
   CloseHandle(WriteOL.hEvent);
 End;
end;

constructor TAKRThread.Create(CreateSuspended: boolean; AOwner:THandle;
     AComNumber: Integer; AAnswerQueue: TThreadQueue; AComandPackage: TAKRPackage);
begin
 inherited Create(true);

 OpenPort(AComNumber);

 FOwner := AOwner;
 FAnswerQueue := AAnswerQueue;
 FComandPackage := AComandPackage;
 FRepeatCount := 0;

 FAnswerChecked := false;
 OnTerminate := CleanUpThread;

 if not CreateSuspended then
   Resume;
end;

procedure TAKRThread.Execute;
Var CurrentState : TComStat;
   AvaibleBytes, ErrCode, RealRead : Cardinal;
   ReadOL : TOverLapped;
   Signaled, Mask : DWORD;
   BytesTrans : DWORD;

   TmpPackage: TReadPackage;
Begin
 if WriteAKRComand then
 Try
   FillChar(ReadOL, SizeOf(ReadOL), 0);
   ReadOL.hEvent:= CreateEvent(nil, True, True, nil);
   SetCommMask(FPortHandle, EV_RXCHAR);
   while (not Terminated) do
   begin
     WaitCommEvent(FPortHandle, Mask, @ReadOL);
     Signaled:= WaitForSingleObject(ReadOL.hEvent, 1000);
     if (Signaled  = WAIT_OBJECT_0)and
       GetOverlappedResult(FPortHandle, ReadOL, BytesTrans, False) then
     begin
       If (Mask and EV_RXCHAR) <> 0 then
       begin
         ClearCommError(FPortHandle, ErrCode, @CurrentState);
         AvaibleBytes:= CurrentState.cbInQue;
         if (AvaibleBytes > 0) and
           ReadFile(FPortHandle, TmpPackage, AvaibleBytes, RealRead, @ReadOL) then
             CheckBytes(TmpPackage,AvaibleBytes);
       End;
     end
     else
       RepeatAKRComand;
   End;
 Finally
   CloseHandle(ReadOL.hEvent);
   SetCommMask(FPortHandle, 0);
 End;
End;

procedure TAKRThread.CheckBytes(TmpPackage: TReadPackage; Count: Word);
var
 i: integer;
 AnswerPackage: TAKRPackage;
begin
 for i := 1 to Count do
 begin
   SetLength(FStackPackage,Length(FStackPackage)+1);
   FStackPackage[Length(FStackPackage)-1] := TmpPackage[i];
 end;

 if ExtractAnswerPackage(FStackPackage,AnswerPackage) then
   if CheckTheAnswer(AnswerPackage) then
     SendAnswer
   else
     RepeatAKRComand;
end;

procedure TAKRThread.OpenPort(ComNumber: Integer);
Var
 ComName : String;
Begin
ComName:= Format("\\.\COM%-d", [ComNumber]);
FPortHandle:= CreateFile(
           PChar(ComName), GENERIC_READ or GENERIC_WRITE,
           0, nil, OPEN_EXISTING,
           FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0) ;
ApplyComSettings;
end;

procedure TAKRThread.ClosePort;
begin
CloseHandle(FPortHandle);
FPortHandle:= INVALID_HANDLE_VALUE;
end;

...

end.

---

← →
Balkon   (2006-06-13 10:07) [23]

Создается и живет этот поток для обработки одной команды и ответа на нее.
Создается он в "буферном" потоке (обрабатывающем командную очередь):

FAKRThread := TAKRThread.Create(false,FOwner,ComNumber,FAnswerQueue,ComandPackage);
 FAKRThread.WaitFor;

---

← →
Сергей М. ©   (2006-06-13 10:13) [24]

см.
http://delphimaster.net/view/4-1149756324/
[14]

---

← →
Balkon   (2006-06-13 12:32) [25]

Переписал функцию записи команды в порт, проверяя результат
WriteFile и количества записанных байт.

function TAKRThread.WriteAKRComand: boolean;
var
 wParam,lParam: Integer;
 Signaled, RealWrite, BytesTrans : Cardinal;
 Success : boolean;
 WriteOL : TOverLapped; {структура для асинхронной записи}
begin
 {создание события для асинхронной записи}
 Result := false;
 FillChar(WriteOL, SizeOf(WriteOL), 0);
 WriteOL.hEvent:= CreateEvent(nil, True, True, nil);
 Try
   {начало асинхронной записи}
   Success := WriteFile(FPortHandle, FComandPackage, SizeOf(FComandPackage),
     RealWrite, @WriteOL) or (GetLastError = ERROR_IO_PENDING);
   if Success then
   begin
   {ожидания завершения асинхронной операции}
     Signaled:= WaitForSingleObject(WriteOL.hEvent, INFINITE);
     {получение результата асинхронной операции}
     Result := (Signaled = WAIT_OBJECT_0) and
       GetOverlappedResult(FPortHandle, WriteOL, BytesTrans, False) and
         (SizeOf(FComandPackage) = BytesTrans);
   end
   else
     raise Exception.Create("Ошибка записи команды: " + IntToStr(GetLastError));
 Finally
   CloseHandle(WriteOL.hEvent);{освобождение дескриптора события}
 End;
end;

и основную процедуру с чтением данных, проверяя результат ReadFile.

procedure TAKRThread.Execute;
Var CurrentState : TComStat;
   AvaibleBytes, ErrCode, RealRead : Cardinal;
   ReadOL : TOverLapped;
   Signaled, Mask : DWORD;
   BytesTrans : DWORD;
   Success: Boolean;
   TmpPackage: TReadPackage;
Begin
 if WriteAKRComand then
 Try
   FillChar(ReadOL, SizeOf(ReadOL), 0);
   ReadOL.hEvent:= CreateEvent(nil, True, True, nil);
   SetCommMask(FPortHandle, EV_RXCHAR);
   while (not Terminated) do
   begin
     WaitCommEvent(FPortHandle, Mask, @ReadOL);
     Signaled:= WaitForSingleObject(ReadOL.hEvent, 1000);
     if (Signaled  = WAIT_OBJECT_0) and
       GetOverlappedResult(FPortHandle, ReadOL, BytesTrans, False) then
     begin
       If (Mask and EV_RXCHAR) <> 0 then
       begin
         ClearCommError(FPortHandle, ErrCode, @CurrentState);
         AvaibleBytes:= CurrentState.cbInQue;
         if (AvaibleBytes > 0) then
         begin
           Success := ReadFile(FPortHandle, TmpPackage, AvaibleBytes, RealRead, @ReadOL)
             or (GetLastError = ERROR_IO_PENDING);
           if Success then
             CheckBytes(TmpPackage,AvaibleBytes)
           else
             raise Exception.Create("ошибка чтения данных: " + IntToStr(GetLastError));
         end;
       End;
     end
     else
       RepeatAKRComand;
   End;
 Finally
   CloseHandle(ReadOL.hEvent);
   SetCommMask(FPortHandle, 0);
 End;
End;

Учтены ли таким образом замечания по Read/WriteFile?
>>Отсутствует анализ результатов, возвращаемых ф-циями Read/WriteFile, WaitCommEvent

Не совсем понятно как проверять результат WaitCommEvent, возращаемый результат аналогичным Read/WriteFile образом?

---

← →
Сергей М. ©   (2006-06-13 12:55) [26]

> Учтены ли таким образом замечания по Read/WriteFile?


Учтены, но логически неверно.

Если ReadFile() вернула False (код ошибки ERROR_IO_PENDING), бессмысленно вызывать CheckBytes(), ибо операция чтения не завершена (находится в стадии выполнения).

В противном случае CheckBytes() следует вызывать со вторым параметром, равным RealRead (фактически прочитанное число байт), а не AvaibleBytes (ожидаемое к прочтению число байт).

Возбуждение исключения в поточной ф-ции без предусмотренной его последующей обязательной обработки недопустимо. В простейшем случае тело метода Execute() следует заключить в try..except - блок, дабы избежать непредсказуемых последствий.

Результат вызова WaitCommEvent() следует обрабатывать похожим образом, в справке это описано.

---

← →
Balkon   (2006-06-13 13:23) [27]

Спасибо большое!
Разбираюсь дальше...

---

Страницы: 1 вся ветка

Текущий архив: 2006.07.02;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.045 c