Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2008.07.13;
Скачать: CL | DM;

Вниз

Warning, которого быть не должно.   Найти похожие ветки 

 
Riply ©   (2008-06-10 21:48) [0]

Здравствуйте !
Вот скелет некой функции:

function Test: WideString;
var
Tmp : UNICODE_STRING;
begin
Result := "";
RtlInitUnicodeString(@Tmp, nil);
if NT_SUCCESS(............) then
 try
  ............
  if NT_SUCCESS(............) then
   begin
    // ............ Много кода, но Result в нем нигде не используется

    SetLength(Result, Tmp.Length shr SHR_WCHAR);
    if Tmp.Length > 0 then Move(Tmp.Buffer^, Pointer(Result)^, Tmp.Length);
   end;
 finally
  RtlFreeUnicodeString(@Tmp);
 end;
end;


Почему Delphi настырно выдает следующее предупреждение:
"[Pascal Warning] Alx_Unicode.pas(746): W1035 Return value of function "Test" might be undefined" ?
Что такое может быть "не так" в коде, где точки ?
(Если его закоментировать (но только весь сразу, а не кусочками), то варнинг исчезает)


 
DrPass ©   (2008-06-11 00:44) [1]


> SetLength(Result, Tmp.Length shr SHR_WCHAR);
>     if Tmp.Length > 0 then Move(Tmp.Buffer^, Pointer(Result)^,
>  Tmp.Length);

А если так:
if Tmp.Length > 0 then
begin
 SetLength(Result, Tmp.Length shr SHR_WCHAR);
 Move(Tmp.Buffer^, Pointer(Result)^, Tmp.Length);
end;


 
Riply ©   (2008-06-11 00:57) [2]

> [1] DrPass ©   (11.06.08 00:44)
> А если так:

Неа. Не помогло.
Просто в "точках" так мого всего, что лень(да и нереально) идти вручную.
Мне хочется понять, хотя бы какого типа безобразничество я там должна была совершить для такого эфекта :)
Не могу себе представить. Да и первой строкой результат задается: Result := "";
Пока оставила это дело до лучших времен, но процедуру не уничтожаю (хотя она уже не нужна).

P.S.
А может Delphi уже пора перезагрузить ?


 
Игорь Шевченко ©   (2008-06-11 09:50) [3]

нету warning"а не обманывай


 
Anatoly Podgoretsky ©   (2008-06-11 09:51) [4]

> Игорь Шевченко  (11.06.2008 9:50:03)  [3]

Дело наверно в точках.


 
Тын-Дын ©   (2008-06-11 09:59) [5]

Возможно с tmp.Buffer какие-то действия выполняются, в результате чего и происходитпредупреждение.


 
Riply ©   (2008-06-11 11:43) [6]

> [3] Игорь Шевченко ©   (11.06.08 09:50)
> нету warning"а не обманывай

Я уже как-то говорила, что могу чего-то не знать,
не понимать или заблуждаться, но не подтасовывать факты.
Как доказательство "не вранья" могу выслать код (его много).
Но так как он в разаработке, то "в нем черт ногу сломит" - было бы мягким его описанием :)

>  [4] Anatoly Podgoretsky ©   (11.06.08 09:51)
> Дело наверно в точках.

>  [5] Тын-Дын ©   (11.06.08 09:59)
> Возможно с tmp.Buffer какие-то действия выполняются, в результате чего и происходитпредупреждение

Там, действительно много преобразований с tmp.Buffer.
Для него идут операции с памятью средствами Nt (через Heap) и обычным ReallocMem.
Цель данной процедуры была в проверке корректности преобразований структур
с различными способами выделения и освобождения памяти друг в друга.
У меня было предположение, что он оказывается неопределенным,
но ведь второй строкой : RtlInitUnicodeString(@Tmp, nil) мы его инициализируем...

P.S.
Это все было затеяно для попытки уйти от зависимости от способа выделения памяти Nt-функциями.


 
Игорь Шевченко ©   (2008-06-11 11:49) [7]

Riply ©   (11.06.08 11:43) [6]


> Я уже как-то говорила, что могу чего-то не знать,
> не понимать или заблуждаться, но не подтасовывать факты.
>


