paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

- removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR

Browse Source 
* fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug #2382)
  * fixed some potential range errors in indexchar/word/dword
This commit is contained in:
Jonas Maebe 2003-02-18 17:56:06 +00:00
parent b2eea6a1d8
commit 15419c49a6
2 changed files with 26 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
rtl/i386/i386.inc
View File

@ -940,46 +940,6 @@ function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_
function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
{$include strlen.inc}
{$define FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; {$ifdef hascompilerproc} compilerproc; {$endif}
begin
asm
cld
movl arr,%esi
movl arr+4,%ecx
{$ifdef hascompilerproc}
{ previous implementations passed length(arr), with compilerproc }
{ we only have high(arr), so add one (JM) }
incl %ecx
{$endif hascompilerproc}
orl %esi,%esi
jnz .LStrCharArrayNotNil
movl $0,%ecx
.LStrCharArrayNotNil:
andl $255,%ecx
movl %ecx,%eax
movl __RESULT,%edi
stosb
cmpl $7,%eax
jl .LStrCharArray2
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
rep
movsb
movl %eax,%ecx
andl $3,%eax
shrl $2,%ecx
rep
movsl
.LStrCharArray2:
movl %eax,%ecx
rep
movsb
end ['ECX','EAX','ESI','EDI'];
end;
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
@ -1214,7 +1174,12 @@ end;
{
$Log$
Revision 1.38 2003-01-06 23:03:13 mazen
Revision 1.39 2003-02-18 17:56:06 jonas
- removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR
* fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382)
* fixed some potential range errors in indexchar/word/dword
Revision 1.38 2003/01/06 23:03:13 mazen
+ defining FPC_SYSTEM_HAS_DECLOCKED and FPC_SYSTEM_HAS_INCLOCKED to avoid
compilation error on generic.inc

27
rtl/inc/generic.inc
View File

@ -115,7 +115,7 @@ var
I : longint;
begin
I:=0;
while (bytearray(buf)[I]<>b) and (I<Len) do
while (I<Len) and (bytearray(buf)[I]<>b) do
inc(I);
if (i=Len) then
i:=-1; {Can't use 0, since it is a possible value}
@ -132,7 +132,7 @@ var
I : longint;
begin
I:=0;
while (wordarray(buf)[I]<>b) and (I<Len) do
while (I<Len) and (wordarray(buf)[I]<>b) do
inc(I);
if (i=Len) then
i:=-1; {Can't use 0, since it is a possible value for index}
@ -149,7 +149,7 @@ var
I : longint;
begin
I:=0;
while (longintarray(buf)[I]<>b) and (I<Len) do inc(I);
while (I<Len) and (longintarray(buf)[I]<>b) do inc(I);
if (i=Len) then
i:=-1; {Can't use 0, since it is a possible value for index}
IndexDWord:=I;
@ -651,8 +651,11 @@ function fpc_chararray_to_shortstr(const arr: array of char):shortstring;[public
var
l: longint;
{$else hascompilerproc}
function fpc_chararray_to_shortstr(p:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
function fpc_chararray_to_shortstr(arr:pchar; l : longint):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR'];
var
{$endif hascompilerproc}
index: longint;
len: byte;
begin
{$ifdef hascompilerproc}
l := high(arr)+1;
@ -661,8 +664,13 @@ begin
l:=255
else if l<0 then
l:=0;
move(arr[0],fpc_chararray_to_shortstr[1],l);
fpc_chararray_to_shortstr[0]:=chr(l);
index:=IndexByte(arr[0],l,0);
if (index < 0) then
len := l
else
len := index;
move(arr[0],fpc_chararray_to_shortstr[1],len);
fpc_chararray_to_shortstr[0]:=chr(len);
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
@ -965,7 +973,12 @@ end;
{
$Log$
Revision 1.49 2003-01-20 22:21:36 mazen
Revision 1.50 2003-02-18 17:56:06 jonas
- removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR
* fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382)
* fixed some potential range errors in indexchar/word/dword
Revision 1.49 2003/01/20 22:21:36 mazen
* many stuff related to RTL fixed
Revision 1.48 2003/01/09 20:14:20 florian