paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 09:21:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed 1.0.10 compilation from Vincent

Browse Source 
git-svn-id: trunk@6286 -
This commit is contained in:
mattias 2004-11-22 23:24:24 +00:00
parent 077dc198ca
commit 7e3ba11449
2 changed files with 63 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
components/codetools/memcheck.pas
View File

@ -880,23 +880,41 @@ procedure dumpheap;
var var
pp : pheap_mem_info; pp : pheap_mem_info;
i : ptrint; i : ptrint;
{$IFDEF HASGETHEAPSTATUS}
ExpectedHeapFree : ptrint;
status : THeapStatus;
{$ELSE}
ExpectedMemAvail : ptrint; ExpectedMemAvail : ptrint;
{$ENDIF}
begin begin
pp:=heap_mem_root; pp:=heap_mem_root;
Writeln(ptext^,'Heap dump by heaptrc unit'); Writeln(ptext^,'Heap dump by heaptrc unit');
Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size); Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
Writeln(ptext^,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_size); Writeln(ptext^,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_size);
Writeln(ptext^,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size); Writeln(ptext^,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size);
{$IFDEF HASGETHEAPSTATUS}
SysGetHeapStatus(status);
Write(ptext^,'True heap size : ',status.CurrHeapSize);
{$ELSE}
Write(ptext^,'True heap size : ',system.HeapSize); Write(ptext^,'True heap size : ',system.HeapSize);
{$ENDIF}
if EntryMemUsed > 0 then if EntryMemUsed > 0 then
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)') Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
else else
Writeln(ptext^); Writeln(ptext^);
{$IFDEF HASGETHEAPSTATUS}
Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
ExpectedHeapFree:=status.CurrHeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
If ExpectedHeapFree<>status.CurrHeapFree then
Writeln(ptext^,'Should be : ',ExpectedHeapFree);
{$ELSE}
Writeln(ptext^,'True free heap : ',MemAvail); Writeln(ptext^,'True free heap : ',MemAvail);
ExpectedMemAvail:=system.HeapSize-(getmem8_size-freemem8_size)- ExpectedMemAvail:=system.HeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed; (getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
If ExpectedMemAvail<>MemAvail then If ExpectedMemAvail<>MemAvail then
Writeln(ptext^,'Should be : ',ExpectedMemAvail); Writeln(ptext^,'Should be : ',ExpectedMemAvail);
{$ENDIF}
i:=getmem_cnt-freemem_cnt; i:=getmem_cnt-freemem_cnt;
while pp<>nil do while pp<>nil do
begin begin
@ -963,6 +981,12 @@ end;
No specific tracing calls No specific tracing calls
*****************************************************************************} *****************************************************************************}
{$IFDEF HASGETHEAPSTATUS}
procedure TraceGetHeapStatus(var status:THeapStatus);
begin
SysGetHeapStatus(status);
end;
{$ELSE}
function TraceMemAvail:ptrint; function TraceMemAvail:ptrint;
begin begin
TraceMemAvail:=SysMemAvail; TraceMemAvail:=SysMemAvail;
@ -977,6 +1001,7 @@ function TraceHeapSize:ptrint;
begin begin
TraceHeapSize:=SysHeapSize; TraceHeapSize:=SysHeapSize;
end; end;
{$ENDIF}
{***************************************************************************** {*****************************************************************************
@ -1027,15 +1052,28 @@ const
AllocMem : @TraceAllocMem; AllocMem : @TraceAllocMem;
ReAllocMem : @TraceReAllocMem; ReAllocMem : @TraceReAllocMem;
MemSize : @TraceMemSize; MemSize : @TraceMemSize;
{$IFDEF HASGETHEAPSTATUS}
GetHeapStatus : @TraceGetHeapStatus;
{$ELSE}
MemAvail : @TraceMemAvail; MemAvail : @TraceMemAvail;
MaxAvail : @TraceMaxAvail; MaxAvail : @TraceMaxAvail;
HeapSize : @TraceHeapsize; HeapSize : @TraceHeapsize;
{$ENDIF}
); );
procedure TraceInit; procedure TraceInit;
{$IFDEF HASGETHEAPSTATUS}
var
initheapstatus : THeapStatus;
{$ENDIF}
begin begin
{$IFDEF HASGETHEAPSTATUS}
SysGetHeapStatus(initheapstatus);
EntryMemUsed:=initheapstatus.CurrHeapUsed;
{$ELSE}
EntryMemUsed:=System.HeapSize-MemAvail; EntryMemUsed:=System.HeapSize-MemAvail;
{$ENDIF}
MakeCRC32Tbl; MakeCRC32Tbl;
SetMemoryManager(TraceManager); SetMemoryManager(TraceManager);
ptext:=@stderr; ptext:=@stderr;
@ -2321,6 +2359,9 @@ end.
{ {
$Log$ $Log$
Revision 1.37 2004/11/22 23:24:24 mattias
fixed 1.0.10 compilation from Vincent
Revision 1.36 2004/11/10 15:25:32 mattias Revision 1.36 2004/11/10 15:25:32 mattias
updated memcheck.pas from heaptrc.pp updated memcheck.pas from heaptrc.pp

28
designer/jitforms.pp
View File

@ -261,7 +261,7 @@ var
i: Integer; i: Integer;
begin begin
for i:=0 to 1000 do begin for i:=0 to 1000 do begin
if PPointer(AClass)[i]=MethodPointer then begin if PPointer(pointer(AClass))[i]=MethodPointer then begin
Result:=i*SizeOf(Pointer); Result:=i*SizeOf(Pointer);
exit; exit;
end; end;
@ -313,17 +313,33 @@ begin
Designer.ValidateRename(AComponent, CurName, NewName); Designer.ValidateRename(AComponent, CurName, NewName);
end; end;
{$IFDEF VER1_0}
type
TMyComponent = class(TComponent)
function GetValidateRenameAddress: pointer;
end;
{ TMyComponent }
function TMyComponent.GetValidateRenameAddress: pointer;
begin
Result := @ValidateRename;
end;
{$ENDIF}
function GetTComponentValidateRenameVMTOffset: integer; function GetTComponentValidateRenameVMTOffset: integer;
begin begin
Result:=GetVMTVirtualMethodOffset(TComponent,@TComponent.ValidateRename, Result:=GetVMTVirtualMethodOffset(TComponent,
{$IFNDEF VER1_0}@TComponent.ValidateRename
{$ELSE}@TMyComponent.GetValidateRenameAddress{$ENDIF},
TComponentWithOverrideValidateRename, TComponentWithOverrideValidateRename,
@TComponentWithOverrideValidateRename.ValidateRename); @TComponentWithOverrideValidateRename.ValidateRename);
end; end;
var var
MyFindGlobalComponentProc:function(const AName:AnsiString):TComponent of object; MyFindGlobalComponentProc:function(const AName: AnsiString): TComponent of object;
function MyFindGlobalComponent(const AName:AnsiString):TComponent; function MyFindGlobalComponent(const AName: AnsiString): TComponent;
begin begin
Result:=MyFindGlobalComponentProc(AName); Result:=MyFindGlobalComponentProc(AName);
end; end;
@ -941,8 +957,8 @@ begin
// set vmtTypeInfo // set vmtTypeInfo
TypeDataSize:=SizeOf(TTypeData)+2; // TTypeData + one word for new prop count TypeDataSize:=SizeOf(TTypeData)+2; // TTypeData + one word for new prop count
TypeInfoSize:=SizeOf(TTypeInfo.Kind)+1+length(NewClassName)+TypeDataSize; TypeInfoSize:=SizeOf(TTypeKind)+1+length(NewClassName)+TypeDataSize;
if SizeOf(TTypeInfo.Kind)<>1 then if SizeOf(TTypeKind)<>1 then
raise Exception.Create('CreateNewClass SizeOf(TTypeInfo^.Kind)<>1'); raise Exception.Create('CreateNewClass SizeOf(TTypeInfo^.Kind)<>1');
GetMem(NewTypeInfo,TypeInfoSize); GetMem(NewTypeInfo,TypeInfoSize);
FillChar(NewTypeInfo^,TypeInfoSize,0); FillChar(NewTypeInfo^,TypeInfoSize,0);