function Test: WideString;
var
Tmp : UNICODE_STRING;
begin
Result := "";
RtlInitUnicodeString(Tmp, nil);
if NT_SUCCESS(STATUS_SUCCESS) then
try
//  ............
 if NT_SUCCESS(STATUS_SUCCESS) then
  begin
   // ............ Много кода, но Result в нем нигде не используется

   SetLength(Result, Tmp.Length shr 1);
   if Tmp.Length > 0 then Move(Tmp.Buffer^, Pointer(Result)^, Tmp.Length);
  end;
finally
 RtlFreeUnicodeString(@Tmp);
end;
end;


Здесь Warning-а нету.


> Что такое может быть "не так" в коде, где точки ?


Например Exit


 
Игорь Шевченко ©   (2008-06-11 11:49) [8]

Riply ©   (11.06.08 11:43) [6]

Телепаты на форуме находятся в бессрочном отпуске


 
Riply ©   (2008-06-11 12:00) [9]

> [7] Игорь Шевченко ©   (11.06.08 11:49)
> Здесь Warning-а нету.

И не должно быть.
Я еще в самом первом посте написала "Если закоментировать код, то варнинг исчезает"

> Например Exit
Не поняла :(

> Телепаты на форуме находятся в бессрочном отпуске
Эт я знаю и это очень печально :)
Но я же просила не угадывать высказать предположения какого типа ляп
может привести к этому.


 
Игорь Шевченко ©   (2008-06-11 12:03) [10]


> Я еще в самом первом посте написала "Если закоментировать
> код, то варнинг исчезает"


ты предлагаешь подставять разные варианты кода в надежде получить Warning ?

Неплохо бы было тебе самой закомментировать до тех пор, пока Warning не исчезнет, убрать последний комментарий и выложить код на форум


 
Anatoly Podgoretsky ©   (2008-06-11 12:16) [11]


> Как доказательство "не вранья" могу выслать код (его много).
>
> Но так как он в разаработке, то "в нем черт ногу сломит"
> - было бы мягким его описанием :)

Вот и замаскируй весь код в точках, приведи к тому виду, что опубликовала, если ошибка исчезнет, начинай по тихоньку размаскировать.


 
{RASkov} ©   (2008-06-11 12:39) [12]

> function Test: WideString;
> var
> Tmp : UNICODE_STRING;
> begin
> Result := "";       //А Тут Хинта нет, о том что переменная не используется?
> RtlInitUnicodeString(@Tmp, nil);
> if NT_SUCCESS(............) then
> try
>  ............
>  if NT_SUCCESS(............) then
>   begin
>    // ............ Много кода, но Result в нем нигде не используется
>
>    SetLength(Result, Tmp.Length shr SHR_WCHAR);
>    if Tmp.Length > 0 then Move(Tmp.Buffer^, Pointer(Result)^, Tmp.Length);
>   end;
> finally
>  RtlFreeUnicodeString(@Tmp);
> end;
> end;


> "[Pascal Warning] Alx_Unicode.pas(746): W1035 Return value of function "Test" might be undefined" ?


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


 
DrPass ©   (2008-06-11 12:46) [13]


> По идеи, если оптимизатор не выкидывает первую строку, то
> глюк какой-то... ибо возвращаемое значение определено в
> первой строке...

Более того, первая строчка вообще не нужна. String/WideString - это управляемые типы, и они всегда инициализируются пустой строкой при входе в область видимости, даже если ты это явно не написал. Компилятор эту фишку знает, и не даст никаких ахтунгов.


 
guav ©   (2008-06-11 13:13) [14]

> [13] DrPass ©   (11.06.08 12:46)
> Более того, первая строчка вообще не нужна

Нужна. Тут строка не локальная переменная, а результат, он передаётся как неявный var параметр, потому там может быть и не пустая строка.


 
Riply ©   (2008-06-11 15:00) [15]

> [10] Игорь Шевченко ©   (11.06.08 12:03)
> Неплохо бы было тебе самой закомментировать до тех пор,
> пока Warning не исчезнет, убрать последний комментарий и выложить код на форум

