You are not logged in.
Unless I'm doing something very silly, there is a bug in the SynopseRTL version of StrLCopy().
The Borland version always adds a null terminator to Dest, the Synopse version does not in my tests.
Offline
I don't understand why you scan the Source for nulls first; is there any reason why the function can't be as simple as this? :
function SynopseStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
or edx,edx // check Source
jz @z // abort if nil
or eax,eax // check Dest
jz @z // abort if nil
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
@z:
end;
(Also, the original Delphi7 version doesn't appear to check for nils).
Offline
AFAIR I re-used some optimized version around.
Searching for null is for safety: you copy up to MaxLen bytes, but you copy only source chars len, with a MaxLen value set to the destination buffer.
Goal is to avoid any potential destination buffer overflow, for security reasons.
Yours sounds like a nice alternative, but does not work as expected: you will append a #0 at MaxLen position.
Offline
The original Delphi7 code produces an access violation if either the source or the destination is nil, so I think this is the logical equivalent:
function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
end;
Offline
Searching for null is for safety: you copy up to MaxLen bytes, but you copy only source chars len, with a MaxLen value set to the destination buffer.
Goal is to avoid any potential destination buffer overflow, for security reasons.
That sounds reasonable, but if so why not add similar checks in the Move routine?
Yours sounds like a nice alternative, but does not work as expected: you will append a #0 at MaxLen position.
I'm not sure what you mean; in my tests it behaves exactly the same as the standard Delphi version (including when MaxLen=0).
Offline
Simple test unit:
Unit1.pas:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
btnTestBorland: TButton;
edtBorland: TLabeledEdit;
edtSynopse: TLabeledEdit;
edtSize: TLabeledEdit;
edtSource: TLabeledEdit;
btnTestSynopse: TButton;
btnTestNew: TButton;
edtNew: TLabeledEdit;
procedure edtSizeChange(Sender: TObject);
procedure btnTestBorlandClick(Sender: TObject);
procedure btnTestSynopseClick(Sender: TObject);
procedure btnTestNewClick(Sender: TObject);
private
{ Private declarations }
Size: Cardinal;
Buffer: array[0..128] of Char;
procedure PrepareBuffer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function SynopseStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm // faster version by AB
or edx,edx
jz @z
push eax
push ebx
xchg eax,edx
mov ebx,ecx
xor ecx,ecx
@1: cmp byte ptr [eax+ecx],0
lea ecx,ecx+1 // copy last #0
je @s
cmp ecx,ebx
jb @1
@s: pop ebx
call Move
pop eax
@z:
end;
function NewStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
asm
or edx,edx // check Source
jz @z // abort if nil
or eax,eax // check Dest
jz @z // abort if nil
mov byte ptr [eax+ecx],0 // null-terminate Dest
push eax // save Dest
xchg eax,edx // swap Source & Dest for Move()
call Move // do the move
pop eax // restore Dest
@z:
end;
function BorlandStrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar;
// original Borland version
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV ESI,EAX
MOV EDI,EDX
MOV EBX,ECX
XOR AL,AL
TEST ECX,ECX
JZ @@1
REPNE SCASB
JNE @@1
INC ECX
@@1: SUB EBX,ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,EDI
MOV ECX,EBX
SHR ECX,2
REP MOVSD
MOV ECX,EBX
AND ECX,3
REP MOVSB
STOSB
MOV EAX,EDX
POP EBX
POP ESI
POP EDI
end;
procedure TForm1.edtSizeChange(Sender: TObject);
begin
Size := StrToInt(edtSize.Text);
end;
procedure TForm1.PrepareBuffer;
var
i: Integer;
begin
for i := 0 to Size-1 do
Buffer[i] := Char(i);
Buffer[Size] := '!';
end;
procedure TForm1.btnTestBorlandClick(Sender: TObject);
begin
PrepareBuffer;
BorlandStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtBorland.Text := Buffer;
end;
procedure TForm1.btnTestSynopseClick(Sender: TObject);
begin
PrepareBuffer;
SynopseStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtSynopse.Text := Buffer;
end;
procedure TForm1.btnTestNewClick(Sender: TObject);
begin
PrepareBuffer;
NewStrLCopy(Buffer, PChar(edtSource.Text), Size);
edtNew.Text := Buffer;
end;
end.
Unit1.dfm:
object Form1: TForm1
Left = 585
Top = 173
Width = 374
Height = 296
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnTestBorland: TButton
Left = 56
Top = 96
Width = 89
Height = 25
Caption = 'btnTestBorland'
TabOrder = 0
OnClick = btnTestBorlandClick
end
object edtBorland: TLabeledEdit
Left = 160
Top = 96
Width = 121
Height = 21
EditLabel.Width = 51
EditLabel.Height = 13
EditLabel.Caption = 'edtBorland'
TabOrder = 1
end
object edtSynopse: TLabeledEdit
Left = 160
Top = 144
Width = 121
Height = 21
EditLabel.Width = 56
EditLabel.Height = 13
EditLabel.Caption = 'edtSynopse'
TabOrder = 2
end
object edtSize: TLabeledEdit
Left = 216
Top = 40
Width = 65
Height = 21
EditLabel.Width = 20
EditLabel.Height = 13
EditLabel.Caption = 'Size'
TabOrder = 3
OnChange = edtSizeChange
end
object edtSource: TLabeledEdit
Left = 56
Top = 40
Width = 129
Height = 21
EditLabel.Width = 49
EditLabel.Height = 13
EditLabel.Caption = 'edtSource'
TabOrder = 4
Text = 'ABCDEFGHIJKLMNOP'
end
object btnTestSynopse: TButton
Left = 56
Top = 144
Width = 89
Height = 25
Caption = 'btnTestSynopse'
TabOrder = 5
OnClick = btnTestSynopseClick
end
object btnTestNew: TButton
Left = 56
Top = 192
Width = 89
Height = 25
Caption = 'btnTestNew'
TabOrder = 6
OnClick = btnTestNewClick
end
object edtNew: TLabeledEdit
Left = 160
Top = 192
Width = 121
Height = 21
EditLabel.Width = 37
EditLabel.Height = 13
EditLabel.Caption = 'edtNew'
TabOrder = 7
end
end
Offline
What puzzles me is why this hasn't been mentioned before, because any standard database application using TStringField.SetAsString (i.e. StrField.AsString := 'x') will highlight the problem.
Offline
guess, that code is part of the fastcode library (correct if that's not so). By the way, is all the fastcode library code part of the enhanced RTL?
--- we no need no water, let the ... burn ---
Offline