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

Вниз

Out of memory при создании экземпляра объекта   Найти похожие ветки 

← →
31512 ©   (2010-10-31 09:50) [0]

Здравствуйте, Уважаемые. Может кто-нибудь сталкивался со странным поведением программы, когда при очередном создании экземпляра объекта возникает ошибка Out of memory?
Суть такая: имеется класс

TClaster = class
...
end;


При создании одного экземпляра всё ок. Всё работает.
Но следующий тестовый код выдаёт Out of memory:

var
c1, c2, c3 : TClaster;
begin
 c1 := TClaster.Create;
 c2 := TClaster.Create;
 c3 := TClaster.Create;
end;

при создании c2. Если в цикле выполнять следующее:

 for i := 0 to 100 do
 begin
   AClaster := TClaster.Create;
   AClaster.Load("...");
   ...
   FreeAndNil(AClaster);
 end;

то тоже всё работает хорошо. Ошибка возникает ещё до выполнения тела конструктора. Никаких действий с динамическим выделением памяти я не выполняю. Экспериментальным путём выявил, что успешно создаются 2 первых экземпляра, а на третьем всегда падение.
Использую Delphi XE, Windows Vista.

---

← →
Игорь Шевченко ©   (2010-10-31 09:57) [1]

> ...


тут ошибка

---

← →
31512 ©   (2010-10-31 11:20) [2]

> Игорь Шевченко ©   (31.10.10 09:57) [1]

Да, понимаю. Подробно отвечу на уточняющие вопросы...

 TArray3ofExtended = array[0..2] of extended;
 TArray3x3ofExtended = array[0..2, 0..2] of extended;
 TTransformMatrix = TArray3x3ofExtended;
 TTensor = TArray3x3ofExtended;
 TInertTensor = TArray3x3ofExtended;
 TContactTable = array of array of Extended;
 TMainInertTensor = record
                      Ix, Iy, Iz : Extended;
                    end;

 TVectorAsArray = TArray3ofExtended;

 TPoint3D = packed record
   X, Y, Z : extended;
 end;

 TVector = packed record
   Vx : extended;
   Vy : extended;
   Vz : extended;
 end;

 TClaster = class
 private
   FItems : TClasterItems;
   FSorts : TClasterItemSorts;
   FSize: extended;
   FWorldCenter: TPoint3D;
   FSummMr: TVector;
   FNumParticles: integer;
   FID: word;
   FPhForceMoment: TVector;
   FPhForce: TVector;
   FIMain: TTensor;
   FStartPsi: extended;
   FStartTheta: extended;
   FStartPhi: extended;
   FPhForceLocal: TVector;
   ThreadList : TPointerList;
   FClasterStatistics: TClasterStatistics;
   function GetItem(index: integer): TClasterItem;
   procedure SetItem(index: integer; const Value: TClasterItem);
   function GetCountItems: integer;
   function GenerateClasterItem : TClasterItem;
   function GetSecondItem : TClasterItem;
   function GetFractalDimension: extended;
   function GetMatrixSinCos(SinTeta, CosTeta, SinFi, CosFi: extended): TTransformMatrix;
   function GetRandomSourceE : TSourceVector;
   function GetContact(const E : TSourceVector; var Index: integer; AItem : TClasterItem) : TContactPoint;
   function GetMassCenter: TVector;
   procedure SetNumParticles(const Value: integer);
   function GetInertTensor: TInertTensor;
//    function GetRealMassCenter: TVector;
   procedure SetID(const Value: word);
   function GetR0: extended;
   procedure SetPhForce(const Value: TVector);
   procedure SetPhForceMoment(const Value: TVector);