Игорь, я пыталась так сделать.
Выяснилось, что условие сохранения Warning`а
переводит код в разряд "не дышать" :)
Например, небольшие изменения в вызываемых процедурах (точнее в двух)
приводят к его исчезновению.
Тем не менее вполне реально собрать не очень большой проект, воспроизводящий "неправильный варнинг".
(повыдергивать процедуры, а если не получается, то юниты, где они сидят).
Если это представляет интерес, то я займусь "выдергиванием" :)


 
Игорь Шевченко ©   (2008-06-11 15:16) [16]

Riply ©   (11.06.08 15:00) [15]


> Тем не менее вполне реально собрать не очень большой проект,
>  воспроизводящий "неправильный варнинг".


Вот и воспроизведи, а то гадание на кофейной гуще.
И потом, у тебя в коде процедуры так много строк, что она в пост не влезает ?


 
Riply ©   (2008-06-11 15:48) [17]

> [16] Игорь Шевченко ©   (11.06.08 15:16)
> Вот и воспроизведи, а то гадание на кофейной гуще.

Хорошо.

> И потом, у тебя в коде процедуры так много строк, что она в пост не влезает ?

Неа, там хуже ситуация.
Вызываются процедуры из др. юнитов, которые вызывают процедуры,
(используют структуры) из "Дома, который построил Джек" :)


 
Riply ©   (2008-06-11 17:56) [18]

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


 
Riply ©   (2008-06-11 20:28) [19]

Вот первые выводы:

[4] Anatoly Podgoretsky был прав - дело именно в точках :)
Если серьезно, то в коде (который заменяли точки) среди прочего
использовались inline ф-ии. Именно inline и есть виновник данного эффекта.
Более точно сказать (привести пример кода и влияния inline на компиляцию), пока сложно.
Игорь Шевченко предлагает поступить так:
"Если есть желание помучиться, то разверни тела функций непосредственно в места
вызовов (проделай работу компилятора) и по получившемуся
коду компилятор может указать более точное место ошибки"

Возни с этим много, но если кому-то инресна более детальная информация (или просто этот вопрос),
то я попробую этим заняться.


 
Игорь Шевченко ©   (2008-06-11 22:45) [20]


> Возни с этим много


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


 
Тын-Дын ©   (2008-06-11 23:17) [21]


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


Можно тоже посмотреть код? Если да, то запрос на email в анкете высылаю.


 
Riply ©   (2008-06-12 00:03) [22]

> [20] Игорь Шевченко ©   (11.06.08 22:45)
> Ключевое слово - community.

Так... Достойно улепетнуть от этой работы опять не получилось :)
Придется попробовать "выполнить работу компилятора" и вынести
результаты на обсуждение :)

> [21] Тын-Дын ©   (11.06.08 23:17)
> Можно тоже посмотреть код?

В принципе, если для дела, то можно.
Есть несколько "но"
Код с стадии разработки.
В нем много недописанных или просто тестируемых на данный момент функций.
А также много лишнего и не относящегося к данному вопросу. (Я конечно попробую его еще почистить)
И последнее: единственное, что этот код делает - это показывает, что Warning мне не приснился :)

P.S.
Чуть не забыла: эффект проявляется под BDS 2006.


 
Тын-Дын ©   (2008-06-12 00:12) [23]


> В принципе, если для дела, то можно.


Конечно, для дела. Разве найти глюки или баги - не дело?-)


> Код с стадии разработки. В нем много недописанных или просто
> тестируемых на данный момент функций.А также много лишнего
> и не относящегося к данному вопросу. (Я конечно попробую
> его еще почистить)


Да главное, чтобы нужный код можно было скомпилировать.
А в каком он виде - не столь важно...


 
Игорь Шевченко ©   (2008-06-12 00:57) [24]

Riply ©   (12.06.08 00:03) [22]

Как ты понимаешь, Warning можно проигнорировать, ничего страшного. Есть даже такие директивы {$WARNINGS OFF} .... {$WARNINGS ON}


 
Riply ©   (2008-06-12 01:07) [25]

> [24] Игорь Шевченко ©   (12.06.08 00:57)
> Как ты понимаешь, Warning можно проигнорировать, ничего страшного.
> Есть даже такие директивы {$WARNINGS OFF} .... {$WARNINGS ON}

Игорь, после такого утверждения,
"но на это стоит списывать в самой последний момент,
когда остальные варианты рассмотрены community и отброшены",
я стала относиться к этому Warning`у как к манне небесной,
ибо с его помощью я смогу найти очередную ошибку в коде.
Так что в данный момент времени я на этот код и не дышу, боюсь, что он исчезнет :)


 
Тын-Дын ©   (2008-06-12 02:06) [26]


> Riply ©   (12.06.08 01:07) [25]


Обрати внимание на определение и описание функции Us_HoldInteger_


 
Тын-Дын ©   (2008-06-12 03:00) [27]


> Обрати внимание на определение и описание функции Us_HoldInteger_

