I have another question about TList in Delphi...
I'm getting an EArgumentOutOfRangeException when accessing a TList, just the same way I've done before, after printing a different TList to console.
copy&pasted the original code below - did not change a single line
Writeln('c: '+inttostr(closed.Capacity)+' |l. 281');
for i := 0 to open.Capacity-1 do
begin
Writeln('open: ' + open[i].startpunkt + open[i].endpunkt +
IntToStr(open[i].kantenbewertung));
end;
Writeln('c: '+inttostr(closed.Capacity));
Writeln('closed.capacity: '+inttostr(closed.Capacity));
for i := 0 to closed.Capacity-1 do begin
Writeln('closed: ' + closed[i].startpunkt + closed[i].endpunkt +
IntToStr(closed[i].kantenbewertung));
end;
The Writeln('c: '+inttostr(closed.Capacity)+' |l. 281'); is clearly printed to console, the for i := 0 to open.Capacity-1 do begin-loop as well.
Console output is:
c: 2 |l. 281
open: AC3
open: BC4
open: CD6
- and then there is the error msg
Is supposed to be part of a implementation of Dijkstra's alg. if this helps.
Does anyone spot a mistake I haven't? Or is this some weird special case?
Capacity is not the same (and may be greater) than the actual Count.
Related
I have an external message coming in every second.
The message payload is saved in a ClientDataSet and displayed in a dbGrid.
No data base is involved. RAM storage only.
This works fine,
BUT,
I have intermittent problems when the dataset is empty and populated the first time.
The code is as follows:
procedure TCtlCfg_DM_WarningsFaults_frm.DecodeRxFrame(Protocol: TProtocolSelection;
// PROVA UTAN VAR VAR Frame : CAN_Driver.TCAN_Frame);
Frame : CAN_Driver.TCAN_Frame);
var
OldRecNo : integer;
// OldIxname : string;
// bMark : TBookMark;
WasFiltered : Boolean;
IdBitFields : TCanId_IdBitFields;
Msg : TCan_Msg;
MsgType : integer;
GlobalNode : TCanId_GlobalNode;
LocalNode : TCanId_LocalNode;
SubNode : TCanId_SubNode;
EntryType : integer;
SubSystemType : integer;
SubSystemDeviceId : integer;
IsActive : Boolean;
IsAcked : Boolean;
begin
with cdsWarningsFaults do
begin
if not Active then Exit;
Msg := Frame.Msg;
IdBitFields := DecodeCanId(Protocol, Frame.ID);
if IdBitFields.SubNode <> cSubNode_Self then Exit; // Ignore non controller/slave messages
if IdBitFields.AddressMode <> cCanId_AddrMode_CA then Exit;
MsgType := IdBitFields.MessageType;
if MsgType <> cMsg_CTL_CA_Broadcast_WarningAndFaultList then Exit;
if Frame.MsgLength < 5 then Exit;
GlobalNode := IdBitFields.GlobalNode;
LocalNode := IdBitFields.LocalNode;
SubNode := IdBitFields.SubNode;
// Silent exit if wrong node
if GlobalNode <> fNodeFilter.GlobalNode then Exit;
if LocalNode <> fNodeFilter.LocalNode then Exit;
if SubNode <> fNodeFilter.SubNode then Exit;
EntryType := Msg[1];
SubSystemType := Msg[2];
IsActive := (Msg[3] = 1);
SubSystemDeviceId := Msg[4];
IsAcked := (Msg[8] = 1);
DisableControls; // 2007-12-03/AJ Flytta inte scrollbars under uppdatering
OldRecNo := RecNo;
// OldIxName := IndexName; // Save current index
// IndexName := IndexDefs.Items[0].Name;
WasFiltered := Filtered; // Save filter status
Filtered := False;
try
try
if Findkey([GlobalNode, LocalNode, SubNode, EntryType, SubSystemType, SubSystemDeviceId]) then
begin // Update record
Edit;
FieldByName('fIsActive').AsBoolean := IsActive;
FieldByName('fIsAcked').AsBoolean := IsAcked;
FieldByName('fTimeout').AsDateTime := GetDatabaseTimeoutAt;
Post;
MainForm.AddToActivityLog('CtlCfg_DM_WF: DecodeRxFrame: Efter Edit. N=' + IntToStr(GlobalNode) + ' ' +
IntToStr(LocalNode) + ' ' +
IntToStr(SubNode) +
' RecCnt=' + IntToStr(RecordCount) + ' ET=' + IntToStr(EntryType) + ' SST=' + IntToStr(subSystemType) + ' SSD=' + IntToStr(SubSystemDeviceId), False);
end
else
begin // Create new record
Append;
MainForm.AddToActivityLog('CtlCfg_DM_WF: DecodeRxFrame: Efter Append. N=' + IntToStr(GlobalNode) + ' ' +
IntToStr(LocalNode) + ' ' +
IntToStr(SubNode) +
' RecCnt=' + IntToStr(RecordCount) + ' ET=' + IntToStr(EntryType) + ' SST=' + IntToStr(subSystemType) + ' SSD=' + IntToStr(SubSystemDeviceId), False);
try
FieldByName('fGlobalNode').AsInteger := GlobalNode;
FieldByName('fLocalNode').AsInteger := LocalNode;
FieldByName('fSubNode').AsInteger := SubNode;
FieldByName('fEntryType').AsInteger := EntryType;
FieldByName('fSubSystemType').AsInteger := SubSystemType;
FieldByName('fSubSystemDeviceId').AsInteger := SubSystemDeviceId;
FieldByName('fIsActive').AsBoolean := IsActive;
FieldByName('fIsAcked').AsBoolean := IsAcked;
FieldByName('fTimeout').AsDateTime := GetDatabaseTimeoutAt;
finally
try
Post; // VArför biter inte denna post så att det blir edit nästa gång
except
MainForm.AddToActivityLog('CtlCfg_DM_WF: DecodeRxFrame: Exception efter Post.', True);
end;
MainForm.AddToActivityLog('CtlCfg_DM_WF: DecodeRxFrame: Efter Post. N=' + IntToStr(GlobalNode) + ' ' +
IntToStr(LocalNode) + ' ' +
IntToStr(SubNode) +
' RecCnt=' + IntToStr(RecordCount) + ' ET=' + IntToStr(EntryType) + ' SST=' + IntToStr(subSystemType) + ' SSD=' + IntToStr(SubSystemDeviceId), False);
end;
end;
except
on E: Exception do
begin
MainForm.AddToActivityLog('Post exception message: [' + E.Message + ']', False);
MainForm.AddToActivityLog('Post exception class: [' + E.ClassName + ']', False);
MainForm.AddToActivityLog('Post exception Error code: [' + IntToStr(EDBCLIENT (E).ErrorCode) + ']', False);
MainForm.AddToActivityLog('Post exception ReadOnly is: [' + BoolToStr(ReadOnly) + ']', False);
MainForm.AddToActivityLog('Post exception CanModify is: [' + BoolToStr(CanModify) + ']', False);
MainForm.AddToActivityLog('DecodeRxFrame: Exception inside FindKey block', False);
Cancel;
end;
end;
finally
// IndexName := OldIxName; // Restore previous index
Filtered := WasFiltered; // Restore filter state
if (OldRecNo >= 1) and (OldRecNo <= RecordCount) then RecNo := OldRecNo;
EnableControls;
end;
end;
//MainForm.AddToActivityLog('DecodeRxFrame: Exit ur proceduren', False);
end;
The problem is when the record does not already exist,
and I need to Append a new record.
It often works fine, but many times it seems the POST does not work,
and the append is repeated a few or many times when new data comes in.
Suddenly the append works, and subbsequent updates are done using edit,
and as far as I can tell, after that it then works forever.
The issue is intermittent and the number of tries needed to succeed vary.
It feels like a timing issue, but I cannot figure it out.
Any ideas greatly appreciated.
Thanks,
Anders J
As mentioned in my comment a lot can be figured out about how the code flows using an extract of the logs. (Also as a side-note, sometimes you need to be careful of the reliability of your logging system. Your logging is at least partially home-brew, so I have no idea what it means when you arbitrarily pass True/False values to the AddToActivityLog method.)
However, I am still able to offer some guidance to help you identify your problem. I also have some general comments to help you improve your code.
You're not shy to use logging to narrow down your problem: this is a good thing!
However you technique could use a little improvement. You're trying to determine what's going wrong around the Post method. Given such a clear goal, your logging seems surprisingly haphazard.
You should do the following:
//Log the line before Post is called. It confirms when it is called.
//Log important state information to check you're ready to post "correctly"
//In this it's especially useful to know the Sate of the dataset (dsEdit/dsInsert).
Post;
//Log the line after Post to confirm it completed.
//Note that "completed" and "succeeded" aren't always the same, so...
//Again, you want to log important state information (in this case dsBrowse).
If you had this this logging, you might (for example) be able to tell us that:
Before calling Post dataset is in dsInsert state.
And (assuming no exceptions as you say): after calling Post the dataset is still in dsInsert state.
NOTE: If it were in dsBrowse but Post still considered "unsuccessful", you'd be told to log details of the record before and after Post.
So now: Post "completing" without the record being "posted" would give a few more things to look at:
What events are hooked to the data set? Especially consider events used for validation.
Since you're working with TClientDataSet there's an important event you'll want to take a look at OnPostError. DBClient uses this callback mechanism to notify the client of errors while posting.
If you log OnPostError I'm sure you'll get a better idea of the problem.
Finally I mentioned you have a lot of other problems with your code; especially the error handling.
Don't use with until you know how to use it correctly. When you know how to use it correctly, you'll also know there's never a good reason to use it. As it stands, your code is effectively 2 characters short of a subtle bug that could have been a nightmare to even realise it even existed; but would be a complete non-issue without with. (You declared and used a property called IsActive differing by only 2 characters from TDataSet's Active. I'm sure you didn't realise this; and their difference is but an accident. However, if they had been the same, with would very quietly use the wrong one.)
You need to write smaller methods - MUCH smaller! Blobs of code like you have are a nightmare to debug and are excellent at hiding bugs.
Your exception handling is fundamentally wrong:
Your comment about logging and exception handling suggests that you've been simply adding what you can out of desperation. I think it pays to understand what's going on to keep your logging useful and avoid the clutter. Let's take a close look at the most problematic portion.
/_ try
/_ FieldByName('fGlobalNode').AsInteger := GlobalNode;
/_E FieldByName('fLocalNode').AsInteger := LocalNode;
| FieldByName('fSubNode').AsInteger := SubNode;
| FieldByName('fEntryType').AsInteger := EntryType;
| FieldByName('fSubSystemType').AsInteger := SubSystemType;
| FieldByName('fSubSystemDeviceId').AsInteger := SubSystemDeviceId;
| FieldByName('fIsActive').AsBoolean := IsActive;
| FieldByName('fIsAcked').AsBoolean := IsAcked;
| FieldByName('fTimeout').AsDateTime := GetDatabaseTimeoutAt;
|_ finally
/_ try
/_ Post;
/ except
| MainForm.AddToActivityLog(..., True);
| end;
|_ MainForm.AddToActivityLog(..., False);
/ end;
|
...
So, in the above code:
If no exceptions happen, you'd simply step from one line to the next.
But as soon as an exception happens, you jump to the next finally/except block.
The first problem is: Why would you try to force a Post if you haven't finished setting your field values. It's a recipe for headaches when you end up with records that have only a fraction of the data they should - unless you're lucky and Post fails because critical data is missing.
When finally finishes during an exception, code immediately jumps to the next finally/except in the call-stack.
Except is slightly different, it only gets called if something did go wrong. (Whereas finally guarantees it will be called with/without an exception.
TIPS: (good for 99% of exception handling cases.
Only use try finally for cleanup that must happen in both success and error cases.
Nest your try finally blocks: The pattern is <Get Resource>try .... finally<Cleanup>end (The only place to do another resource protection is inside the .....)
Avoid except in most cases.
The main exception to the previous rule is when cleanup is needed only in the case of an error. In which case: do the cleanup and re-raise the exception.
Other than that: only implement an except block without re-raising if you can fully resolve an error condition. (Meaning the lines of code immediately after the exception swallower truly don't care about the previous exception.
I'm with a problem here while using the Delphi Regex records. This is my problem code:
function CrawlThread.CrawlLinks: bool;
var
Matches: TMatchCollection;
Match: TMatch;
i: integer;
begin
Matches:= TRegex.Matches(code, frmCrawler.Edit2.Text);
if Matches.Count > 0 then
begin
i:= 0;
for Match in Matches do
begin
SetLength(CrawledLinks, i + 1);
if (POS('https://', Match.Value) = 0) then
CrawledLinks[i]:= 'http://' + Match.Value
else
CrawledLinks[i]:= Match.Value;
inc(i);
end;
Result:= true;
end;
Matches:= TRegex.Matches(code, frmCrawler.Edit3.Text);
if Matches.Count > 0 then
begin
i:= 0;
for Match in Matches do
begin
SetLength(FollowLinks, i + 1);
if (POS('https://', Match.Value) = 0) then
FollowLinks[i]:= 'http://' + Match.Value
else
FollowLinks[i]:= Match.Value;
inc(i);
end;
Result:= true;
end;
This code gets called multiple times inside threads, if I comment it, I get like 26MB on memory usage, and not growing up... When I use it, I start around 50MB (what is not a problem), but it keeps growing up like 1MB per minute (in 1 min this code gets called hundreds of times).
Using the ReportMemoryLeaksOnShutdown:= true; I get this output:
It's almost the same when commented or using the code, so I don't believe it explain the 1MB per minute when using the code. Of course the UnicodeString leaks bother me, but as I get them even when not using the code, I don't think they are the problem.
Is there any idea on why that code is consuming so much memory?
I dont think any of the shown code is leaking, since TMatchCollection and TMatch are pure records.
I have seen similar build-up of memory due to allocation of strings. But it must stabilize after a while, unless they are f.ex added to a TStringList without ever cleaning it.
That leads me to the next: The message box speaks about 2 x TStringList that are never freed. Have you tried so search your project for all TStringList.Create and made sure there are matching TStringList.Free?
Likewise for TCriticalSection and TIdHashMessageDigest5?
Just to be sure: in the above code it seems its a method inside a Thread class? If so, it will lead to errors referring to the components frmCrawler.Edit2.Text and frmCrawler.Edit3.Text in the VCL thread.
I am attempting to create a simple debug visualiser for TDatasets (well, I'm having to make it a TADODataset for now, so I can use the .SaveToFile method).
I've pretty much copied the TStrings visualiser example suplied by EMBT, but am running into problems when the form is being shown, as it gives me an AV without showing any data.
The top part of the callstack in the AV looks like this:
[5003C49E]{rtl150.bpl } System.#UStrAsg (Line 17745, "System.pas" + 30) + $0
[149038D1]{DatasetVisualiserProject.bpl} Datasetvisualiserframe.TDatasetVisualiserFrame.ThreadNotify + $151
[20A2CA9A]{coreide150.bpl} DebuggerMgr.TDebuggerMgr.OnShowVisualizer (Line 1112, "DebuggerMgr.pas" + 4) + $3B
So it's a problem with string assignments, likely unallocated memory? Like the TStrings implementation my ThreadNotify procedure has no code in it.
My 'work' routine replaces the TStrings implementation's AddStringListItems call, and looks like this:
procedure TDatasetVisualiserFrame.SetDataset(const Expression, TypeName, EvalResult: string);
var
TempFilename: string;
begin
FAvailableState := asAvailable;
FExpression := Expression;
IntDataset.Close;
TempFileName := GetTempFile('DSDebug');
try
if FTypeName = TADODataset.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset_ADO.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset_ADO;
end
else if FTypeName = TKBMMemTable.Classname then
begin
Evaluate(Format('%s.SaveToFile(%s)', [FExpression, TempFileName]));
IntDataset.LoadFromFile(TempFileName);
srcIntDataset.DataSet := IntDataset;
end
else raise Exception.Create('Unhandled class type ' + TypeName);
finally
if fileexists(TempFileName) then
begin
DeleteFile(TempFileName);
end;
end;
DebugDatasetView.beginupdate;
try
DebugDatasetView.ClearItems;
DebugDatasetView.DataController.CreateAllItems(false);
finally
DebugDatasetView.endupdate;
end;
end;
The frame itself has a TADODataset, Datasource and a QuantumGrid component for display (though a DBGrid should work)
Do I need to do something with thread handling because I'm dealing with Datasets or is it something more fundamental?
As a bonus question: My original plan was to take a TDataset and use KBMMemTable's LoadFromDataset routine passing in the original dataset, but soon after starting I discovered I was limited to getting strings back from the debugger so this wasn't possible. Am I mistaken, or is there a tricksy way around it?
After being given the means of how to debug the IDE (thanks #David M) I noticed that I hadn't implemented FrameCreated properly.
Other than that, SaveToFile also needed the filename with QuotedStr, otherwise the file would be created empty and LoadFromFile would fail due to an empty stream.
Now it works perfectly :-)
I'm getting this error message under heavy load. Here is code abstract and message from my error log.
I tried everything I could think of. Any suggestion would be greatly appreciated.
Procedure tCacheInMemory.StreamValue(Name: String; IgnoreCase: Boolean; Var Stream: TStringStream);
Var
i: Integer;
Begin
i := 0;
Try
If Not active Then
exit;
arrayLock.BeginRead;
Try
i := Search(Name);
If i > -1 Then Begin
If fItems[i].value = Nil Then
exit;
fItems[i].value.Position := 0;
Stream.Position := 0;
Stream.CopyFrom(fItems[i].value, fItems[i].value.Size);
End;
Finally
arrayLock.EndRead;
End;
Except { ...execution jumps to here }
On E: Exception Do Begin
x.xLogError('LogErrorCacheInMemory.txt', 'StreamValue:' + E.Message + ' ItemsCount:' + IntToStr( High(fItems)) + 'Memory:' + IntToStr(x.GetMemoryInfoMemory) + endLn + 'StreamSize : ' + IntToStr(fItems[i].value.Size) + ' i=' + IntToStr(i) + 'Name: ' + Name);
Clear;
End
End;
End;
Log Entries:
3/10/2011 10:52:59 AM: StreamValue:Stream read error ItemsCount:7562 Memory:240816
StreamSize : 43 i=7506 Name: \\xxxxxxxx\WebRoot\\images\1x1.gif
3/10/2011 12:39:14 PM: StreamValue:Stream read error ItemsCount:10172 Memory:345808
StreamSize : 849 i=10108 Name: \\xxxxxxxx\WebRoot\\css\screen.add.css
3/10/2011 3:45:29 PM: StreamValue:Stream read error ItemsCount:11200 Memory:425464
StreamSize : 3743 i=11198 Name: \\xxxxxxxx\WebRoot\\JS\ArtWeb.js
P.S.
arrayLock: TMultiReadExclusiveWriteSynchronizer;
fItems: Array Of rCache;
Type
rCache = Record
Name: String;
value: TStringStream;
expired: TDateTime;
End;
And calling function:
Function tCacheInMemory.CacheCheck(cName: String; Out BlobStream: TStringStream): Boolean;
Begin
Result := False;
If Not IfUseCache Then
exit;
BlobStream.SetSize(0);
BlobStream.Size := 0;
StreamValue(trim(cName), True, BlobStream);
If BlobStream.Size > 0 Then
Result := True;
End;
`
You're not using correct locking. You're acquiring a read lock on the array of cache entries, but once you find the item you want, you modify it. First, you explicitly modify it by assigning its Position property, and then you implicitly modify it by reading from it, which modifies its Position property again. When other code attempts to read from that same cache item, you'll have interference. If the source stream's Position property changes between the time the destination stream calculates how many bytes are available and the time it actually requests to read those bytes, you'll get a stream-read error.
I have a couple pieces of advice related to this:
Don't use streams as a storage device in the first place. You're apparently holding the contents of files. You're not going to change those, so you don't need a data structure designed for making sequential changes. Instead, just store the data in simple arrays of bytes: TBytes. (Also, use of TStringStream in particular introduces confusion over whether those strings' encodings are important. A simple file cache shouldn't be concerned with string encodings at all. If you must use a stream, use a content-agnostic class like TMemoryStream.)
Don't quell an exception that you haven't actually handled. In this code, you're catching all exception types, logging some information, clearing the cache, and then proceeding as though everything is normal. But you haven't done anything to resolve the problem that triggered the exception, so everything is not normal. Since you're not really handling the exception, you need to make sure it propagates to the caller. Call raise after to call Clear. (And when you log the exception, make sure you log the exception's ClassName value as well as its message.)
It looks like something external is blocking your stream files.
You could try to use Process Monitor to see what blocks it.
Another thing you can try is to open the stream in read-deny-write mode (please show us how you open the stream).
Something like this:
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite) ;
Edit 1: Disregard the strike through part: you are using TStringStream.
I'll keep the answer just in case anyone ever gets this kind of error when using TFileStream.
Edit 2: Yuriy posted this interesting addendum, but I'm not sure it will work, as the BlobStream is not initialized, just like Robert Love suspected:
Function TCacheInMemory.CacheCheck(cName: String; Out BlobStream: TStringStream): Boolean;
Begin
Result := False;
Try
If Not IfUseCache Then
exit;
BlobStream.SetSize(0);
BlobStream.Size := 0;
StreamValue(trim(cName), True, BlobStream);
If BlobStream.Size > 0 Then
Result := True;
Except
On E: Exception Do
Begin
x.xLogError('LogErrorCacheInMemory.txt', 'CheckCacheOutStream:' + E.Message + ' ItemsCount:' + IntToStr( High(fItems)) + 'Memory:' + IntToStr(x.GetMemoryInfoMemory));
End;
End;
End;
--jeroen
I had a topic 1-2 weeks ago about a "The block header has been corrupted" and "Block has been modified after being freed" error.
Somebody gave me a good tip (thanks Alexander) about setting FullDebugModeScanMemoryPoolBeforeEveryOperation to true and finally I have some indications about where is the TRUE location of the error.
The error log points to TScObj object. I have a second object very similar to this one and when I use it the error does not appear. So, this somehow confirms that the error is in this specific object (TScObj).
The log is like this:
FastMM has detected an error during a free block scan operation.
FastMM detected that a block has been modified after being freed.
Modified byte offsets (and lengths): 15656(1)
The previous block size was: 15672
This block was previously allocated by thread 0xC88, and the stack trace (return addresses) at the time was:
402EC9 [System][#ReallocMem]
40666C [System][DynArraySetLength]
40A17D [FastMM4][UpdateHeaderAndFooterCheckSums]
40674E [System][#DynArraySetLength]
4CE329 [ReadSC.pas][ReadSC][TScObj.ReadData][239]
4CDD0C [ReadSC.pas][ReadSC][TScObj.LoadFromFile][168]
4D013E [SmplCubImport.pas][SmplCubImport][TCubImport.ImportSample][164]
40461A [System][#AfterConstruction]
4DC151 [UnitAsmJob.pas][UnitAsmJob][TAsmJob.LoadSample][960]
The allocation number was: 78709
The block was previously freed by thread 0xC88, and the stack trace (return addresses) at the time was:
402E6F [System][#FreeMem]
4068A8 [System][#DynArrayClear]
405DF9 [System][#FinalizeArray]
4CE9F9 [ReadSC.pas][ReadSC][TScObj.ReadData][298]
4CDD0C [ReadSC.pas][ReadSC][TScObj.LoadFromFile][168]
4D013E [SmplCubImport.pas][SmplCubImport][TCubImport.ImportSample][164]
40461A [System][#AfterConstruction]
4DC151 [UnitAsmJob.pas][UnitAsmJob][TAsmJob.LoadSample][960]
The thing is that I don't see any place in my code where I could wrongfully allocate memory.
type
TWordTrace = array of Word;
TDiskTrc = array of Smallint;
var Tracea,Tracec: TWordTrace;
procedure TScObj.ReadData;
Var i: Integer;
DiskTrc1: TDiskTrc;
DiskTrc2: TDiskTrc;
DiskTrc3: TDiskTrc;
DiskTrc4: TDiskTrc;
begin
SetLength(DiskTrc1, H.NrOfSamples+1);
SetLength(DiskTrc2, H.NrOfSamples+1);
SetLength(DiskTrc3, H.NrOfSamples+1);
SetLength(DiskTrc4, H.NrOfSamples+1); <------ log shows error here. <- on DynArraySetLength
FStream.Seek( H.SOffset, soFromBeginning);
if H.SampleSize = 1 then
begin
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
Unpack(DiskTrc1);
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc2[i], 1);
Unpack(DiskTrc2);
etc...
end
else
begin
for i:= 1 TO H.NrOfSamples DO
begin
FStream.Read( DiskTrc1[i], 2);
DiskTrc1[i]:= Swap(DiskTrc1[i]);
end;
Unpack(DiskTrc1);
for i:= 1 TO H.NrOfSamples DO
begin
FStream.Read( DiskTrc2[i], 2);
DiskTrc2[i]:= Swap(DiskTrc2[i]);
end;
Unpack(DiskTrc2);
etc...
end;
SetLength(Tracea, H.NrOfSamples+1);
SetLength(Tracec, H.NrOfSamples+1);
SetLength(Traceg, H.NrOfSamples+1);
SetLength(Tracet, H.NrOfSamples+1); <------ log shows error here. <- on FinalizeArray
for i:=1 to H.NrOfSamples DO
begin
if DiskTrc1[i]< 0
then Tracea[i]:= 0
else Tracea[i]:= DiskTrc1[i];
if DiskTrc2[i]< 0
then Tracec[i]:= 0
else Tracec[i]:= DiskTrc2[i];
etc...
end;
end;
procedure TScObj.Unpack(VAR DiskTrc: TDiskTrc);
var i: integer;
Prev: Integer;
Recover: Integer;
begin
Prev:= 0;
for i:= 1 to H.NrOfSamples do
begin
Recover := DiskTrc[i] + Prev;
if (Recover> 32767) OR (Recover< -32768)
then Recover:= 0;
DiskTrc[i]:= Recover;
Prev:= DiskTrc[i];
end;
Prev:= 0;
for i:= 1 to H.NrOfSamples do
begin
Recover := DiskTrc[i] + Prev;
if (Recover> 32767) OR (Recover< -32768)
then Recover:= 0;
DiskTrc[i]:= Recover;
Prev:= DiskTrc[i];
end;
end;
Later during the "load from disk" procedure, the information from the temporary loader object (SC) is transfered into a more "definitive" object, like this:
TSam = class
etc...
for i:= 1 to NrOfSamples DO
begin
CMX[i].Tracea:= SC.Tracea[i];
CMX[i].Tracec:= SC.Tracec[i];
etc...
end;
Edit 2:
The bug appears only when I try to open/load a very specific set of (two) files. For all other files the bug doesn't show.
Did you try to run this code with FullDebugModeScanMemoryPoolBeforeEveryOperation enabled? Did you try to call ScanMemoryPoolForCorruptions at TScObj.ReadData's start?
If that doesn't help - try to step into that problem call (GetMem?) and follow FastMM's code to see the address of that corrupted header. Just write it down on the paper and restart the program. There are very high chances that the address of this block will be the same.
Set a breakpoint at safe location - i.e. right before "bad things" happens. Once stopped on it - then set a new breakpoint on memory's location - right at this header, which will become corrupted later (be sure not to set it too early).
Then just run your program - the debugger will stop right at this bad code, which tries to modify header.
I think you've got corruption happening elsewhere, and what looks like a routine call is just unmasking the problem. The locations you're pointing to don't seem likely to currupt memory. Without looking at the code in detail, isolating procedures and testing them carefully, it's awfully hard to guess where the problem lies. Do you get any warnings when you compile?
I'm thinking the error is not ion the code shown, but there is something you should really check:
SetLength(DiskTrc1, H.NrOfSamples+1);
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
This works thanks to the +1 in Setlength, but are you aware that you are allocating 1 extra item at DiskTrc1[0] that is never used?
I suspect that you mix this with a Setlength(xx, N) somewhere (how is CMX created/dimensioned?).
Note that the normal pattern is
SetLength(DiskTrc1, H.NrOfSamples);
for i:= 0 TO H.NrOfSamples-1 DO
FStream.Read( DiskTrc1[i], 1);
You need to show more code (like, how is TDiskTrc defined?)
A few points:
Remember that Dynamic arrays are reference-counted, have you tried running with and without Optimizations?
Before using any of these items you may want to assert:
assert(CMX <> nil);
assert(Length(CMX) = NrOfSamples+1);
Is there any code (Swap, Unpack, ...) that stores a reference to an Array?
Are you re-using thos SC objects? (Hint: don't)
Are you clearing any arrays (like DiskTrc1 := nil or SetLength(DiskTrc1, 0) ?
Everyone seems to be skipping the important error at the start:
FastMM has detected an error during a free block scan operation. FastMM detected that a block has been modified after being freed.
An old pointer is being used somewhere.
Since you have no clue on the pointer error you are looking for I would forget it for now and go look for the other one--they might turn out to be related.
Solved.
Today I spent the day manually inspecting each line of code. I made quite few changes and finally the problem went away. I haven't tried to see which specific line generated the problem.
Thanks a lot to every body for help !!!
Are your arrays 0-based or 1-based?
Multiple times you run loops like this:
if H.SampleSize = 1 then
begin
for i:= 1 TO H.NrOfSamples DO
FStream.Read( DiskTrc1[i], 1);
Unpack(DiskTrc1);
...
Are you sure this is not reading past the end of DiskTrc1?