Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.07.13;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.65 MB
Время: 0.01 c
2-1213366793
Sten
2008-06-13 18:19
2008.07.13
Иконка в заголовке формы


3-1201857058
Son_of_Morning
2008-02-01 12:10
2008.07.13
Помогите определится с выбором СУБД


2-1213347467
TForumHelp
2008-06-13 12:57
2008.07.13
Получение класса по его имени


3-1201958594
Lamer666
2008-02-02 16:23
2008.07.13
Как узнать процент заполненности базы данных MSSQL


15-1211742484
Заинтересованный
2008-05-25 23:08
2008.07.13
Стоимость разработки пакета, аналогичного SynEdit





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский