Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Memorija zauzeta Objektom

[es] :: Pascal / Delphi / Kylix :: Memorija zauzeta Objektom

[ Pregleda: 1987 | Odgovora: 15 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

emastergam
Student, FTN , Proizvodno masinstvo, CIM
Zrenjanin

Član broj: 215529
Poruke: 4
212.200.214.*



Profil

icon Memorija zauzeta Objektom09.03.2009. u 22:30 - pre 185 meseci
Imam klasu izvedenu od TOject koja pored procedura sadrzi dvodimenzionalne matrice pointera i objekata (koji sadrze druge objekte). Zanima me kako da dobijem ili izracunam koliko memorije moj glavni objekat zauzima sa svim podobjektima i matricama. Ovo mi treba da bi ogranicio kolicinu memorije koju koristi sam objekt (jel jedan objekt moze da zauzme do 5gb memorije ako se ne koristi kako treba a ja planiram da koristim nekoliko 2xmatrica od po 255x255 ovih objekata )
Probao sam sa InstanceSize al on vraca samo zauzetu memoriju za objekt bez podobjekata (svi objekti su pretstavljeni pointerom kao i matrice).
Probao i da uzmem AllocMemSize pre i posle procedure ali to nije dobro jel moze da se ubaci nesto izmedju (u slucaju nekog multitreada) pa da pokupim i njegovu velicinu pa ce mi unistiti celu kalkulaciju i dati pogresan rezultat.
Probao i da napravim svoju proceduru koja racuna velicine svih elemenata ponaosob. Cak sam koristio i CPU view i cackao po memoriji da vidim gde su koji delovi objekta i uvek dobijem manju vrednost nego sto pokaze AllocMemSize. Da stvar bude gora pri koriscenju 256x256 objekata izgubim i po 1mb memorije . Sto je veca matrica gubitci su sve veci. Mozda zbog fragmentacije u memoriji il ko zna cega !
Probao i ovo i ono i smorio se na smrt pa se setio da nisam jedini i da se i drugi bave ovom rabotom pa reko da ih pitam da pripomognu.
Ako je sta jasno odgovarajte ako nije objasnjavacu josh samo pomagajte.
Imali neko iskustva s ovim? Neka komponenta forum, predlog?

Delphi 7, Windows XP (Pnđer XP )
Hvala!
Nepismen
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.dial-up.dsl.siol.net.



+14 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 00:31 - pre 185 meseci
>kako da dobijem ili izracunam koliko memorije moj glavni objekat zauzima sa svim podobjektima i matricama.
Tako nesto ces tesko izvesti bez custom memory manager-a. Pogledaj FastMM ili nesto slicno, mozda to moze da ti pomogne, mada sumnjam.

>Da stvar bude gora pri koriscenju 256x256 objekata izgubim i po 1mb memorije
Vise memorije se zauzima zato sto je Delphi memory manager malo neefikasan (ali zato brz), zbog align-a, fragmentacije i ostalih zezalica. Veoma je bitan nacin na koji zauzimas ram, tj. uposte nije isto ako alociras niz clan-po-clan i kada alociras blok velicine BrojClanova * SizeOf(Clan), jer u prvom slucaju memorija je verovatno fragmentovana a u drugom je kontinualna i kompaktna (contiguous). Drugi nacin zahteva malo vise koda i paznje ali je zato daleko efikasniji.

Ako su ti podobjekti samo pointeri a ne reference (znaci AllocMem, ne TObject.Create) mozes da umesto AllocMem napravis svoj wrapper za alokaciju memorije koji ce pri svakoj alokaciji da alociranu kolicinu rama zapise u neku internu tabelu formata (Name,Size), onda ti je kolicina zauzete memorije = InstanceSize + SumOf(Name).
if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

savkic
Igor Savkić

Moderator
Član broj: 92186
Poruke: 2739



+92 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 02:17 - pre 185 meseci
> Imam klasu izvedenu od TOject koja pored procedura sadrzi dvodimenzionalne matrice pointera i objekata (koji sadrze druge objekte). Zanima
> me kako da dobijem ili izracunam koliko memorije moj glavni objekat zauzima sa svim podobjektima i matricama.

Pretpostavljam da imaš načina da dođeš do svih postojećih objekata? Napravi jednu rekurzivnu metodu koja će proći kroz sve objekte i podobjekte i zbrajati osnovnu veličinu objekta i njegovih podobjekata kao i drugih struktura koe koristi (ako sam te shvatio, svaki objekat ima neki niz ili nešto slično).

> Ovo mi treba da bi ogranicio kolicinu memorije koju koristi sam objekt (jel jedan objekt moze da zauzme do 5gb memorije ako se ne koristi
> kako treba a ja planiram da koristim nekoliko 2xmatrica od po 255x255 ovih objekata )

Možeš li malo da razjasniš koji su to podaci koje čuvaš kada mogu dostići 5GB, vrlo verovatno se mogu efikasnije organizovati.
 
Odgovor na temu

Rapaic Rajko
Bgd

Član broj: 4105
Poruke: 810
93.86.158.*



+62 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 09:57 - pre 185 meseci
Citat:
Imam klasu izvedenu od TOject koja pored procedura sadrzi dvodimenzionalne matrice pointera i objekata (koji sadrze druge objekte)


Da li su svi ovi objekti TVOJE, to jest izvedene klase? Da li si ih sve izveo od neke (opet tvoje) root klase?

Ako DA, napravi virtuelnu metodu na prvom ancestoru (ako postoji jedinstveni/root ancestor) koja treba da vraca zauzece memorije date instance. Zatim, u svakom nasledniku/klasi radis override te metode, znaci neki tvoj objekat treba da ume da izracuna sopstveno zauzece sa svim svojim podobjektima.

Ukoliko nemas jedinstvenog/root ancestora, mozes da napravis Delphi interface sa metodom GetOwnMem, koji ces pridruziti svim tvojim klasama

Code:

  IGetMem = interface
    function GetOwnMem: integer;
  end;

  TMyClass = class(TPersistent, IGetMem)
    ...
  end;


Sad kad razmislim ima mnogo nacina da se ovo uradi.
Medjutim, metod koji sam opisao vraca samo velicinu KORISNE memorije, ne i stvarne (gornja prica o fragmentaciji itd.itd.).
I jos nesto, ako ikako mozes izbegni nizove i koristi dinamicko alociranje record-a (ili kreiranje objekta) i TList klasu, jer se moze desiti da te sistem odbije - mnogo je lakse dati 1GB RAM-a u parcicima, nego u komadu...

Rajko
 
Odgovor na temu

emastergam
Student, FTN , Proizvodno masinstvo, CIM
Zrenjanin

Član broj: 215529
Poruke: 4
79.101.140.*



Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 12:30 - pre 185 meseci
Citat:
Boris B.:Ako su ti podobjekti samo pointeri a ne reference...

Uglavnom 2xmatrice referenci (TObject.Create)
Citat:
savkic: Pretpostavljam da imaš načina da dođeš do svih postojećih objekata? Napravi jednu rekurzivnu metodu koja će proći kroz sve objekte i podobjekte i zbrajati osnovnu veličinu objekta i njegovih podobjekata kao i drugih struktura koe koristi (ako sam te shvatio, svaki objekat ima neki niz ili nešto slično).

Probao sam to al uvek dobijem manju vrednost od one iz AllocMemSize. Dole je procedura.
Citat:
Rapaic Rajko: Da li su svi ovi objekti TVOJE, to jest izvedene klase? Da li si ih sve izveo od neke (opet tvoje) root klase?

Nisu sve klase moje.
Citat:
savkic:Možeš li malo da razjasniš koji su to podaci koje čuvaš kada mogu dostići 5GB, vrlo verovatno se mogu efikasnije organizovati.

Imam maksimalno 256 pravaca u kojima se slika pojavljuje, svaki pravac moze da ima 256 slika a svaka slika max HxW 256x256. Sve slike su 8bit bitmap. Takodje svaka slika ima svoju masku, status i heder. To dodje negde oko 5gb ako se koristi maksimalno (sto ce retko biti slucaj, realno se koristi 1 pravac i 8 slika ili 256 pravaca sa po 1 slikom dimenzija oko 40x40) pa ocu da znam koliko memorije koristim da mogu da zabranim unos novih slika ako objekt koristi vise od recimo 10mb.
Evo jos malo informacija koje bi mozda mogle da pomognu.
Code:

  TFramesList = array of array of TByteMap; // Graphig32 mapa bytova velicine HxW. Koristim je kao 256color bitmap uz pomoc palete (koja nema veze sa mojim objektom, eksterna je).
  TFramesHeader = array of array of THeader_Frame; //2xmatrica obicanih rekord. 8xCardinal.
  THeaderStatus = record
    StatusMain   : TDC6_HeaderStatus_Main; // Set od 7 elemenata.
    StatusFrames : TDC6_FramesStatus;// 2xmatrica setova od 6 elemenata.
  end;
TMasksList = array of array of TBitsMap; //2xmatrica. Izvedeno od TBooleanMap iz Grapgic32. Mapa boolova koristim je za masku pri iscrtavanju bitmapa.

TMy_Decoder = class (TObject)  
    FHeader_Main   : THeader_Main;  //Rekord. 6xCardinal +1 Dinamicki niz Cardinala(maximalna duzine koju cu koristit je 256x256 elemenata. Realno koristim oko 100).
    FHeader_Frame  : TFramesHeader;  
    FHeaderStatus  : THeaderStatus;
    FDecoderStatus : TStatus_Decoder; // Set od 7 elemenata.
    FFrames        : TFramesList;      
    FMasks         : TMasksList;       
    ...
Evo kako sam pokusao da resim problem:
Code:
procedure TMyDecoder.CalculateOcupatedSpace;
var I,II:Integer;
begin
{Sam object + THeader_Main}
    FMemory_Used:=InstanceSize;
    FMemory_Used:=FMemory_Used+Length(FHeader_Main.Offsets)*4;
    FMemory_Used:=FMemory_Used+Length(FHeader_Frame)*(Length(FHeader_Frame[0])+1)*SizeOf(THeader_Frame);
{Zauzeto TFramesList}
    for I:=0 to Length(FFrames)-1 do
    for II:=0 to Length(FFrames[I])-1 do
      begin 
      // Velicina slike+Objekt
      FMemory_Used:=FMemory_Used+(FFrames[I,II].Width*FFrames[I,II].Height)+FFrames[I,II].InstanceSize;
      end;
    FMemory_Used:=FMemory_Used+(Length(FFrames)*(Length(FFrames[0])+1))*4;
{Zauzeto TMasksList}
    for I:=0 to Length(FMasks)-1 do
    for II:=0 to Length(FMasks[I])-1 do
      begin
      // Velicina maske u bajtovima+Objekt
      FMemory_Used:=FMemory_Used+Ceil(FMasks[I,II].Width*FMasks[I,II].Height/8)+FMasks[I,II].InstanceSize;
      end;
    FMemory_Used:=FMemory_Used+(Length(FMasks)*(Length(FMasks[0])+1))*4;
{Zauzeto THeaderStatus}
    for I:=0 to Length(FHeaderStatus.StatusFrames)-1 do
    for II:=0 to Length(FHeaderStatus.StatusFrames[I])-1 do
      begin
      FMemory_Used:=FMemory_Used+(SizeOf(FHeaderStatus.StatusFrames[I,II]));
      end;
    FMemory_Used:=FMemory_Used+(Length(FHeaderStatus.StatusFrames)*(Length(FHeaderStatus.StatusFrames[0])+1))*SizeOf(FHeaderStatus.StatusFrames);
{Ostali elementi}
    FMemory_Used:=FMemory_Used+SizeOf(FHeaderStatus.StatusMain);
    FMemory_Used:=FMemory_Used+SizeOf(FDecoderStatus);
end;

Znam da bi mogao da ustedim nesto memorije ako bi napravio rekord koji bi sadrzao sliku,masku i heder al trenutno to nije problem. Ova klasa jos nije prosla nikakve optimizacije. Stvarni problem je odrediti koliko je velika. Nisam probao FastMM al cu ga probati (danas ako stignem).
Ako ima nekih predloga ili ideja samo kazite.
Nepismen
 
Odgovor na temu

savkic
Igor Savkić

Moderator
Član broj: 92186
Poruke: 2739



+92 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 14:09 - pre 185 meseci
> Probao sam to al uvek dobijem manju vrednost od one iz AllocMemSize.

To je očekivano zbog fragmentacije memorije, npr. ako ti zatražiš 3KB bajta memory manager će alocirati recimo 4KB. Možeš probati sa FastMM koji je efikasniji u tim delovima. Verovatno možeš dobiti približnu veličinu alocirane memorije množenjem dobijene stvarne veličine sa nekim koeficijentom. Ključ za smanjenje upotrebe memorije je alociranje blokova koji su što bliži stvarnim potrebama kako bi se izbegla fragmentacija, recimo alociraš na početku za svaki osnovni objekat 50MB i onda svi podobjekti i slike koriste memoriju iz tog bloka.

Dalje nisam shvatio šta radiš sa svim tim slikama u memoriji, da li ti stalno treba svaka od njih, kolika je veličina jedne slike i koliko ih ukupno ima.


 
Odgovor na temu

Milan Milosevic

Član broj: 67
Poruke: 932
77.46.219.*



+31 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 15:38 - pre 185 meseci
Nisam bas citao detaljno ali mozda ovo moze da ti pomogne
uses
PsAPI;

function CurrentMemoryUsage: Cardinal;
var
pmc: TProcessMemoryCounters;
begin
pmc.cb := SizeOf(pmc) ;
if GetProcessMemoryInfo(GetCurrentProcess, @pmc, SizeOf(pmc)) then
Result := pmc.WorkingSetSize
else
RaiseLastOSError;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
caption:='Ova aplikacija trosi ovoliko memorije '+ inttostr(CurrentMemoryUsage);// ovo je u bajtovima
ShowMessage(FormatFloat('Iskoriscena Memorija: ,.# K', CurrentMemoryUsage / 1024)) ;
end;

[Ovu poruku je menjao Milan Milosevic dana 10.03.2009. u 19:15 GMT+1]
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.dial-up.dsl.siol.net.



+14 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 18:03 - pre 185 meseci
@Milan Milosevic
>Nisam bas citao detaljno ali mozda ovo moze da ti pomogne
To vraca velicinu WorkingSet-a procesa, tj. koliko rama je ukupno "otkinuto" od sistema, realna upotreba memorije je uvek daleko manja (mada svakako korisna informacija, jer upravo je to u krajnjoj liniji bitno )

@Rapajic Rajko
>Ukoliko nemas jedinstvenog/root ancestora, mozes da napravis Delphi interface sa metodom GetOwnMem, koji ces pridruziti svim tvojim klasama
Jos laksi i prljaviji nacin je koriscenje class helpera, jednostavno dopunis TObject i ne moras da izvodis svoje klase. Koriscenjem interfejsa bi morao da nasledi i dopuni svaku klasu ponaosob, a i to ne bi pomoglo ako klase imaju podklase, jer njihov kod pretpostavljam ne moze da menja. Class helperi naravno rade od D10 nagore.


Znaci kao sto sam napisao na pocetku, bez custom MM-a ces tesko postici to sto zelis. U tom cilju sam napisao jedan
Ovaj MM sabira ukupnu kolicinu alocirane memorije svih Delphi objekata (znaci i AllocMem i TObject.Create). Obavezno stavi MyMM kao prvi uses unit u dpr fajlu. Kolicniu zauzete memorije u svakom trenutku mozes da proveris sa MyMM.TotalSize. Samo pazi, MyMM prati samo Delphi memoriju, znaci egzotike tipa Ole objekti i WinAPI funkcije koje same alociraju ram otpadaju, ali to ti ni ne treba ako sam te dobro razumeo, svi tvoji objekti su 100% Delphi kod.

Code:

unit MyMM;

interface

function MyAlloc(Size: Integer): Pointer;
function MyFree(P: Pointer): Integer;
function MyRealloc(P: Pointer; Size: Integer): Pointer;

const MyMemMgr: TMemoryManager = (GetMem: MyAlloc; FreeMem: MyFree; ReallocMem: MyRealloc);

var
  TotalSize: Integer = 0;
  OldMM: TMemoryManager;

implementation

uses
  Windows, SysUtils;

function MyAlloc(Size: Integer): Pointer;
begin
  Result := OldMM.GetMem(Size);
  InterlockedExchangeAdd(TotalSize, Size);
end;

function MyFree(P: Pointer): Integer;
var
  Size: Integer;
begin
  Size := SizeOf(P);
  Result := OldMM.FreeMem(P);
  InterlockedExchangeAdd(TotalSize, -Size);
end;

function MyRealloc(P: Pointer; Size: Integer): Pointer;
var
  OldSize: Integer;
begin
  OldSize := SizeOf(P);
  Result := OldMM.ReallocMem(P, Size);
  InterlockedExchangeAdd(TotalSize, -OldSize);
  InterlockedExchangeAdd(TotalSize, Size);
end;

initialization
  GetMemoryManager(OldMM);
  SetMemoryManager(MyMemMgr);
end.



MyMM.TotalSize je obican var integer, znaci mozes i direktno da mu menjas vrednost, npr. postavis MyMM.TotalSize na nulu kad hoces i onda pratis kako se menja.


Edit: Popravio Inc i Dec pozive na InterlockedExchangeAdd

[Ovu poruku je menjao Boris B. dana 10.03.2009. u 19:30 GMT+1]
if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

Milan Milosevic

Član broj: 67
Poruke: 932
77.46.210.*



+31 Profil

icon Re: Memorija zauzeta Objektom10.03.2009. u 18:10 - pre 185 meseci
PA da koliko ti aplikacija trosi memorije ukupno.
Proveris pre kreiranja objekta, pa zatim posle kreiranja pa te dve vrednosti oduzmes. Na to sam mislio.
 
Odgovor na temu

Rapaic Rajko
Bgd

Član broj: 4105
Poruke: 810
93.86.158.*



+62 Profil

icon Re: Memorija zauzeta Objektom11.03.2009. u 09:38 - pre 185 meseci
Borise, ovaj red nece raditi kako si naumio

Code:

  OldSize := SizeOf(P);


Uvek ces dobiti vrednost 4 (bajta). Dugo radim u Delphi-ju, ali jos ne znam nacin nalazenja velicine memorije pridruzene pointeru...?

Rajko
 
Odgovor na temu

emastergam
Student, FTN , Proizvodno masinstvo, CIM
Zrenjanin

Član broj: 215529
Poruke: 4
93.86.79.*



Profil

icon Re: Memorija zauzeta Objektom11.03.2009. u 10:22 - pre 185 meseci
Citat:
savkic: Dalje nisam shvatio šta radiš sa svim tim slikama u memoriji, da li ti stalno treba svaka od njih, kolika je veličina jedne slike i koliko ih ukupno ima.
U jednom momentu mi treba samo 1 slika ali cesto dolazi do promene (kad je animacija u pitanju onda se brzo menjaju slike pa mi trebaju sva u memoriji). Sto se tice snimanja u neki fajl to bi me ubilo nacisto. Ili svaki objekt da ima svoj fajl ili da pravim neki fajl medadzer za sve objekte. Al onda imam vise posla oko menadzera nego oko samog objekta.
@Milan Milosevic: bas sam nasao tu proceduru i koristim je al to mi neresava problem oko zauzete memorije/objektu.
Citat:
Milan Milosevic: PA da koliko ti aplikacija trosi memorije ukupno.
Proveris pre kreiranja objekta, pa zatim posle kreiranja pa te dve vrednosti oduzmes. Na to sam mislio.

Trenutno koristim taj pristup i radi ok (uvek fali 80b al znam zasto). Problem je sto onda nije tread-safe. To mi sad nije vazno al uskoro ce biti.
@Boris B. Probacu taj mm. Trenutno se njakam sa FastMM.
Ako bude kakvih pomaka javicu. Hvala svima na pomoci.
Nepismen
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.dial-up.dsl.siol.net.



+14 Profil

icon Re: Memorija zauzeta Objektom11.03.2009. u 17:26 - pre 185 meseci
@Rajko
>Uvek ces dobiti vrednost 4 (bajta). Dugo radim u Delphi-ju, ali jos ne znam nacin nalazenja velicine memorije pridruzene pointeru...?
Potpuno si u pravu, oslobadjanje nisam ni probao, tek juce sam napisao svoj prvi MM (tj samo wrapper za stari) . Ali na svu srecu kad pises svoj MM imas punu kontrolu. Ionako bi morao da se dopuni jer se ne vid konkretno koje instance zauzimaju koliko rama, znaci morala bi da se vodi tabela za svaki alloc, pa bi tamo strpali i velicinu zauzetog bloka. Probacu da dopunim kod da pravilo oduzima oslobodjenu kolicinu i da vodi tabelu alokacija. Znam da FastMM to vec radi ali mi je zanimljivo...
if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

Milan Milosevic

Član broj: 67
Poruke: 932
79.101.76.*



+31 Profil

icon Re: Memorija zauzeta Objektom11.03.2009. u 17:50 - pre 185 meseci
Koji tip slika koristis. Ukoliko su Bitmape onda lako moze da se odredi koliko memorije nosi jedna slika date sirine visine
i tipa.
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.dial-up.dsl.siol.net.



+14 Profil

icon Re: Memorija zauzeta Objektom11.03.2009. u 20:18 - pre 185 meseci
Evo popravljeni memory manager. Sada se vodi tabela svih alokacija po thread-u koji je izvrsio alokaciju. Funkcija GetAllocatedSize kao parametar prima ThreadID i kao rezultat vraca ukupnu kolicinu memorije koju je alocirao taj thread. Ako se prosledi 0 vraca ukupnu kolicinu memorije svih thread-ova. Funkcija GetMySize vraca alociranu velicinu za pointer ili referencu, dok GetMemUsageList vraca tabelu kompletnog zauzeca rama.

Sada je veoma lako thread-safe odrediti velicinu kreiranih objekata zajedno sa svim podobjektima:

Code:

  Size := MyMM.GetAllocatedSize(GetCurrentThreadID);
  ...
  //kreiranje objekata
  ...
  Size := MyMM.GetAllocatedSize(GetCurrentThreadID) - Size;



Zbog jednostavnosti koda unit koristi Classes.TThreadList za vodjenje tabele alokacija. TThreadList ima nezgodnu osobinu da mora da raste (TThreadList.Grow) ako mu nestane mesta. Posto MyMM nije vlasnik te liste nego originalni MM, poziv Grow izazove a/v. Resenje je postavljanje kapaciteta liste pri kreiranju (AllocList.Capacity = 65535, initialize sekcija). Ako ce u aplikaciji biti vise od 65535 razlicitih alokacija (ne bajtova) onda je potrebno taj broj povecati. Alternativa bi bila koriscenje custom liste koja svoju memoriju alocira na neki drugi nacin (npr. HeapAllocate), mada bi i ovo trebalo da je dovoljno dobro za vecinu potreba.

Unit:

Code:

unit MyMM;

interface

uses
  Classes;

function MyAlloc(Size: Integer): Pointer;
function MyFree(P: Pointer): Integer;
function MyRealloc(P: Pointer; Size: Integer): Pointer;

function GetMemUsageList: String;
function GetMySize(var P): Integer;
function GetAllocatedSize(ThreadID: Cardinal = 0): Integer;

const MyMemMgr: TMemoryManager = (GetMem: MyAlloc; FreeMem: MyFree; ReallocMem: MyRealloc);

var
  OldMM: TMemoryManager;
  AllocList: TThreadList;

type
  PMemRec = ^TMemRec;
  TMemRec = record
    P: Pointer;
    Size: Integer;
    ThreadID: Cardinal;
  end;

implementation

uses
  Windows, SysUtils;

function FindRec(P: Pointer): PMemRec;
var
  I: Integer;
  Lst: TList;
begin
  Result := nil;
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
      if PMemRec(Lst[I]).P = P then
      begin
        Result := PMemRec(Lst[I]);
        break;
      end;
  finally
    AllocList.UnlockList;
  end;
end;

function MyAlloc(Size: Integer): Pointer;
var
  Rec: PMemRec;
begin
  Result := OldMM.GetMem(Size);
  Rec := OldMM.GetMem(SizeOf(TMemRec));
  Rec.Size := Size;
  Rec.P := Result;
  Rec.ThreadID := GetCurrentThreadId;
  AllocList.Add(Rec);
end;

function MyFree(P: Pointer): Integer;
var
  Rec: PMemRec;
begin
  Result := OldMM.FreeMem(P);
  Rec := FindRec(P);
  if Rec <> nil then
  begin
    AllocList.Remove(Rec);
    OldMM.FreeMem(Rec);
  end;
end;

function MyRealloc(P: Pointer; Size: Integer): Pointer;
var
  Rec: PMemRec;
begin
  Result := OldMM.ReallocMem(P, Size);
  Rec := FindRec(P);
  if Rec <> nil then
  begin
    Rec.P := Result;
    Rec.Size := Size;
    Rec.ThreadID := GetCurrentThreadId;
  end;
end;

function GetMemUsageList: String;
var
  I: Integer;
  Lst: TList;
  Rec: PMemRec;
begin
  Result := '';
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
    begin
      Rec := Lst[I];
      Result := Result + IntToHex(Integer(Rec.P), 8) + ': ' + IntToStr(Rec.Size) + ' b, ThreadID=' + IntToHex(Rec.ThreadID, 8) + #13#10;
    end;
  finally
    AllocList.UnlockList;
  end;
end;

function GetMySize(var P): Integer;
var
  Rec: PMemRec;
begin
  Rec := FindRec(Pointer(P));
  if Rec <> nil then
    Result := Rec.Size
  else
    Result := 0;
end;

function GetAllocatedSize(ThreadID: Cardinal = 0): Integer;
var
  Lst: TList;
  I: Integer;
begin
  Result := 0;
  Lst := AllocList.LockList;
  try
    for I := 0 to Lst.Count - 1 do
      if (ThreadID = 0) or (ThreadID = PMemRec(Lst[I]).ThreadID) then
        Inc(Result, PMemRec(Lst[I]).Size);
  finally
    AllocList.UnlockList;
  end;
end;

initialization
  AllocList := TThreadList.Create;
  AllocList.LockList.Capacity := 65536;
  AllocList.UnlockList;
  GetMemoryManager(OldMM);
  SetMemoryManager(MyMemMgr);

finalization
  SetMemoryManager(OldMM);
  AllocList.Free;
end.

if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

emastergam
Student, FTN , Proizvodno masinstvo, CIM
Zrenjanin

Član broj: 215529
Poruke: 4
93.86.77.*



Profil

icon Re: Memorija zauzeta Objektom13.03.2009. u 11:01 - pre 185 meseci
@Boris B.: Probao sam tvoj MM I radi ok do 65k blokova (malo vise memorije pojede al to je zbog liste pointer). Imam malih problema al cu ih resiti (valjda).
Nego, pitanje za 3 bambija:
Ako komponenta koristi recimo MyMM a aplikacija (koja koristi tu komponentu) FastMM sta ce biti? Jel to moze? Da ne gubim vreme probavajuci ako neko zna ishod.
Nepismen
 
Odgovor na temu

Boris B.
Ljubljana

Član broj: 213615
Poruke: 286
*.dial-up.dsl.siol.net.



+14 Profil

icon Re: Memorija zauzeta Objektom13.03.2009. u 17:31 - pre 185 meseci
Tu sam i ja malo zbunjen. Po nekoj logici posto je MyMM samo wrapper za originalni MM trebalo bi da radi OK. Medjutim izgleda da nije tako, zbog pomenutog problema sa TList.Grow koji bi po toj logici trebalo da radi, medjutim daje a/v kada se pozove Grow tj. MemoryManager.ReallocMem. Sto je jos cudnije a/v se ne dobije unutar funkcije MyMM.MyRealloc nego pre tog poziva, odmah posle Grow (debugger u call stacku prikaze da je zadnji pokusan poziv neka f-ja @Realloc).

Edit:
Nasao sam zasto se desava a/v pri pozivu TList.Grow, dodje do beskonacne rekurzije (uprosceno receno), zbog konkretne implementacije D2007 memory manager-a koji je u stvari FastMM. Stvar radi kada se koristi Capacity = xxx u initialize sekciji i verovatno nije ni potrebna na starijim Delphijima koji ne koriste FastMM kao default MM.

Nego da ja odgovorim na tvoje pitanje. Kad se ucita komponenta izvrsice se initialize sekcija od MyMM unita, znaci zamenice se MM. Posto je MyMM samo wrapper za stari MM, i posto je prostor za MyMM.AllocList zauzet pre zamene MM-a, onda bi stvar trebalo da radi normalno. Side-effect je taj da ce onda i glavna aplikacija nadalje koristi MyMM kao svoj MM, a posto ti, kao pisac komponente, ne znas koliko ce alokacija izvrsavati glavna aplikacija moze da se desi da probije barijeru od 65k alokacija, i eto problema. Zato ih je bolje ne mesati

[Ovu poruku je menjao Boris B. dana 13.03.2009. u 19:32 GMT+1]
if it walks like a duck and quacks like a duck, it could be a dragon doing a duck
impersonation.
 
Odgovor na temu

[es] :: Pascal / Delphi / Kylix :: Memorija zauzeta Objektom

[ Pregleda: 1987 | Odgovora: 15 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.