paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 22:32:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 'conservative' version of the do_open patch by Joe da Silva

Browse Source
This commit is contained in:
Tomas Hajny 2004-01-11 22:54:44 +00:00
parent fc60443584
commit 490598c62a
1 changed files with 65 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
rtl/watcom/system.pp
View File

@ -1117,6 +1117,17 @@ begin
Increase_file_handle_count:=true; Increase_file_handle_count:=true;
end; end;
function dos_version : word;
var
regs : trealregs;
begin
regs.realeax := $3000;
sysrealintr($21,regs);
dos_version := regs.realeax
end;
procedure do_open(var f;p:pchar;flags:longint); procedure do_open(var f;p:pchar;flags:longint);
{ {
filerec and textrec have both handle and mode as the first items so filerec and textrec have both handle and mode as the first items so
@ -1128,8 +1139,11 @@ procedure do_open(var f;p:pchar;flags:longint);
var var
regs : trealregs; regs : trealregs;
action : longint; action : longint;
Avoid6c00 : boolean;
begin begin
AllowSlash(p); AllowSlash(p);
{ check if Extended Open/Create API is safe to use }
Avoid6c00 := lo(dos_version) < 7;
{ close first if opened } { close first if opened }
if ((flags and $10000)=0) then if ((flags and $10000)=0) then
begin begin
@ -1173,32 +1187,63 @@ begin
end; end;
{ real dos call } { real dos call }
syscopytodos(longint(p),strlen(p)+1); syscopytodos(longint(p),strlen(p)+1);
{$ifndef RTLLITE}
if LFNSupport then if LFNSupport then
regs.realeax:=$716c regs.realeax := $716c { Use LFN Open/Create API }
else else
regs.realeax:=$6c00; regs.realeax:=$6c00;
regs.realedx:=action; {$endif RTLLITE}
regs.realds:=tb_segment; if Avoid6c00 then
regs.realesi:=tb_offset; regs.realeax := $3d00 + (flags and $ff) { For now, map to Open API }
regs.realebx:=$2000+(flags and $ff); else
regs.realecx:=$20; regs.realeax := $6c00; { Use Extended Open/Create API }
if regs.realah = $3d then
begin { Using the older Open or Create API's }
if (action and $00f0) <> 0 then
regs.realeax := $3c00; { Map to Create/Replace API }
regs.realds := tb_segment;
regs.realedx := tb_offset;
end
else
begin { Using LFN or Extended Open/Create API }
regs.realedx := action; { action if file does/doesn't exist }
regs.realds := tb_segment;
regs.realesi := tb_offset;
regs.realebx := $2000 + (flags and $ff); { file open mode }
end;
regs.realecx := $20; { file attributes }
sysrealintr($21,regs); sysrealintr($21,regs);
{$ifndef RTLLITE}
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
if lo(regs.realeax)=4 then if lo(regs.realeax)=4 then
if Increase_file_handle_count then if Increase_file_handle_count then
begin begin
{ Try again } { Try again }
if LFNSupport then if LFNSupport then
regs.realeax:=$716c regs.realeax := $716c {Use LFN Open/Create API}
else
if Avoid6c00 then
regs.realeax := $3d00+(flags and $ff) {For now, map to Open API}
else else
regs.realeax:=$6c00; regs.realeax := $6c00; {Use Extended Open/Create API}
regs.realedx:=action; if regs.realah = $3d then
regs.realds:=tb_segment; begin { Using the older Open or Create API's }
regs.realesi:=tb_offset; if (action and $00f0) <> 0 then
regs.realebx:=$2000+(flags and $ff); regs.realeax := $3c00; {Map to Create/Replace API}
regs.realecx:=$20; regs.realds := tb_segment;
regs.realedx := tb_offset;
end
else
begin { Using LFN or Extended Open/Create API }
regs.realedx := action; {action if file does/doesn't exist}
regs.realds := tb_segment;
regs.realesi := tb_offset;
regs.realebx := $2000+(flags and $ff); {file open mode}
end;
regs.realecx := $20; {file attributes}
sysrealintr($21,regs); sysrealintr($21,regs);
end; end;
{$endif RTLLITE}
if (regs.realflags and carryflag) <> 0 then if (regs.realflags and carryflag) <> 0 then
begin begin
GetInOutRes(lo(regs.realeax)); GetInOutRes(lo(regs.realeax));
@ -1207,9 +1252,11 @@ begin
else else
begin begin
filerec(f).handle:=lo(regs.realeax); filerec(f).handle:=lo(regs.realeax);
{$ifndef RTLLITE}
{ for systems that have more then 20 by default ! } { for systems that have more then 20 by default ! }
if lo(regs.realeax)>FileHandleCount then if lo(regs.realeax)>FileHandleCount then
FileHandleCount:=lo(regs.realeax); FileHandleCount:=lo(regs.realeax);
{$endif RTLLITE}
end; end;
if lo(regs.realeax)<max_files then if lo(regs.realeax)<max_files then
begin begin
@ -1491,7 +1538,10 @@ END.
{ {
$Log$ $Log$
Revision 1.9 2003-12-15 15:57:48 peter Revision 1.10 2004-01-11 22:54:44 hajny
* 'conservative' version of the do_open patch by Joe da Silva
Revision 1.9 2003/12/15 15:57:48 peter
* patches from wiktor * patches from wiktor
Revision 1.8 2003/11/17 19:55:13 hajny Revision 1.8 2003/11/17 19:55:13 hajny