//    procedure RecalcSummMr;
   procedure SetPhForceLocal(const Value: TVector);
   procedure CollectData;
   function GetMass: extended;
   function GetVolume: extended;
   procedure SetClasterStatistics(const Value: TClasterStatistics);
   procedure ClearStatistics;
 public
   constructor Create;
   destructor Destroy; override;
   function ItemInfoToSurfaceInfo(const ItemIndex : integer) : TSurfaceInfo;
   procedure BuildClaster;
   procedure BuildNextItem;
   procedure Clear;
   procedure MoveToCenter;
   procedure SetBiSpherical;
   procedure SetThreeSpherical(var MinBeta : extended; const ARadius, Beta : Extended; const AccCoef : Extended = 0.74; const Rate : Extended = 1.00);
   procedure Save(const AFileName : string);
   procedure Load(const AFileName : string);
   procedure LoadStatistics(const AFileName : string);
   procedure RotateClaster(const Phi, Theta, Psi : extended);
   procedure ResetClaster;
   procedure TransformClaster(const ATM : TTransformMatrix);
   procedure RunStatistics(const N : UInt64);
   function GetContactTable : TContactTable;
   property Item[index : integer] : TClasterItem read GetItem write SetItem;default;
   property Items : TClasterItems read FItems;
   property CountItems : integer read GetCountItems;
   property Size : extended read FSize;
   property Mass : extended read GetMass;
   property Summ_Mr : TVector read FSummMr;
   property Volume : extended read GetVolume;
   property MassCenter : TVector read GetMassCenter;
   property FractalDimension : extended read GetFractalDimension;
   property WorldCenter : TPoint3D read FWorldCenter;
   property Sorts : TClasterItemSorts read FSorts;
   property NumParticles : integer read FNumParticles write SetNumParticles;
   property InertTensor : TInertTensor read GetInertTensor;
   property ID : word read FID write SetID;
   property R0 : extended read GetR0;
   property PhForce : TVector read FPhForce write SetPhForce;
   property PhForceLocal : TVector read FPhForceLocal write SetPhForceLocal;
   property PhForceMoment : TVector read FPhForceMoment write SetPhForceMoment;
   property IMain : TTensor read FIMain;
   property StartPhi   : extended read FStartPhi;
   property StartTheta : extended read FStartTheta;
   property StartPsi   : extended read FStartPsi;
   property ClasterStatistics : TClasterStatistics read FClasterStatistics write SetClasterStatistics;
 end;

constructor TClaster.Create;
var
AColor : TSortColor;
begin
inherited Create;

FSorts := TClasterItemSorts.Create;
FSorts.Add(TClasterItemSort.Create);

AColor.R := 0.5;
AColor.G := 0.5;
AColor.B := 0.5;
AColor.A := 1.00;

FSorts[0].Color := AColor;

FItems := TClasterItems.Create;
FSize  := 0.00;
FSummMr.Vx := 0.00;
FSummMr.Vy := 0.00;
FSummMr.Vz := 0.00;
FWorldCenter.X := 0.00;
FWorldCenter.Y := 0.00;
FWorldCenter.Z := 0.00;

FPhForce.Vx := 0.00;
FPhForce.Vy := 0.00;
FPhForce.Vz := 0.00;

FPhForceMoment.Vx := 0.00;
FPhForceMoment.Vy := 0.00;
FPhForceMoment.Vz := 0.00;

FPhForceLocal.Vx := 0.00;
FPhForceLocal.Vy := 0.00;
FPhForceLocal.Vz := 0.00;

FStartPhi   := 0.00;
FStartTheta := 0.00;
FStartPsi   := 0.00;
end;



---

← →
Leonid Troyanovsky ©   (2010-10-31 12:09) [3]

> 31512 ©   (31.10.10 11:20) [2]

> Да, понимаю. Подробно отвечу на уточняющие вопросы...

Приводить надо код _необходимый_ и _достаточный_
для воспроизведения ошибки.

Кому охота глазеть на все эти TClasterItems и
думать, что это за function GetContactTable.

--
Regards, LVT.

---

← →
sniknik ©   (2010-10-31 12:10) [4]

