Головна сторінка
Top.Mail.Ru Яндекс.Метрика
Форум: "Початківцям";
Поточний архів: 2018.09.23;
Завантажити: [xml.tar.bz2];

Вниз

Допоможіть будь ласка знайти помилку в коді Знайти схожі гілки


Денис11998833   (2016-08-08 18:04) [0]

Есть код для хранения структур в массиве:


unit uTst;

interface

type
 TGroupDests=(gdFile, gdReg, gdTweak, gdUnknown);

 TScanGroupsItem=record
   IdGroup: integer;
   IdParentGroup: integer;
   GroupDest: TGroupDests;
   GroupName: pstring;
   GroupDescr: pstring;
   IconInd: integer;
   VclFakeGroup: boolean;
   SchedForFix: boolean;
 end;
 PScanGroupsItem=^TScanGroupsItem;

 TScanGroupsList=array of PScanGroupsItem;

 procedure TstLoader;
 procedure TstUnloader;

var
 ScanGroupsList: TScanGroupsList;
 ScanGroupsCnt: integer;
 TstText1, TstText2: string;

implementation

procedure TstLoader;
var
 ScanGroupsItem: PScanGroupsItem;
 i: integer;
begin
 TstText1:="Tst text1";
 TstText2:="Tst text2";

 ScanGroupsCnt:=0;
 for i := 0 to 40 do
 begin
   GetMem(ScanGroupsItem, SizeOf(TScanGroupsItem));
   ScanGroupsItem^.IdGroup:=11;
   ScanGroupsItem^.IdParentGroup:=111;
   ScanGroupsItem^.GroupDest:=gdReg;
   ScanGroupsItem^.GroupName:=@TstText1;
   ScanGroupsItem^.GroupDescr:=@TstText2;
   ScanGroupsItem^.VclFakeGroup:=False;
   ScanGroupsItem^.SchedForFix:=True;

   Inc(ScanGroupsCnt);
   SetLength(ScanGroupsList, ScanGroupsCnt);
   ScanGroupsList[ScanGroupsCnt]:=ScanGroupsItem;
 end;
end;

procedure TstUnloader;
var i: integer;
begin
 for i := 1 to ScanGroupsCnt do
   FreeMem(PScanGroupsItem(ScanGroupsList[i]));
end;

end.


Вызываю TstLoader в OnCreate формы. При закрытии приложения, получаю access violationб в функции SysFreeMem, модуля GETMEM.INC:


function SysFreeMem(P: Pointer): Integer;
asm
{$ifdef CPU386}
{---------------32-bit BASM SysFreeMem---------------}
 {On entry:
   eax = P}
 {Get the block header in edx}
 mov edx, [eax - 4]
 {Is it a small block in use?}
 test dl, IsFreeBlockFlag + IsMediumBlockFlag + IsLargeBlockFlag
 {Save the pointer in ecx}
 mov ecx, eax
 {Save ebx}
 push ebx
 {Get the IsMultiThread variable in bl}
 mov bl, IsMultiThread
 {Is it a small block that is in use?}
 jnz @NotSmallBlockInUse
 {Do we need to lock the block type?}
 test bl, bl
 {Get the small block type in ebx}
 mov ebx, TSmallBlockPoolHeader[edx].BlockType
 {Do we need to lock the block type?}
 jnz @LockBlockTypeLoop
@GotLockOnSmallBlockType:
 {Current state: edx = @SmallBlockPoolHeader, ecx = P, ebx = @SmallBlockType}
 {Decrement the number of blocks in use}
 sub TSmallBlockPoolHeader[edx].BlocksInUse, 1
 {Get the old first free block}
 mov eax, TSmallBlockPoolHeader[edx].FirstFreeBlock
 {Is the pool now empty?}
 jz @PoolIsNowEmpty
 {Was the pool full?}
 test eax, eax
 {Store this as the new first free block}
 mov TSmallBlockPoolHeader[edx].FirstFreeBlock, ecx
 {Store the previous first free block as the block header}
 lea eax, [eax + IsFreeBlockFlag]
 mov [ecx - 4], eax
 {Insert the pool back into the linked list if it was full}
 jz @SmallPoolWasFull
 {All ok}
 xor eax, eax
 {Unlock the block type}
 mov TSmallBlockType[ebx].BlockTypeLocked, al
 {Restore registers}
 pop ebx
 {Done}
 ret
 {Align branch target}
 nop