Сорри, описание и реализацию...


 
Riply ©   (2008-06-12 17:41) [28]

Некоторые результаты
Удалось довести подопытную функцию до такого вида:

function TestExtract: WideString;
var
Tmp, Empty: UNICODE_STRING;
RetStatus: NTSTATUS;
begin
Result := "";
RtlInitUnicodeString(@Tmp, nil);
try
 RetStatus := Um_GetMemory(Empty.Buffer, 1024);

 if RetStatus = STATUS_SUCCESS then
  try
   Empty.MaximumLength := 1024;
   Empty.Length := 0;
   RetStatus := Us_HoldLen_(@Tmp, Empty.Buffer, Empty.Length, 0);
  finally
   _Um_FreeMem(Empty.Buffer);
  end;

 if NT_SUCCESS(RetStatus) then Result := Tmp.Buffer;
finally
 Um_FreeMem(Tmp.Buffer);
end;
end;

Любые дальнейшие попытки "раскрытия" функций (у меня) ведут к исчезновению Warning`а.
Даже при замене в последней строчке Um_FreeMem(Tmp.Buffer)
на _Um_FreeMem(Tmp.Buffer) он исчезает.
Пока остается только смотреть на реализацию функций и медитировать,
что именно в них не нравиться компилятору :)

> [26] Тын-Дын © (12.06.08 02:06)
> Обрати внимание на определение и описание функции Us_HoldInteger_

Она оказалась не при чем. Ее удалось выбросить.
(Что именно тебе в ней не понравилось, пока не поняла.
Но правда особо и не смотрела т.к. удалось от нее избавиться :)

P.S.
Для перекомпиляции проекта с новой функцией надо изменить Sh_MemMng.inc
Он должен выглядеть так:
{$DEFINE SH_MEM_MNG}
{.$DEFINE SH_MEM_DEBUG}
{.$DEFINE SH_MEM_US_DEBUG}
{.$DEFINE SH_MEM_US_HEAP}


 
Riply ©   (2008-06-12 17:43) [29]

Sorry. Опять забыла выделить код :(


 
Тын-Дын ©   (2008-06-12 18:04) [30]


> Но правда особо и не смотрела т.к. удалось от нее избавиться
> :)


Что именно не понравилось?
В описании есть inline, в реализации нет.
После исправления предупреждение исчезает.


 
Тын-Дын ©   (2008-06-12 18:06) [31]

Не факт, конечно, что это единственное место, но видимо только эта функция участвует в цепочке вычислений.

Ещё можешь обратить внимание на функцию
function BlockMem_Append(const pMemBlock: PMEM_BLOCK; const pBuffer: Pointer; const BytesWrite: LongWord): NTSTATUS;{$IFNDEF SH_MEM_DEBUG}inline;{$ENDIF}

Эта функция не раскрывается в код по месту.


 
Тын-Дын ©   (2008-06-12 18:08) [32]

PS.
После единственного добавления inline в функцию Us_HoldInteger_ предупреждение исчезло.


 
Игорь Шевченко ©   (2008-06-12 18:15) [33]

Сузим просторы для поиска:

function TestExtract: WideString;
var
 Tmp: UNICODE_STRING;
begin
 FillChar(Tmp, 8, 0);
 Result := "";
 if NT_SUCCESS(Us_HoldInteger_(@Tmp, 353453, 10, 8, 0)) then
   Result := Us_ToStringW(@Tmp);
 Us_FreeMem(@Tmp);
end;


Здесь тот же самый warning


 
Тын-Дын ©   (2008-06-12 18:16) [34]


> Игорь Шевченко ©   (12.06.08 18:15) [33]
> Сузим просторы для поиска:function TestExtract: WideString;
> var  Tmp: UNICODE_STRING;begin  FillChar(Tmp, 8, 0);  Result
> := "";  if NT_SUCCESS(Us_HoldInteger_(@Tmp, 353453, 10,
> 8, 0)) then    Result := Us_ToStringW(@Tmp);  Us_FreeMem(@Tmp);
> end;Здесь тот же самый warning


То же самое - у меня при компиляции нет предупреждения.


 
Тын-Дын ©   (2008-06-12 18:19) [35]

Сейчас удалю всё, кроме исходных текстов, ещё раз перекомпилирую...


 
Игорь Шевченко ©   (2008-06-12 18:19) [36]

Кстати, Warning исчезает, если функцию Us_HoldInteger_ перенести без всяких изменений из модуля Sh_Unicode в тело проекта сразу перед TestExtract.

Мой хороший совет - не париться.


 
Тын-Дын ©   (2008-06-12 18:26) [37]


> Кстати, Warning исчезает, если функцию Us_HoldInteger_ перенести
> без всяких изменений из модуля Sh_Unicode в тело проекта
> сразу перед TestExtract.


Не потому ли, что Rеsult присваивается непосредственно в этой функции безусловно?


 
Riply ©   (2008-06-12 18:26) [38]

> [34] Тын-Дын ©   (12.06.08 18:16)
> То же самое - у меня при компиляции нет предупреждения.

Надо компилировать с такими дериктивами:
{$DEFINE SH_MEM_MNG}
{.$DEFINE SH_MEM_DEBUG}
{.$DEFINE SH_MEM_US_DEBUG}
{$DEFINE SH_MEM_US_HEAP}
тогда будет.

> [36] Игорь Шевченко ©   (12.06.08 18:19)
> Мой хороший совет - не париться.

Наверное Вы правы, но я хорошо запомнила историю, когда inline функция
"меняла" входной параметр - константу.
Вдруг и здесь что-то подобное ?


 
Тын-Дын ©   (2008-06-12 18:30) [39]


> Надо компилировать с такими дериктивами:


С такими и компилировал - нет предупреждения после исправления..


 
Игорь Шевченко ©   (2008-06-12 18:45) [40]


> Вдруг и здесь что-то подобное ?


а ты попробуй функцию перенести. define все те же самые, inc-файл тот же включается, функция сама не inline, посмотришь, уйдет warning или нет.


 
Riply ©   (2008-06-12 19:36) [41]

> [40] Игорь Шевченко ©   (12.06.08 18:45)
> а ты попробуй функцию перенести. define все те же самые, inc-файл тот же включается,
> функция сама не inline, посмотришь, уйдет warning или нет.

Уходит, если функция не inline

> Тын-Дын ©

> {$DEFINE SH_MEM_MNG}
> {.$DEFINE SH_MEM_DEBUG}
> {.$DEFINE SH_MEM_US_DEBUG}
> {$DEFINE SH_MEM_US_HEAP}

> program Warning;

> {$APPTYPE CONSOLE}

А разве такое "использование" директив не опасно ?
Я имею ввиду то, не получится ли что у разных юнитов разные define`ы ?

