updated memcheck.pas and made it more easy to update

git-svn-id: trunk@5672 -

.gitattributes

@@ -47,6 +47,7 @@ components/codetools/laz_xmlwrite.pas svneol=native#text/pascal
 components/codetools/lfmtrees.pas svneol=native#text/pascal
 components/codetools/linkscanner.pas svneol=native#text/pascal
 components/codetools/memcheck.pas svneol=native#text/pascal
+components/codetools/memcheck_laz.inc svneol=native#text/pascal
 components/codetools/methodjumptool.pas svneol=native#text/pascal
 components/codetools/multikeywordlisttool.pas svneol=native#text/pascal
 components/codetools/pascalparsertool.pas svneol=native#text/pascal

components/codetools/memcheck_laz.inc

@@ -0,0 +1,145 @@
+{%MainUnit memcheck.pas}
+
+{$IFDEF MC_Interface}
+procedure CheckHeap;
+procedure CheckHeap(const txt: ansistring);
+procedure CheckHeapWrtMemCnt(const txt: ansistring);
+procedure WriteGetMemCount(const txt: ansistring);
+
+function MemCheck_getmem_cnt: longint;
+function MemCheck_freemem_cnt: longint;
+function MemCheck_getmem_size: longint;
+function MemCheck_freemem_size: longint;
+function MemCheck_getmem8_size: longint;
+function MemCheck_freemem8_size: longint;
+{$ENDIF}
+
+{$IFDEF MC_ImplementationStart}
+// override RunError and Halt for better debugging
+procedure RunError(RunErrorNumber: word); forward;
+procedure Halt(ErrNum: byte); forward;
+{$ENDIF MC_ImplementationStart}
+
+{$IFDEF MC_ImplementationEnd}
+procedure RunError(RunErrorNumber: word);
+begin
+  if ExceptOnError then begin
+    // create an gdb catchable exception
+    if 0=(1 div ((ord(ExceptOnError) and 1) shr 1)) then ;
+  end;
+  if HaltOnError then System.Halt(1);
+  System.RunError(RunErrorNumber);
+end;
+
+procedure Halt(ErrNum: byte);
+begin
+  if ExceptOnError then begin
+    // create an gdb catchable exception
+    if 0=(1 div ((ord(ExceptOnError) and 1) shr 1)) then ;
+  end;
+  System.Halt(1);
+end;
+
+// StartAddition for CodeTools
+procedure CheckHeap;
+var
+  p: pointer;
+  OldQuickTrace: boolean;
+begin
+  writeln('>>> memcheck.pp - CheckHeap');
+  OldQuickTrace:=QuickTrace;
+  QuickTrace:=false;
+  GetMem(p,4);
+  FreeMem(p);
+  QuickTrace:=OldQuickTrace;
+end;
+
+procedure CheckHeap(const txt: ansistring);
+var
+  p: pointer;
+  OldQuickTrace: boolean;
+begin
+  writeln('>>> memcheck.pp - CheckHeap "',txt,'"');
+  OldQuickTrace:=QuickTrace;
+  QuickTrace:=false;
+  GetMem(p,4);
+  FreeMem(p);
+  QuickTrace:=OldQuickTrace;
+end;
+
+const
+  LastWrittenGetMemCnt: longint = 0;
+  HiddenGetMemCnt: longint = 0;
+
+procedure CheckHeapWrtMemCnt(const txt: ansistring);
+var
+  p: pointer;
+  StartGetMemCnt, CurGetMemCount, DiffGetMemCount: longint;
+  OldQuickTrace: boolean;
+begin
+  StartGetMemCnt:=MemCheck_getmem_cnt;
+  CurGetMemCount:=StartGetMemCnt-HiddenGetMemCnt;
+  DiffGetMemCount:=CurGetMemCount-LastWrittenGetMemCnt;
+  LastWrittenGetMemCnt:=CurGetMemCount;
+
+  writeln('>>> memcheck.pp - CheckHeap2 "',txt,'" ',
+    CurGetMemCount,'(',StartGetMemCnt,') +',DiffGetMemCount);
+  OldQuickTrace:=QuickTrace;
+  QuickTrace:=false;
+  GetMem(p,4);
+  FreeMem(p);
+  QuickTrace:=OldQuickTrace;
+
+  // don't count mem counts of this proc
+  inc(HiddenGetMemCnt,MemCheck_getmem_cnt-StartGetMemCnt);
+end;
+
+procedure WriteGetMemCount(const txt: ansistring);
+var
+  StartGetMemCnt, CurGetMemCount, DiffGetMemCount: longint;
+begin
+  StartGetMemCnt:=MemCheck_getmem_cnt;
+  CurGetMemCount:=StartGetMemCnt-HiddenGetMemCnt;
+  DiffGetMemCount:=CurGetMemCount-LastWrittenGetMemCnt;
+  LastWrittenGetMemCnt:=CurGetMemCount;
+
+  writeln('>>> memcheck.pp - WriteGetMemCount "',txt,'" ',
+    CurGetMemCount,'(',StartGetMemCnt,') +',DiffGetMemCount);
+
+  // don't count mem counts of this proc
+  inc(HiddenGetMemCnt,MemCheck_getmem_cnt-StartGetMemCnt);
+end;
+
+function MemCheck_getmem_cnt: longint;
+begin
+  MemCheck_getmem_cnt:=getmem_cnt;
+end;
+
+function MemCheck_freemem_cnt: longint;
+begin
+  MemCheck_freemem_cnt:=freemem_cnt;
+end;
+
+function MemCheck_getmem_size: longint;
+begin
+  MemCheck_getmem_size:=getmem_size;
+end;
+
+function MemCheck_freemem_size: longint;
+begin
+  MemCheck_freemem_size:=freemem_size;
+end;
+
+function MemCheck_getmem8_size: longint;
+begin
+  MemCheck_getmem8_size:=getmem8_size;
+end;
+
+function MemCheck_freemem8_size: longint;
+begin
+  MemCheck_freemem8_size:=freemem8_size;
+end;
+// Addition for CodeTools
+
+{$ENDIF MC_ImplementationEnd}
+

