paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 20:19:25 +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 2003-12-17 20:40:38 +00:00
parent 87b24ee42c
commit caeb56cff5
1 changed files with 66 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
rtl/go32v2/system.pp
View File

@ -1189,6 +1189,17 @@ begin
Increase_file_handle_count:=true;
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);
{
filerec and textrec have both handle and mode as the first items so
@ -1200,8 +1211,11 @@ procedure do_open(var f;p:pchar;flags:longint);
var
regs : trealregs;
action : longint;
Avoid6c00 : boolean;
begin
AllowSlash(p);
{ check if Extended Open/Create API is safe to use }
Avoid6c00 := lo(dos_version) < 7;
{ close first if opened }
if ((flags and $10000)=0) then
begin
@ -1245,32 +1259,62 @@ begin
end;
{ real dos call }
syscopytodos(longint(p),strlen(p)+1);
{$ifndef RTLLITE}
if LFNSupport then
regs.realeax:=$716c
regs.realeax := $716c { Use LFN Open/Create API }
else
regs.realeax:=$6c00;
regs.realedx:=action;
regs.realds:=tb_segment;
regs.realesi:=tb_offset;
regs.realebx:=$2000+(flags and $ff);
regs.realecx:=$20;
{$endif RTLLITE}
if Avoid6c00 then
regs.realeax := $3d00 + (flags and $ff) { For now, map to Open API }
else
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);
{$ifndef RTLLITE}
if (regs.realflags and carryflag) <> 0 then
if lo(regs.realeax)=4 then
if Increase_file_handle_count then
begin
{ Try again }
if LFNSupport then
regs.realeax:=$716c
if LFNSupport then
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
regs.realeax:=$6c00;
regs.realedx:=action;
regs.realds:=tb_segment;
regs.realesi:=tb_offset;
regs.realebx:=$2000+(flags and $ff);
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);
end;
{$endif RTLLITE}
if (regs.realflags and carryflag) <> 0 then
begin
GetInOutRes(lo(regs.realeax));
@ -1279,9 +1323,11 @@ begin
else
begin
filerec(f).handle:=lo(regs.realeax);
{$ifndef RTLLITE}
{ for systems that have more then 20 by default ! }
if lo(regs.realeax)>FileHandleCount then
FileHandleCount:=lo(regs.realeax);
{$endif RTLLITE}
end;
if lo(regs.realeax)<max_files then
begin
@ -1300,8 +1346,7 @@ begin
{$endif SYSTEMDEBUG}
end;
{ append mode }
if ((flags and $100) <> 0) and
(FileRec (F).Handle <> UnusedHandle) then
if (flags and $100)<>0 then
begin
do_seekend(filerec(f).handle);
filerec(f).mode:=fmoutput; {fool fmappend}
@ -1562,7 +1607,10 @@ Begin
End.
{
$Log$
Revision 1.29 2003-12-04 21:42:07 peter
Revision 1.30 2003-12-17 20:40:38 hajny
* 'conservative' version of the do_open patch by Joe da Silva
Revision 1.29 2003/12/04 21:42:07 peter
* register calling updates
Revision 1.28 2003/11/03 09:42:27 marco