Вопрос к участникам:
Т.е. решаем пока плюнуть на этот Warning и Us_HoldInteger_ делаем не inline ?
А варнинг пусть живет как хочет :)


 
Тын-Дын ©   (2008-06-12 20:13) [42]

Я бы всё-таки убрал inline в Us_HoldInteger_, избавившись от предупреждения-)


 
Игорь Шевченко ©   (2008-06-12 21:04) [43]


> Уходит, если функция не inline


в проекте она не inline


 
Riply ©   (2008-06-12 21:10) [44]

> [43] Игорь Шевченко ©   (12.06.08 21:04)
> в проекте она не inline

Все. Я уже совсем запуталась. Не могу вспомнить в каком виде высылала проект :(
Ну да ладно. Так как решаем поступить: плюнуть (до лучших времен :) или еще помучаться ?


 
Тын-Дын ©   (2008-06-12 21:29) [45]


> в проекте она не inline


У меня в оригинале:
function Us_HoldInteger_(const pUs: PUNICODE_STRING; const Value, Base, DisplChars, SourceHoldBytes: LongWord): NTSTATUS;

implementation

function Us_HoldInteger_(const pUs: PUNICODE_STRING; const Value, Base, DisplChars, SourceHoldBytes: LongWord): NTSTATUS; {$IFNDEF SH_MEM_US_DEBUG}inline;{$ENDIF}
var
MemBlock: MEM_BLOCK;
begin
{$IFDEF SH_MEM_US_HEAP}
Result := MemBlock.__GetMemory(MAX_INT_LENGTH);
if Result = STATUS_SUCCESS then
 try
  Result := BlockMem_AppendInteger(@MemBlock, Value, Base, DisplChars);
  if NT_SUCCESS(Result) then Result := Us_HoldLen_(pUs, MemBlock.pBuffer, MemBlock.Length, SourceHoldBytes);
 finally
  MemBlock.__FreeMem;
 end;
{$ELSE}
MemBlock.InitMemBlock(SourceHoldBytes, MaximumLength, Buffer);
Result := BlockMem_AppendInteger(@MemBlock, Value, Base, DisplChars);
Us_InitFromMemBlock_(pUs, @MemBlock);
{$ENDIF}
end;


 
Riply ©   (2008-06-12 21:33) [46]

> [45] Тын-Дын ©   (12.06.08 21:29)
> У меня в оригинале:

У вас и Игорем "оригиналы" могут различаться. (Хоть убейте - не помню)
Я ведь, отправив Игорю код, не сидела сложа руки в ожидании результата :)
Могла и напартачить с исходниками :)


 
Игорь Шевченко ©   (2008-06-12 22:26) [47]

