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

* patches from wiktor

Browse Source
This commit is contained in:
peter 2003-12-15 15:57:48 +00:00
parent 2d7ecc1273
commit d715c6195f
2 changed files with 107 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
rtl/watcom/system.pp
View File

@ -527,29 +527,78 @@ begin
end;
function strcopy(dest,source : pchar) : pchar;assembler;
var
saveeax,saveesi,saveedi : longint;
asm
pushl %esi
pushl %edi
cld
movl 12(%ebp),%edi
movl $0xffffffff,%ecx
xorb %al,%al
repne
scasb
not %ecx
movl 8(%ebp),%edi
movl 12(%ebp),%esi
movl %ecx,%eax
shrl $2,%ecx
rep
movsl
movl %eax,%ecx
andl $3,%ecx
rep
movsb
movl 8(%ebp),%eax
popl %edi
popl %esi
movl %edi,saveedi
movl %esi,saveesi
{$ifdef REGCALL}
movl %eax,saveeax
movl %edx,%edi
{$else}
movl source,%edi
{$endif}
testl %edi,%edi
jz .LStrCopyDone
leal 3(%edi),%ecx
andl $-4,%ecx
movl %edi,%esi
subl %edi,%ecx
{$ifdef REGCALL}
movl %eax,%edi
{$else}
movl dest,%edi
{$endif}
jz .LStrCopyAligned
.LStrCopyAlignLoop:
movb (%esi),%al
incl %edi
incl %esi
testb %al,%al
movb %al,-1(%edi)
jz .LStrCopyDone
decl %ecx
jnz .LStrCopyAlignLoop
.balign 16
.LStrCopyAligned:
movl (%esi),%eax
movl %eax,%edx
leal 0x0fefefeff(%eax),%ecx
notl %edx
addl $4,%esi
andl %edx,%ecx
andl $0x080808080,%ecx
jnz .LStrCopyEndFound
movl %eax,(%edi)
addl $4,%edi
jmp .LStrCopyAligned
.LStrCopyEndFound:
testl $0x0ff,%eax
jz .LStrCopyByte
testl $0x0ff00,%eax
jz .LStrCopyWord
testl $0x0ff0000,%eax
jz .LStrCopy3Bytes
movl %eax,(%edi)
jmp .LStrCopyDone
.LStrCopy3Bytes:
xorb %dl,%dl
movw %ax,(%edi)
movb %dl,2(%edi)
jmp .LStrCopyDone
.LStrCopyWord:
movw %ax,(%edi)
jmp .LStrCopyDone
.LStrCopyByte:
movb %al,(%edi)
.LStrCopyDone:
{$ifdef REGCALL}
movl saveeax,%eax
{$else}
movl dest,%eax
{$endif}
movl saveedi,%edi
movl saveesi,%esi
end;
@ -1442,7 +1491,10 @@ END.
{
$Log$
Revision 1.8 2003-11-17 19:55:13 hajny
Revision 1.9 2003-12-15 15:57:48 peter
* patches from wiktor
Revision 1.8 2003/11/17 19:55:13 hajny
* Wiktor Sywula: LFN detection uncommented in system, new units added
Revision 1.7 2003/10/18 09:31:59 hajny

44
rtl/watcom/sysutils.pp
View File

@ -68,9 +68,9 @@ begin
StrDispose(P);
end ;
{ Native OpenFile function.
if return value <> 0 call failed. }
function OpenFile(const FileName: string; var Handle: longint; Mode, Action: word): longint;
var
Regs: registers;
@ -78,17 +78,34 @@ begin
result := 0;
Handle := 0;
StringToTB(FileName);
if LFNSupport then Regs.Eax:=$716c
else Regs.Eax:=$6c00;
Regs.Edx := Action; { Action if file exists/not exists }
Regs.Ds := tb_segment;
Regs.Esi := tb_offset;
Regs.Ebx := $2000 + (Mode and $ff); { file open mode }
Regs.Ecx := $20; { Attributes }
if LFNSupport then
Regs.Eax := $716c { Use LFN Open/Create API }
else { Check if Extended Open/Create API is safe to use }
if lo(dosversion) < 7 then
Regs.Eax := $3d00 + (Mode and $ff) { For now, map to Open API }
else
Regs.Eax := $6c00; { Use Extended Open/Create API }
if Regs.Ah = $3d then
begin
if (Action and $00f0) <> 0 then
Regs.Eax := $3c00; { Map to Create/Replace API }
Regs.Ds := tb_segment;
Regs.Edx := tb_offset;
end
else { LFN or Extended Open/Create API }
begin
Regs.Edx := Action; { Action if file exists/not exists }
Regs.Ds := tb_segment;
Regs.Esi := tb_offset;
Regs.Ebx := $2000 + (Mode and $ff); { file open mode }
end;
Regs.Ecx := $20; { Attributes }
RealIntr($21, Regs);
if Regs.Flags and CarryFlag <> 0 then result := Regs.Ax
else Handle := Regs.Ax;
end ;
if (Regs.Flags and CarryFlag) <> 0 then
result := Regs.Ax
else
Handle := Regs.Ax;
end;
Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
@ -755,7 +772,10 @@ end.
{
$Log$
Revision 1.2 2003-11-26 20:00:19 florian
Revision 1.3 2003-12-15 15:57:49 peter
* patches from wiktor
Revision 1.2 2003/11/26 20:00:19 florian
* error handling for Variants improved
Revision 1.1 2003/11/17 19:55:13 hajny