Исключение в этой строчке:

 {Unlock the block type}
 mov TSmallBlockType[ebx].BlockTypeLocked, al


Подскажите пожалуйста, что не так делаю?..



Игорь Шевченко ©   (2016-08-08 19:03) [1]


>    FreeMem(PScanGroupsItem(ScanGroupsList[i]));


FreeMem(PScanGroupsItem(ScanGroupsList[Pred(i)]));

Динамические массивы с нуля индексируются.



Денис11998833   (2016-08-08 19:33) [2]

Велике спасибі! Вилетіло з голови((



iop ©   (2016-08-09 08:52) [3]

ScanGroupsCnt - зайва змінна



Kilkennycat ©   (2016-08-09 10:15) [4]


> Iop © (09.08.16 08: 52) [3]

она для информативности. и надежности. просто "и" ненадежно и неинформативно



iop ©   (2016-08-09 10:29) [5]

што, і навіть в циклі на Фрімен по довжині масиву?



Kilkennycat ©   (2016-08-09 11:10) [6]

там інша справа, там вона з 1 починається.



Тимохов Дима ©   (2016-08-12 01:28) [7]


> Денис11998833 (08.08.16 18:04)


Коллега, а зачем ты отключил Range checking?
Поставил бы {R+} в коде или соотв. галку в настройках проекта - и сразу бы сам нашел.

Знаю, что многие отключают проверки на границы массива. Но мое имхо, что на стадии разработки это чертовски полезная штука.

А в боевой сборке можно и отключать.



Kilkennycat ©   (2016-08-12 01:46) [8]


> А в боевой сборке можно и

спользовать LOW() HIGH() или аналогичное



Германн ©   (2016-08-12 02:11) [9]


> Kilkennycat © (12.08.16 01: 46) [8]
>
>
> > А в боевой сборке можно и
>
> спользовать LOW() HIGH()

Вот это полезный совет для любой сборки!



сторінки: 1 вся гілка

Форум: "Початківцям";
Поточний архів: 2018.09.23;
Завантажити: [xml.tar.bz2];

наверх









Пам'ять: 0.59 MB
Час: 0.014 c
1-1359435539
tButton
2013-01-29 08:58
2018.09.23
переповнення стека


15-1474373519
Кіпор
2016-09-20 15:11
2018.09.23
IDE Delphi XE - стираються bookmark в режимі DFM


2-1471034827
Pavor
2016-08-12 23:47
2018.09.23
Відображення документа з полями Edit, мітками, зображеннями ..


2-1470668686
Деніс11998833
2016-08-08 18:04
2018.09.23
Допоможіть будь ласка знайти помилку в коді





африкаанс албанський арабська вірменин азербайджанець баскський білоруський болгарська каталонський Китайська (спрощене письмо) Китайський традиційний) хорватський чеська данську мову нідерландський Ukranian естонець Філіппінська фінську мову французький
галісійська грузинський німецький грецький гаїтянський креольський давньоєврейську хінді угорський ісландський індонезієць ірландський італійський японський корейський латиська литовець македонець малайський мальтійський норвежець
перс полірування португальська румунський російська сербський словацький словенський іспанська суахілі шведську мову тайський турецька український урду в'єтнамський валлійський ідиш бенгальський боснійський
кебуано есперанто гуджараті хауса хмонг ігбо яванський каннада кхмерская Лао латинь маорі маратхі монгольський непальська панджабі сомалійський тамільська телугу йоруба
зулуський
Англійська Французький Німецький Італійський Португальська Русский Іспанська