проверь такой код, ошибка есть?
constructor TClaster.Create;
var
AColor : TSortColor;
begin
inherited Create;

{FSorts := TClasterItemSorts.Create;
FSorts.Add(TClasterItemSort.Create);

AColor.R := 0.5;
AColor.G := 0.5;
AColor.B := 0.5;
AColor.A := 1.00;

FSorts[0].Color := AColor;

FItems := TClasterItems.Create;
FSize  := 0.00;
FSummMr.Vx := 0.00;
FSummMr.Vy := 0.00;
FSummMr.Vz := 0.00;
FWorldCenter.X := 0.00;
FWorldCenter.Y := 0.00;
FWorldCenter.Z := 0.00;

FPhForce.Vx := 0.00;
FPhForce.Vy := 0.00;
FPhForce.Vz := 0.00;

FPhForceMoment.Vx := 0.00;
FPhForceMoment.Vy := 0.00;
FPhForceMoment.Vz := 0.00;

FPhForceLocal.Vx := 0.00;
FPhForceLocal.Vy := 0.00;
FPhForceLocal.Vz := 0.00;

FStartPhi   := 0.00;
FStartTheta := 0.00;
FStartPsi   := 0.00;}
end;

что такое TSortColor?

---

← →
31512 ©   (2010-10-31 12:49) [5]

> Приводить надо код _необходимый_ и _достаточный_
> для воспроизведения ошибки.

В том-то и дело, что ошибка происходит не в моём коде. В тело конструктора отладчик даже не заходит, а валится на первом же begin конструктора.
Если от begin пойти по F7 то происходит примерно следующее:

function _ClassCreate(AClass: TClass; Alloc: Boolean): TObject;
class function TObject.NewInstance: TObject;
class function TObject.InstanceSize: Longint;
function _GetMem(Size: Integer): Pointer;
function SysGetMem(Size: Integer): Pointer;
function AllocateLargeBlock(ASize: Cardinal): Pointer;
function VirtualAlloc(lpAddress: Pointer;
 dwSize, flAllocationType, flProtect: Cardinal): Pointer; stdcall;
procedure Error(errorCode: TRuntimeError);//errorCode = reOutOfMemory
procedure ErrorAt(ErrorCode: Byte; ErrorAddr: Pointer);
procedure ErrorHandler(ErrorCode: Byte; ErrorAddr: Pointer); export;
procedure RaiseExceptObject(P: PExceptionRecord);
function _IsClass(Child: TObject; Parent: TClass): Boolean;
class function TObject.InheritsFrom(AClass: TClass): Boolean;

Т.е. валится не мой код, а где-то до выполнения кода конструктора.
Чуть позже постараюсь сказать, где. А код необходимый и достаточный для воспроизведения ошибки я уже приводил:

var
c1, c2, c3 : TClaster;
begin
c1 := TClaster.Create;
c2 := TClaster.Create;
c3 := TClaster.Create;
end;

В том-то вся и штука, что не могу более чётко локализовать проблему.


> sniknik ©   (31.10.10 12:10) [4]

 TSortColor = packed record
   R,G,B,A : single;
 end;

---

← →
sniknik ©   (2010-10-31 13:04) [6]

> а валится на первом же begin конструктора.
что значит, что кодом до этого ты испортил память, точку входа.

> В том-то вся и штука, что не могу более чётко локализовать проблему.
я привел код который может помочь в локализации...

---

← →
clickmaker ©   (2010-10-31 13:05) [7]

что такое TClasterItemSorts? что там создается и как?

---

← →
Anatoly Podgoretsky ©   (2010-10-31 13:12) [8]

Один сплошной стон "а что такое ..."

---

← →
31512 ©   (2010-10-31 13:35) [9]

> clickmaker ©   (31.10.10 13:05) [7]