languages/lazaruside.ru.po

@@ -272,7 +272,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisactivateregularexpressionsyntaxfortextandreplaceme
 msgid "Activate regular expression syntax for text and replacement (pretty much like perl)"
-msgstr ""
+msgstr "Активировать синтаксис регулярных выражений для текста и замены (почти как в perl)"
 
 #: lazarusidestrconsts:liscodetempladd
 msgid "Add"
@@ -296,7 +296,7 @@ msgstr "
 
 #: lazarusidestrconsts:srkmecaddbreakpoint
 msgid "add break point"
-msgstr ""
+msgstr "добавить точку останова"
 
 #: lazarusidestrconsts:liscodetempladdcodetemplate
 msgid "Add code template"
@@ -388,7 +388,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisallowsearchingformultiplelines
 msgid "Allow searching for multiple lines"
-msgstr ""
+msgstr "Разрешить поиск для нескольких строк"
 
 #: lazarusidestrconsts:dlgalphabetically
 msgid "Alphabetically"
@@ -484,7 +484,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisaskbeforereplacingeachfoundtext
 msgid "Ask before replacing each found text"
-msgstr ""
+msgstr "Спросить перед заменой каждого фрагмента"
 
 #: lazarusidestrconsts:liscodetoolsoptsat
 msgid "At"
@@ -1364,7 +1364,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisdate
 msgid "Date"
-msgstr ""
+msgstr "Дата"
 
 #: lazarusidestrconsts:uemdebugword
 msgid "Debug"
@@ -1644,7 +1644,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisdistinguishbigandsmalllettersegaanda
 msgid "Distinguish big and small letters e.g. A and a"
-msgstr ""
+msgstr "Различать регистр букв, например, А и а"
 
 #: lazarusidestrconsts:dlgnotsplitlineafter
 msgid "Do not split line after:"
@@ -2008,7 +2008,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisfindfilefilemaskbak
 msgid "File mask (*;*.*;*.bak?)"
-msgstr ""
+msgstr "Маска файла (*;*.*;*.bak?)"
 
 #: lazarusidestrconsts:srkmcatfilemenu
 msgid "File menu commands"
@@ -2996,11 +2996,11 @@ msgstr "
 
 #: lazarusidestrconsts:lismenujumptonexterror
 msgid "Jump to next error"
-msgstr ""
+msgstr "Переход к след. ошибке"
 
 #: lazarusidestrconsts:lismenujumptopreverror
 msgid "Jump to previous error"
-msgstr ""
+msgstr "Переход к пред. ошибке"
 
 #: lazarusidestrconsts:dlgjumpingetc
 msgid "Jumping (e.g. Method Jumping)"
@@ -4360,7 +4360,7 @@ msgstr "
 
 #: lazarusidestrconsts:srkmecremovebreakpoint
 msgid "remove break point"
-msgstr ""
+msgstr "удалить точку останова"
 
 #: lazarusidestrconsts:lispckeditremovedependency
 msgid "Remove dependency"
@@ -4880,7 +4880,7 @@ msgstr "
 
 #: lazarusidestrconsts:lispckexplisrequiredby
 msgid "Selected package is required by:"
-msgstr ""
+msgstr "Выбранный пакет нужен для:"
 
 #: lazarusidestrconsts:dlgselectedtext
 msgid "Selected Text"
@@ -5740,7 +5740,7 @@ msgstr "
 
 #: lazarusidestrconsts:listheunititselfhasalreadythenamepascalidentifiersmus
 msgid "The unit itself has already the name %s%s%s. Pascal identifiers must be unique."
-msgstr ""
+msgstr "Модуль уже называется %s%s%s. Идентификаторы паскаля должны быть уникальны."
 
 #: lazarusidestrconsts:lisprojaddtheunitnamealreadyexistsintheproject
 msgid "The unit name %s%s%s already exists in the project%swith file: %s%s%s."
@@ -5824,7 +5824,7 @@ msgstr "
 
 #: lazarusidestrconsts:listhereisalreadyaunitwiththenamepascalidentifiersmus
 msgid "There is already a unit with the name %s%s%s. Pascal identifiers must be unique."
-msgstr ""
+msgstr "Уже есть модуль, называемый %s%s%s. Идентификаторы паскаля должны быть уникальны."
 
 #: lazarusidestrconsts:lispkgmangthereisalreadyanotherpackagewiththename
 msgid "There is already another package with the name %s%s%s.%sConflict package: %s%s%s%sFile: %s%s%s"
@@ -6040,7 +6040,7 @@ msgstr "
 
 #: lazarusidestrconsts:lisunabletofindfilechecksearchpathinprojectcompileroption
 msgid "Unable to find file %s%s%s.%sCheck search path in%sProject->Compiler Options...->Search Paths->Other Unit Files"
-msgstr ""
+msgstr "Не могу найти файл %s%s%s.%sПроверьте путь поиска в%sПроект->Параметры компилятора...->Пути->Другие файлы модулей"
 
 #: lazarusidestrconsts:lisunabletofindmethodplzfixtheerrorshowninthemessage
 msgid "Unable to find method. Plz fix the error shown in the message window."