Riply ©   (12.06.08 21:10) [44]

Это я несколько ввел в заблуждение, виноват - я переместил тело функции, убрав ее прототип из интерфейсной части Sh_Unicode.
В интерфейсной части она объявлена как inline, а в implementation без него, что вполне допустимо. Так что перенеся функцию я убрал inline.


 
Игорь Шевченко ©   (2008-06-12 23:04) [48]

а эта...вопрос такой автору - а зачем такое количество вложенных друг в друга inline-функций ? Тест компилятора или иные соображения ?


 
Riply ©   (2008-06-12 23:19) [49]

> [48] Игорь Шевченко ©   (12.06.08 23:04)
> а эта...вопрос такой автору - а зачем такое количество вложенных друг в друга inline-функций ?
> Тест компилятора или иные соображения ?

Здесь все вместе.
Модуль в стадии разработки и тестирования.
На этом этапе множественность вложений позволяла почти безболезненно
менять алгоритм работы на любом "уровне" и наблюдать
за его поведением при различных условиях (в т. ч. и быстродействием).
Позже, когда было выяснено влияние inline и выбран окончательный алгоритм,
планировалось "слияние" функций и приведение модуля в рабочий, пригодный для использования вид.


 
Riply ©   (2008-06-13 00:03) [50]

Раз уж заговорили об этом, хочу поделиться.
Есть у меня код (автора, к сожалению, не помню, но не я :).
Скомпилированный под Delphi 7 и BDS 2006 он дает наглядное
представление о, изменениях в работе BMM.
Если с этим кодом чуть поиграть, то можно его использовать для
получения и других "сравнительных" данных.
Не знаю, может кому интересно будет. Ну а на "нет" и суда нет :)

unit BMM_SpeedMultiTread;

interface
uses
Windows,
SysUtils,
Classes;

procedure DiffGetMemSpeedInMultiThread(List: TStrings);

implementation
const
BorlandMM  = "borlndmm.dll";

function BMM_GetMem(Size: Integer): Pointer; external BorlandMM name "@Borlndmm@SysGetMem$qqri";
function BMM_FreeMem(P: Pointer): Integer; external BorlandMM name "@Borlndmm@SysFreeMem$qqrpv";
function _IsDebuggerPresent:boolean;external "kernel32.dll" name "IsDebuggerPresent";

//Хак - получение указателя на borlandmm.IsMultiThread
function GetBMMIsMultiThreadPtr:pBoolean;
var
 pbase,p,pp:pChar;
 pData,v:integer;
begin
 Result:=Nil;
 integer(pbase):=GetModuleHandle("borlndmm.dll");
 if pbase = Nil then Exit;
 p:=pbase+pInteger(pbase+$3C)^;     //указатель на PE-signature
 inc(p,24);                         //указатель на PE.OptionalHeader
 //начало секции данных - чтобы не возиться c анализом секций берем BaseOfData
 //(поле не обязательное для заполнения, но в borlndmm оно установлено)
 if pWord(p)^ and $100 = $100 then  //если PE32
   pData:=integer(pbase)+pInteger(p+24)^ //BaseOfData
 else
 begin                  //BaseOfCode      SizeOfCode
   pData:=integer(pbase)+pInteger(p+20)^+pInteger(p+4)^;
   pData:=(pData+4093) and -4096;
 end;
 p:=pbase+pInteger(p+16)^;              //AddressOfEntryPoint
 pp:=p+48;
 repeat
   //ищем MOV byte ptr [XXXX],1 = $05C6,$XXXX,$01
   if (pWord(p)^ = $05C6) and (pByte(p+6)^ = 1) then
   begin
     v:=pInteger(p+2)^;
     if (v >= pData) and (v < pData+$100) then
     begin
       Result:=pointer(v);
       Exit;
     end;
   end;
   inc(p);
 until p >= pp;