TClasterItemSorts = class(TList<TClasterItemSort>)
  private
   procedure ANotifier(Sender: TObject; const Item: TClasterItemSort;  Action: TCollectionNotification);
  public
   constructor Create;
   destructor Destroy;override;
   procedure Assign(const ASorts : TClasterItemSorts);
  end;

procedure TClasterItemSorts.ANotifier(Sender: TObject;
 const Item: TClasterItemSort; Action: TCollectionNotification);
begin
 case Action of
   cnAdded: begin end;
   cnRemoved: Item.Free;
   cnExtracted: begin end;
 end;
end;

procedure TClasterItemSorts.Assign(const ASorts: TClasterItemSorts);
var
AItem, CopyItem : TClasterItemSort;
begin
Clear;
for AItem in ASorts do
begin
 CopyItem := TClasterItemSort.Create;
 CopyItem.RadiusMax    := AItem.RadiusMax;
 CopyItem.RadiusMin    := AItem.RadiusMin;
 CopyItem.AlphaMax     := AItem.AlphaMax;
 CopyItem.AlphaMin     := AItem.AlphaMin;
 CopyItem.DensityMax   := AItem.DensityMax;
 CopyItem.DensityMin   := AItem.DensityMin;
 CopyItem.RefIdx_ReMax := AItem.RefIdx_ReMax;
 CopyItem.RefIdx_ReMin := AItem.RefIdx_ReMin;
 CopyItem.RefIdx_ImMax := AItem.RefIdx_ImMax;
 CopyItem.RefIdx_ImMin := AItem.RefIdx_ImMin;
 CopyItem.Color        := AItem.Color;
 CopyItem.Enabled      := AItem.Enabled;
 Add(CopyItem);
end;

end;

constructor TClasterItemSorts.Create;
begin
 inherited;
 OnNotify := ANotifier;
end;

destructor TClasterItemSorts.Destroy;
begin
 inherited;
end;



---

← →
31512 ©   (2010-10-31 13:40) [10]

> sniknik ©   (31.10.10 12:10) [4]


> sniknik ©   (31.10.10 13:04) [6]


> я привел код который может помочь в локализации...
>

