Building, not just compiling, the following fails with an internal compiler error when using Delphi 6 if optimization is on. Using the assignment instead of the inc() works. Is this a compiler bug? The weird record structures are because the original code has been reduced to this minimal example.
program Project1;
type
requestCountsType = array[0..1] of
record
processed: int64;
end;
talliestype = record
counts: requestCountsType;
end;
healthtype = record
charged: talliestype;
end;
procedure computeProcessed(const h: healthtype; var requests, bytesin, bytesout: int64);
var i: byte;
begin
requests := 0; bytesin := 0; bytesout := 0;
for i := 0 to 1 do
begin
inc(requests, h.charged.counts[i].processed); // including this generates compiler internal error C1405 when optimization is on
// requests := requests + h.charged.counts[i].processed; // this works
end;
end;
var ht: healthtype; var r, b1, b2: int64;
begin
computeProcessed(ht, r, b1, b2);
end.
See bug report #109124. I can confirm the problem in Delphi XE; the bug report says it was fixed in Delphi XE4.
Related
I'm trying to read a .MEM file using Delphi. It's a FoxPro Memory Variable Files. I've tried to read using TFileStream and load into TStringList. But, it only returns the first word.
F := TFileStream.Create(sFile, fmOpenRead);
L := TStringList.Create;
try
F.Position := 0;
L.LoadFromStream(F);
ShowMessage(L.Text);
finally
F.Free;
L.Free;
end;
The reason is because I want to migrate some useful .MEM values from an old program to my new program. Thanks for any help.
If it's a one-time affair and you have access to a VFP installation - i.e. the IDE, not only the runtime - then David Heffernan's suggestion is certainly the most sensible way. In this case you can load and inspect the .MEM via
release all extended && to clear away all existing memvars
restore from foo && assuming the file in question is named FOO.MEM
activate window Locals && inspect the variables...
list memory to foo && or list them to FOO.TXT
modify file foo.txt
However, LIST MEMORY (and DISPLAY MEMORY) also include all the system variables - the things that start with an underscore - which would need to be parsed off.
If it's an ongoing affair - repeated imports necessary - and you know which variables you need then there are two fairly clean and easy ways.
The first is only valid if a VFP IDE is installed on the computer on which the Delphi program is to be run. In this case you can instantiate VFP from Delphi (leave it invisible), have it read the .MEM and then query individual variables:
procedure fetch_variables_from_MEM (mem_filename: string; var_list: CFoos);
var
fox: Variant;
foo: CFoo;
begin
fox := CreateOleObject('VisualFoxpro.Application.9');
try
fox.DoCmd('release all extended');
fox.DoCmd('restore from ' + mem_filename);
for foo in var_list do
foo.Value := fox.Eval('m.' + foo.Name);
finally
fox.Quit; // AutoQuit not supported
end;
end;
I glossed over some details, like that CoInitialize() needs to be called on the thread somewhere before calling this, and I assumed suitable definitions for the variable list (a list/collection of hypothetical CFoo objects), but the sketched outline works - even in 64-bit Delphi.
The advantage is that things like datetime values arrive as TDateTime by virtue of the COM infrastructure and the use of variants.
The second easy way is applicable if an IDE is not available on the machine where the Delphi program is to be used but you have access to an IDE somewhere, so that you can build a small COM server:
define class FoxWrapper as custom olepublic
function Eval (cExpression as string) as variant
return evaluate(m.cExpression)
procedure DoCmd (cCommand as string)
&cCommand
enddefine
This can then be used instead of "VisualFoxPro.Application.9" in the example above. Note: for 64-bit Delphi you need to build this as an out-of-process server (i.e. an EXE). Also, this may run afoul of the VFP licence conditions.
For accessing the data directly, here's some quick & dirty Delphi code that I modelled after some FoxPro stuff that I coded eons ago and updated for VFP9. This is proof-of-principle code with simplified array handling and other compromises for the sake of exposition; it lacks all the production-quality noise necessitated by Delphi's half-assed language definition and its quarter-assed runtime.
type
TMEMVarHeader = packed record
var_name: array [0..10] of AnsiChar;
mem_type: AnsiChar; // 0ACDHLNOQYacdhlnoqy
big_size: UInt32; // only if mem_type == 'H'
width : Byte; // special meaning if mem_type == 'H'
decimals: Byte;
padding : array [0..13] of Byte; // 0 0 0 0 0 0 0 3 0 0 0 0 0 0
end;
SizeOf_TMEMVarHeader_eq_32 = true .. SizeOf(TMEMVarHeader) = 32;
TMEMVarInfo = record
header: TMEMVarHeader;
null_t: AnsiChar;
name : AnsiString;
value : Variant;
function ReadFromStream (stream: TStream): Boolean; // false if EOF
end;
function TMEMVarInfo.ReadFromStream (stream: TStream): Boolean;
const
DELPHI_EPOCH = 2415019.0;
var
header_bytes_read: Integer;
name_length: UInt16;
text_length: UInt32;
array_dim_1: UInt16;
array_dim_2: UInt16;
d: TDate; // 64-bit double
l: Boolean;
n: Double; // 64-bit double
q: array of Byte;
c: AnsiString;
t: TDateTime; // 64-bit double
y: Int64;
binary: Boolean;
i: Cardinal;
a: array of Variant;
v: TMEMVarInfo;
begin
name := ''; value := Unassigned;
header_bytes_read := stream.Read(header, SizeOf(header));
if header_bytes_read <> Sizeof(header) then begin
if not ((header_bytes_read = 1) and (header.var_name[0] = #26)) then
raise Exception.Create('unexpected MEM file format (problem reading header)');
result := false; // EOF
EXIT;
end;
result := true;
// variable name
if header.var_name[0] = #0 then begin // long variable name
assert(header.mem_type = LoCase(header.mem_type));
stream.ReadBuffer(name_length, Sizeof(name_length));
SetLength(name, name_length);
stream.ReadBuffer(name[1], name_length);
end else begin
assert(header.mem_type = UpCase(header.mem_type));
name := header.var_name;
end;
// variable value
case UpCase(header.mem_type) of
'A':
begin
stream.ReadBuffer(array_dim_1, SizeOf(array_dim_1));
stream.ReadBuffer(array_dim_2, SizeOf(array_dim_2));
if array_dim_2 = 0 then // it's a vector, not an array
array_dim_2 := 1;
SetLength(a, array_dim_1 * array_dim_2);
for i := 0 to array_dim_1 * array_dim_2 - 1 do begin
if not v.ReadFromStream(stream) then
raise Exception.Create('error reading array element');
a[i] := v.value;
end;
value := a;
end;
'0': begin stream.ReadBuffer(null_t, 1); value := Null; end;
'C', 'H', 'Q':
begin
if UpCase(header.mem_type) = 'H' then begin // length > 254
binary := header.width <> 0;
text_length := header.big_size;
end else begin
binary := UpCase(header.mem_type) = 'Q';
text_length := header.width;
end;
if binary then begin
SetLength(q, text_length); stream.ReadBuffer(q[0], text_length); value := q;
end else begin
SetLength(c, text_length); stream.ReadBuffer(c[1], text_length); value := c;
end;
end;
'D': begin stream.ReadBuffer(d, Sizeof(d)); if d > 0 then d := d - DELPHI_EPOCH; VarCast(value, d, varDate); end;
'L': begin stream.ReadBuffer(l, Sizeof(l)); value := l; end;
'N': begin stream.ReadBuffer(n, Sizeof(n)); value := n; end;
'T': begin stream.ReadBuffer(t, Sizeof(t)); if t > 0 then t := t - DELPHI_EPOCH; value := t; end;
'Y': begin stream.ReadBuffer(y, Sizeof(y)); VarCast(value, y / 10000.0, varCurrency); end;
else
raise Exception.Create('unexpected type ''' + header.mem_type + ''' in MEM file');
end;
end;
For reading a .MEM, create a TFileStream and a TMEMVarInfo variable, then read variables one by one until var_info.ReadFromStream(stream) returns false.
Note: the byte at offset 19h (shown as 3 in the structure comment) is a code page identifier. The values are the same as those found in .DBF headers, i.e. 1 for DOS 437, 3 for Windows 1252 and so on. However, even though VFP stores these identifiers when writing a .MEM, all the newer versions of VFP that I tested completely ignore these code page marks when loading a .MEM. A self-written importer could put the code page marks to good use, though.
Reading the binary .mem files is not the correct way to proceed. The correct solution is to get VFP to export the data. It knows how to read it. Get VFP to export to a known format, and read that. This is the standard approach to data migration.
Using: Delphi XE7 Update 1, TAwImageGrid, Windows 10 Professional running on Intel Core i7-2820QM.
This code loads images into the grid from a database:
var
s, w: String;
r: Integer;
ms: TMemoryStream;
bmp: TBitmap;
begin
r := uqProj_Search.RecordCount;
// Load images
for r := imgGrid.Count - 1 downto 0 do
imgGrid.Items.Images[r].Free;
imgGrid.Clear;
ms := TMemoryStream.Create;
try
while not(uqProj_Search.Eof) do
begin
r := uqProj_Search.FieldByName('row_id').AsInteger;
// :proj_id
uqImg_S.ParamByName('proj_id').AsInteger := r;
uqImg_S.Prepared := True;
uqImg_S.Open;
ms.Clear;
uqImg_Simg.SaveToStream(ms);
uqImg_S.Close;
ms.Position := 0;
bmp := TBitmap.Create;
try
bmp.LoadFromStream(ms);
imgGrid.Items.Add(IntToStr(r));
imgGrid.Items.Images[imgGrid.Count - 1] := TBitmap.Create;
imgGrid.Items.Images[imgGrid.Count - 1].Assign(bmp);
finally
bmp.Free;
end;
uqProj_Search.Next;
end;
finally
ms.Free;
end;
end;
I have this code in the KeyDown event (called when the Del key is pressed):
procedure TfmSrchRec.imgGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
x, p: Integer;
AFormat: Word;
AData: THandle;
APalette: HPalette;
begin
x := imgGrid.ItemIndex;
p := StrToInt(imgGrid.Items.Strings[x]);
if (x = -1) then
Exit;
if (UpCase(Char(Key)) = 'C') and (Shift = [ssCtrl]) then
begin
// Clipboard.Assign(imgGrid.Images[imgGrid.ItemIndex])
TBitmap(imgGrid.Images[x]).Dormant;
TBitmap(imgGrid.Images[x]).SaveToClipboardFormat(AFormat, AData, APalette);
Clipboard.SetAsHandle(AFormat, AData);
end
else if (Key = VK_DELETE) then
begin
imgGrid.Items.Images[x].Free;
imgGrid.Items.Delete(x);
end;
end;
Freeing up memory in the form's OnClose event:
procedure TfmSrchRec.FormClose(Sender: TObject; var Action: TCloseAction);
var
r: Integer;
begin
for r := imgGrid.Count - 1 downto 0 do
imgGrid.Items.Images[r].Free;
end;
Here's the problem:
After deleting an image from the grid, if that image was the last remaining image, then closing the program would produce this error message:
---------------------------
Unexpected Memory Leak
---------------------------
An unexpected memory leak has occurred. The unexpected small block leaks are:
61 - 68 bytes: Unknown x 1
---------------------------
OK
---------------------------
The error does not occur if there was a remaining image in the grid before the application was closed. I have ReportMemoryLeaksOnShutDown := True at project startup (in the DPR file).
I'm guessing that this error has to do with the component's code more than the way I am using it. I'm hoping that the TAwImageGrid component author NGLN could have a look at this question and provide the answer, but other Delphi gurus are also welcome.
Links:
TAwImageGrid component source official home page:
https://github.com/NGLN/AwImageGrid
StackOverflow Question that gives a good introduction to the component:
Looking for a custom image grid
I can reproduce your findings and consider it a bug.
When making the component, I copied the implementation of TStringList from D7, i.e. by using a pointer to a non-existing fix-sized array for the internal storage of the items. Strangely enough, I cannot find flaws in it, but D7's TStringList implementation does not produce this bug. I suppose it has something to do as explained here.
I see that the implementation of TStringList in XE2 is changed to the use of a dynamic array. When I change the component's code to that same design, the memory leak is gone. So I will change the open source code too, but for the time being you might do yourself.
The following code to compare two Real48's (6-byte float) compiles and runs, but either generates non-nonsensical results or generates a AV.
program Project44;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Generics.Defaults;
begin
try
WriteLn(System.Generics.Defaults.TComparer<Real48>.Default.Compare(100.0,100.0));
WriteLn('all ok, press space');
except on E:exception do
WriteLn(e.Message);
end;
ReadLn
end.
It should output 0, but if it does not bomb first it outputs -92 or some other incorrect value.
Is this bug still present in the lastest XE8?
And if so, has it been reported before, I cannot find anything on the https://quality.embarcadero.com, but if there's an older QC I would like to refer to that.
Finally....
How do I compare two REAL48 types using TComparer<something>?
EDIT :
this was the fix I settled upon:
interface
...snip...
[Test]
procedure TestReal48;
...snip...
TTest<T> = record
private
class var Def: System.Generics.Defaults.IComparer<T>;
class var F: FastDefaults.TComparison<T>;
public
class function Real48Comparison(const Left, Right: T): Integer; static;
implementation
procedure TestDefault.TestReal48;
var
OldDef: System.Generics.Defaults.IComparer<Real48>;
begin
OldDef:= TTest<Real48>.Def;
TTest<Real48>.Def:= System.Generics.Defaults.TComparer<Real48>.Construct(TTest<Real48>.Real48Comparison);
TTest<Real48>.Test(100.0,100.0);
TTest<Real48>.Test(100000.0,-10000.0);
TTest<Real48>.Test(0.0,-10000.0);
TTest<Real48>.Test(100000.0,0.0);
TTest<Real48>.Test(0.0,0.0);
TTest<Real48>.Def:= OldDef;
end;
This defect is present in all versions of the compiler. Since Real48 was deprecated more than a decade ago I would expect that Embarcadero would not change the behaviour, even if you submitted a bug report. Of course, you should still submit a bug report, but I would not hold your breath when waiting for a fix!
You'll have to construct a comparer rather than relying on the default:
var
Comparer: IComparer<Real48>;
function Real48Comparison(const Left, Right: Real48): Integer;
begin
if Left < Right then
Result := -1
else if Left > Right then
Result := 1
else
Result := 0;
end;
Comparer := System.Generics.Defaults.TComparer<Real48>.Construct(Real48Comparison);
Why does the default Real48 comparer fail so hard. Well, it starts here:
class function TComparer<T>.Default: IComparer<T>;
begin
Result := IComparer<T>(_LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T)));
end;
It transpires that TypeInfo(Real48) yields nil. There would appear to be no type info available for Real48. Probably not a great surprise.
Then we reach here:
function _LookupVtableInfo(intf: TDefaultGenericInterface; info: PTypeInfo; size: Integer): Pointer;
var
pinfo: PVtableInfo;
begin
if info <> nil then
begin
pinfo := #VtableInfo[intf, info^.Kind];
Result := pinfo^.Data;
if ifSelector in pinfo^.Flags then
Result := TTypeInfoSelector(Result)(info, size);
if ifVariableSize in pinfo^.Flags then
Result := MakeInstance(Result, size);
end
else
begin
case intf of
giComparer: Result := Comparer_Selector_Binary(info, size);
giEqualityComparer: Result := EqualityComparer_Selector_Binary(info, size);
else
System.Error(reRangeError);
Result := nil;
end;
end;
end;
We take the else branch and call Comparer_Selector_Binary. So we end up performing a binary comparison. The comparison is actually performed by this function:
function Compare_Binary(Inst: PSimpleInstance; const Left, Right): Integer;
begin
Result := BinaryCompare(#Left, #Right, Inst^.Size);
end;
which calls:
function BinaryCompare(const Left, Right: Pointer; Size: Integer): Integer;
var
pl, pr: PByte;
len: Integer;
begin
pl := Left;
pr := Right;
len := Size;
while len > 0 do
begin
Result := pl^ - pr^;
if Result <> 0 then
Exit;
Dec(len);
Inc(pl);
Inc(pr);
end;
Result := 0;
end;
Not going to be useful for a real valued type.
As for the runtime error that relates to the ABI for Real48. It seems that Real48 parameters are always passed on the stack. That is just not compatible with the use of untyped parameters in Compare_Binary.
After upgrading to XE8 some of our projects start to break data. Looks like a bug in TList realization.
program XE8Bug1;
{$APPTYPE CONSOLE}
uses
System.SysUtils, Generics.Collections;
type
TRecord = record
A: Integer;
B: Int64;
end;
var
FRecord: TRecord;
FList: TList<TRecord>;
begin
FList := TList<TRecord>.Create;
FRecord.A := 1;
FList.Insert(0, FRecord);
FRecord.A := 3;
FList.Insert(1, FRecord);
FRecord.A := 2;
FList.Insert(1, FRecord);
Writeln(IntToStr(FList[0].A) + IntToStr(FList[1].A) + IntToStr(FList[2].A));
end.
This code prints "123" in XE7 and before (as it should be), but in XE8 it prints "120".
Maybe someone know a quickfix for this?
Update: unofficial fix is here
I found that now the TList<T>.Insert method call TListHelper.InternalInsertX depends on the data size, in my case:
procedure TListHelper.InternalInsertN(AIndex: Integer; const Value);
var
ElemSize: Integer;
begin
CheckInsertRange(AIndex);
InternalGrowCheck(FCount + 1);
ElemSize := ElSize;
if AIndex <> FCount then
Move(PByte(FItems^)[AIndex * ElemSize], PByte(FItems^)[(AIndex * ElemSize) + 1], (FCount - AIndex) * ElemSize);
Move(Value, PByte(FItems^)[AIndex * ElemSize], ElemSize);
Inc(FCount);
FNotify(Value, cnAdded);
end;
I see the problem in the first Move call. Destination should be:
PByte(FItems^)[(AIndex + 1) * ElemSize]
not
PByte(FItems^)[(AIndex * ElemSize) + 1]
Aaargh!
Finally, I've used the System.Generics.Defaults.pas and System.Generics.Collections.pas units from Delphi XE7 in my projects, and now all works as expected.
Update: as I see, RTL not affected, as it isn't use TList<T>.Insert for T with SizeOf > 8 (or maybe I miss something?)
Is there any additional runtime overhead in calling overloaded functions?
(I ask this specifically for Delphi, in case the answer isn't the same for all compiled languages)
I think not as that should be resolved during compile time, but you can never be sure can you?
Of course you can be sure, because it is documented. Is the compiler which resolves it at compile time, so there's no additional overhead on calling overloaded functions in Delphi.
[Edit]
I did a small test for you:
var
j: Integer;
st: string;
procedure DoNothing(i: Integer); overload;
begin
j := i;
end;
procedure DoNothing(s: string); overload;
begin
st := s;
end;
procedure DoNothingI(i: integer);
begin
j := i;
end;
procedure TForm2.Button1Click(Sender: TObject);
const
MaxIterations = 10000000;
var
StartTick, EndTick: Cardinal;
I: Integer;
begin
StartTick := GetTickCount;
for I := 0 to MaxIterations - 1 do
DoNothing(I);
EndTick := GetTickCount;
Label1.Caption := Format('Overlaod ellapsed ticks: %d [j:%d]', [EndTick - StartTick, j]);
StartTick := GetTickCount;
for I := 0 to MaxIterations - 1 do
DoNothingI(I);
EndTick := GetTickCount;
Label1.Caption := Format('%s'#13'Normal ellapsed ticks: %d [j:%d]', [Label1.Caption, EndTick - StartTick, j]);
end;
Result: Almost all the time 31 Ticks (milliseconds) for both on my dev machine, sometimes overload takes only 16 ticks.
Overloading is resolved at compile time (no overhead), but overriding has overhead!
virtual is faster than dynamic:
http://docwiki.embarcadero.com/RADStudio/en/Methods
Virtual versus Dynamic
In Delphi for Win32, virtual and dynamic methods are semantically equivalent.
However, they differ in the implementation of method-call dispatching at run time: virtual methods optimize for speed, while dynamic methods optimize for code size.