end;

procedure DiffGetMemSpeedInMultiThread(List: TStrings);
const
 memsz   = 8;
 repcnt  = 1;//32;
 itemcnt = 4*2;
 fmt:array[1..itemcnt] of string = (
   "GetMem+FreeMem   = %4d <- IsMultiThread:=false",
   "GetMem+FreeMem   = %4d <- IsMultiThread:=true",
   "borlandmm.dll    = %4d <- as is (dll.IsMultiThread:=true)",
   "borlandmm.dll    = %4d <- set on fly dll.IsMultiThread:=false",
   "HeapAlloc\Free   = %4d <- dwFlags = 0",
   "HeapAlloc\Free   = %4d <- dwFlags = NO_SERIALIZE",
   "GlobalAlloc\Free = %4d <- GMEM_FIXED",
   "GlobalAlloc\Free = %4d <- GMEM_MOVEABLE");
var
 t:array[0..itemcnt] of integer;
 p:array[1..3] of pointer;
 i,j,k,ph,over,heapflags:integer;
 BMMIsMultiThread:pBoolean;

 function StartRDTSC:integer;
 asm
   push ebx
   push edi
   xor eax,eax
   cpuid         //db $0F,$A2
   rdtsc         //db $0F,$31
   mov edi,eax
   xor eax,eax
   cpuid         //db $0F,$A2
   mov eax,edi
   pop edi
   pop ebx
 end;///

 function StopRDTSC:integer;
 asm
   rdtsc         //db $0F,$31
 end;///

begin
 over:=0; //замеряем оверхед на cpuid
 for j:=1 to 5 do
 begin
   t[0]:=StartRDTSC;
   t[0]:=StopRDTSC-t[0]-over;
 end;
 over:=t[0];

 IsMultiThread:=false;
 for i:=1 to 3 do GetMem(p[i],memsz);
 k:=1;
 repeat
   for j:=1 to 5 do
   begin
     t[0]:=StartRDTSC;
     for i:=1 to repcnt do
     begin
       FreeMem(p[2]);
       GetMem(p[2],memsz);
     end;
     t[k]:=(StopRDTSC-t[0]-over) div repcnt;
   end;
   IsMultiThread:=true;
   inc(k)
 until k > 2;
 IsMultiThread:=false;
 for i:=1 to 3 do FreeMem(p[i]);

 for i:=1 to 3 do p[i]:=BMM_GetMem(memsz);
 BMMIsMultiThread:=GetBMMIsMultiThreadPtr;
 repeat
   for j:=1 to 5 do
   begin
     t[0]:=StartRDTSC;
     for i:=1 to repcnt do
     begin
       BMM_FreeMem(p[2]);
       p[2]:=BMM_GetMem(memsz);
     end;
     t[k]:=(StopRDTSC-t[0]-over) div repcnt;
   end;
   if BMMIsMultiThread <> Nil then BMMIsMultiThread^:=false;
   inc(k);
 until k > 4;
 for i:=1 to 3 do BMM_FreeMem(p[i]);
 if BMMIsMultiThread <> Nil then BMMIsMultiThread^:=true;

 ph:=GetProcessHeap;
 for i:=1 to 3 do p[i]:=HeapAlloc(ph,0,memsz);
 heapflags:=0;
 repeat
   for j:=1 to 5 do
   begin
     t[0]:=StartRDTSC;
     for i:=1 to repcnt do
     begin
       HeapFree(ph,heapflags,p[2]);
       p[2]:=HeapAlloc(ph,heapflags,memsz);
     end;
     t[k]:=(StopRDTSC-t[0]-over) div repcnt;
   end;
   heapflags:=1; //=HEAP_NO_SERIALIZE;
   inc(k);
 until k > 6;
 for i:=1 to 3 do HeapFree(ph,0,p[i]);

 for i:=1 to 3 do p[i]:=pointer(GlobalAlloc(GMEM_FIXED,memsz));
 for j:=1 to 5 do
 begin
   t[0]:=StartRDTSC;
   for i:=1 to repcnt do
   begin
     GlobalFree(integer(p[2]));
     p[2]:=pointer(GlobalAlloc(GMEM_FIXED,memsz));
   end;
   t[k]:=(StopRDTSC-t[0]-over) div repcnt;
 end;
 inc(k);
 for i:=1 to 3 do GlobalFree(integer(p[i]));

 for i:=1 to 3 do p[i]:=pointer(GlobalAlloc(GMEM_MOVEABLE,memsz));
 for j:=1 to 5 do
 begin
   t[0]:=StartRDTSC;
   for i:=1 to repcnt do
   begin
     GlobalFree(integer(p[2]));
     p[2]:=pointer(GlobalAlloc(GMEM_MOVEABLE,memsz));
   end;
   t[k]:=(StopRDTSC-t[0]-over) div repcnt;
 end;
 inc(k);
 for i:=1 to 3 do GlobalFree(integer(p[i]));

 List.Add("");
 for i:=1 to k-1 do
   List.Add(Format(fmt[i],[t[i]]));
 if _IsDebuggerPresent then
   List.Add("ВНИМАНИЕ: результаты HeapAlloc\Free сильно завышены"#13#10+
                   "из-за запуска программы под отладчиком");