Да, ошибка осталась :-(. Я это первым делом попробовал, перед обращением сюда. Потом долго гуглил, пытался разобраться.
Т.е. до inherited Create; даже не доходит. Валится раньше.

---

← →
31512 ©   (2010-10-31 13:43) [11]

> Anatoly Podgoretsky ©   (31.10.10 13:12) [8]

Ну ничего не поделаешь. Если бы смог подробно описать - описал бы.
Вся бяка в том, что первые да экземпляра создаются без проблем. Третий всегда валится. Если в программе, где-то уже создан экземпляр, то валится, соответственно, на втором. В этом-то и странность.

---

← →
sniknik ©   (2010-10-31 13:47) [12]

> Да, ошибка осталась :-(.
ну тогда следующий этап, код на проверку

TClaster = class
{private
  FItems : TClasterItems;
  FSorts : TClasterItemSorts;
  FSize: extended;
  FWorldCenter: TPoint3D;
  FSummMr: TVector;
  FNumParticles: integer;
  FID: word;
  FPhForceMoment: TVector;
  FPhForce: TVector;
  FIMain: TTensor;
  FStartPsi: extended;
  FStartTheta: extended;
  FStartPhi: extended;
  FPhForceLocal: TVector;
  ThreadList : TPointerList;
  FClasterStatistics: TClasterStatistics;
  function GetItem(index: integer): TClasterItem;
  procedure SetItem(index: integer; const Value: TClasterItem);
  function GetCountItems: integer;
  function GenerateClasterItem : TClasterItem;
  function GetSecondItem : TClasterItem;
  function GetFractalDimension: extended;
  function GetMatrixSinCos(SinTeta, CosTeta, SinFi, CosFi: extended): TTransformMatrix;
  function GetRandomSourceE : TSourceVector;
  function GetContact(const E : TSourceVector; var Index: integer; AItem : TClasterItem) : TContactPoint;
  function GetMassCenter: TVector;
  procedure SetNumParticles(const Value: integer);
  function GetInertTensor: TInertTensor;
//    function GetRealMassCenter: TVector;
  procedure SetID(const Value: word);
  function GetR0: extended;
  procedure SetPhForce(const Value: TVector);
  procedure SetPhForceMoment(const Value: TVector);
//    procedure RecalcSummMr;
  procedure SetPhForceLocal(const Value: TVector);
  procedure CollectData;
  function GetMass: extended;
  function GetVolume: extended;
  procedure SetClasterStatistics(const Value: TClasterStatistics);
  procedure ClearStatistics;
public
  constructor Create;
  destructor Destroy; override;
  function ItemInfoToSurfaceInfo(const ItemIndex : integer) : TSurfaceInfo;
  procedure BuildClaster;
  procedure BuildNextItem;
  procedure Clear;
  procedure MoveToCenter;
  procedure SetBiSpherical;
  procedure SetThreeSpherical(var MinBeta : extended; const ARadius, Beta : Extended; const AccCoef : Extended = 0.74; const Rate : Extended = 1.00);
  procedure Save(const AFileName : string);
  procedure Load(const AFileName : string);
  procedure LoadStatistics(const AFileName : string);
  procedure RotateClaster(const Phi, Theta, Psi : extended);
  procedure ResetClaster;
  procedure TransformClaster(const ATM : TTransformMatrix);
  procedure RunStatistics(const N : UInt64);
  function GetContactTable : TContactTable;
  property Item[index : integer] : TClasterItem read GetItem write SetItem;default;
  property Items : TClasterItems read FItems;
  property CountItems : integer read GetCountItems;
  property Size : extended read FSize;
  property Mass : extended read GetMass;
  property Summ_Mr : TVector read FSummMr;
  property Volume : extended read GetVolume;
  property MassCenter : TVector read GetMassCenter;
  property FractalDimension : extended read GetFractalDimension;
  property WorldCenter : TPoint3D read FWorldCenter;
  property Sorts : TClasterItemSorts read FSorts;
  property NumParticles : integer read FNumParticles write SetNumParticles;
  property InertTensor : TInertTensor read GetInertTensor;
  property ID : word read FID write SetID;
  property R0 : extended read GetR0;
  property PhForce : TVector read FPhForce write SetPhForce;
  property PhForceLocal : TVector read FPhForceLocal write SetPhForceLocal;
  property PhForceMoment : TVector read FPhForceMoment write SetPhForceMoment;
  property IMain : TTensor read FIMain;
  property StartPhi   : extended read FStartPhi;
  property StartTheta : extended read FStartTheta;
  property StartPsi   : extended read FStartPsi;
  property ClasterStatistics : TClasterStatistics read FClasterStatistics write SetClasterStatistics;}
end;


---

← →
31512 ©   (2010-10-31 14:36) [13]

> sniknik ©   (31.10.10 13:47) [12]

Если честно, то это я тоже пробовал. :-) Конечно же всё работает.
Только я создал

TTestClaster = class
private
  FClasterStatistics: TClasterStatistics;
public
  constructor Create;
end;


---

← →
31512 ©   (2010-10-31 14:40) [14]

Впрочем я уже догадываюсь где собака порылась :-D

---

← →
31512 ©   (2010-10-31 14:48) [15]

В пылу озабоченности деталями проекта наступил на грабли. :-) Хорошо, что сейчас это выявилось. Спасибо всем за помощь.
Обратил внимание на

TPointerList = array[0..MaxListSize - 1] of Pointer;

Объявленный в Classes.pas.
Темку можно закрыть. Как сказал А.С. Пушкин: "... И опыт, сын ошибок трудных..."

---

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

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

Наверх

Память: 0.53 MB
Время: 0.009 c