浏览代码

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

Tomas Hajny 21 年之前
父节点
当前提交
caeb56cff5
共有 1 个文件被更改,包括 66 次插入18 次删除
  1. 66 18
      rtl/go32v2/system.pp

+ 66 - 18
rtl/go32v2/system.pp

@@ -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