end;

end.


 
Игорь Шевченко ©   (2008-06-13 00:40) [51]

Riply ©   (13.06.08 00:03) [50]


> Скомпилированный под Delphi 7 и BDS 2006 он дает наглядное
>
> представление о, изменениях в работе BMM.


собственно, начиная с D2005, если я не ошибаюсь, в delphi используется FastMM вместо старого кода. Поэтому отличия они, в принципе, очевидны.

Мне больше другое интересно, а как же система работает ? Она ж тоже память выделяет под свои нужды, однако без всяких дополнительных Memory Manager"ов живет, пользуя HeapAlloc, HeapFree (они же RtlAllocateHeap, RtlFreeHeap).

И работает быстро, зараза!


 
Riply ©   (2008-06-13 01:11) [52]

> [51] Игорь Шевченко ©   (13.06.08 00:40)
> И работает быстро, зараза!

:)
Я помню как меня удивил тот факт, что Nt-функции с UNICODE_STRING работают через Heap.
А мы же их (пусть и косвенно) но вызываем "мульены" раз :)
Попробовала найти ответ на вопрос "а зачем", но кроме как у Рихтера ничего не нашла.
А он тоже выражает удивление по этому поводу.
Кстати, этот вопрос меня интересует до сих пор.
Чем я рискую, подменивая способ выделения памяти для UNICODE_STRING в Nt-функциях ?
Может это у них страховка для случая многопоточности ?


 
Игорь Шевченко ©   (2008-06-13 01:35) [53]

Riply ©   (13.06.08 01:11) [52]


> Чем я рискую, подменивая способ выделения памяти для UNICODE_STRING
> в Nt-функциях ?
> Может это у них страховка для случая многопоточности ?


Ничем. Память для буфера в Unicode_string - это самая обыкновенная память пользовательского режима и как ее выделять - это дело сугубо личное. лучше чем выделение через Heap-функции еще ничего не придумали, кроме lookaside-списков, но они для строк категорически не подходят.


> Я помню как меня удивил тот факт, что Nt-функции с UNICODE_STRING
> работают через Heap.


Собственно, практически все выделение памяти работает через Heap-функции, а они, в свою очередь работают через VirtualAlloc/VirtualFree, кроме отображения файлов на память, так что удивляться нечему.

Кстати, совет, если уж о скорости заговорили - если у тебя есть константы, которые надо передавать через UNICODE_STRING, не вызывай RtlInitUnicodeString и тем более, не выделяй под константы память и не копируй туда значения. Лучше использовать для этих целей константные строки типа
const
 MyUnicodeString: UNICODE_STRING = (Length:длина; MaximumLength:длина; Biffer:"строка");


 
Riply ©   (2008-06-13 10:29) [54]

> [53] Игорь Шевченко ©   (13.06.08 01:35)

Спасибо.



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

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

Наверх




Память: 0.66 MB
Время: 0.017 c
15-1211959878
Azize
2008-05-28 11:31
2008.07.13
Веб-сайты, которые изменили мир. Топ-15


15-1211817107
Константинов
2008-05-26 19:51
2008.07.13
Looking Glass


15-1211889596
map
2008-05-27 15:59
2008.07.13
Какрта в программе


3-1201959891
Антон Шестаков
2008-02-02 16:44
2008.07.13
Удалить все записи в базе Парадокс


3-1199805755
AntonUSAnoV
2008-01-08 18:22
2008.07.13
Пропадает полоса прокрутки Dbgrid