+ implemented file routines do_open and do_close for msdos, based on the go32v2 code

git-svn-id: branches/i8086@24076 -

rtl/msdos/sysfile.inc

@@ -13,12 +13,44 @@
 
  **********************************************************************}
 
+   { Keep Track of open files }
+   const
+      max_files = 50;
+   var
+      openfiles : array [0..max_files-1] of boolean;
+{$ifdef SYSTEMDEBUG}
+      opennames : array [0..max_files-1] of pchar;
+   const
+      free_closed_names : boolean = true;
+{$endif SYSTEMDEBUG}
+
+
 {****************************************************************************
                         Low level File Routines
  ****************************************************************************}
 
 procedure do_close(handle : thandle);
+var
+  regs : Registers;
 begin
+  if Handle<=4 then
+   exit;
+  regs.BX:=handle;
+  if handle<max_files then
+    begin
+       openfiles[handle]:=false;
+{$ifdef SYSTEMDEBUG}
+       if assigned(opennames[handle]) and free_closed_names then
+         begin
+            sysfreememsize(opennames[handle],strlen(opennames[handle])+1);
+            opennames[handle]:=nil;
+         end;
+{$endif SYSTEMDEBUG}
+    end;
+  regs.AX:=$3e00;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);
 end;
 
 
@@ -96,8 +128,163 @@ procedure do_truncate (handle:thandle;pos:longint);
 begin
 end;
 
-procedure do_open(var f;p:pchar;flags:longint);
+const
+  FileHandleCount : word = 20;
+
+function Increase_file_handle_count : boolean;
+var
+  regs : Registers;
 begin
+  Inc(FileHandleCount,10);
+  regs.BX:=FileHandleCount;
+  regs.AX:=$6700;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   begin
+    Increase_file_handle_count:=false;
+    Dec (FileHandleCount, 10);
+   end
+  else
+    Increase_file_handle_count:=true;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  regs   : Registers;
+  action : longint;
+begin
+  DoDirSeparators(p);
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case filerec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file handle }
+  filerec(f).handle:=UnusedHandle;
+  action:=$1;
+{ convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : filerec(f).mode:=fminput;
+   1 : filerec(f).mode:=fmoutput;
+   2 : filerec(f).mode:=fminout;
+  end;
+  if (flags and $1000)<>0 then
+   action:=$12; {create file function}
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{$ifndef RTLLITE}
+  if LFNSupport then
+   begin
+     regs.AX := $716c;                        { Use LFN Open/Create API }
+     regs.DX := action;             { action if file does/doesn't exist }
+     regs.SI := Ofs(p^);
+     regs.BX := $2000 + (flags and $ff);               { file open mode }
+   end
+  else
+{$endif RTLLITE}
+   begin
+     if (action and $00f0) <> 0 then
+       regs.AX := $3c00                     { Map to Create/Replace API }
+     else
+       regs.AX := $3d00 + (flags and $ff);   { Map to Open_Existing API }
+     regs.DX := Ofs(p^);
+   end;
+  regs.DS := Seg(p^);
+  regs.CX := $20;                                     { file attributes }
+  MsDos(regs);
+{$ifndef RTLLITE}
+  if (regs.Flags and fCarry) <> 0 then
+    if regs.AX=4 then
+      if Increase_file_handle_count then
+        begin
+          { Try again }
+          if LFNSupport then
+            begin
+              regs.AX := $716c;                 {Use LFN Open/Create API}
+              regs.DX := action;      {action if file does/doesn't exist}
+              regs.SI := Ofs(p^);
+              regs.BX := $2000 + (flags and $ff);        {file open mode}
+            end
+          else
+            begin
+              if (action and $00f0) <> 0 then
+                regs.AX := $3c00              {Map to Create/Replace API}
+              else
+                regs.AX := $3d00 + (flags and $ff);     {Map to Open API}
+              regs.DX := Ofs(p^);
+            end;
+          regs.DS := Seg(p^);
+          regs.CX := $20;                               {file attributes}
+          MsDos(regs);
+        end;
+{$endif RTLLITE}
+  if (regs.Flags and fCarry) <> 0 then
+    begin
+      GetInOutRes(regs.AX);
+      exit;
+    end
+  else
+    begin
+      filerec(f).handle:=regs.AX;
+{$ifndef RTLLITE}
+      { for systems that have more then 20 by default ! }
+      if regs.AX>FileHandleCount then
+        FileHandleCount:=regs.AX;
+{$endif RTLLITE}
+    end;
+  if regs.AX<max_files then
+    begin
+{$ifdef SYSTEMDEBUG}
+       if openfiles[regs.AX] and
+          assigned(opennames[regs.AX]) then
+         begin
+            Writeln(stderr,'file ',opennames[regs.AX],'(',regs.AX,') not closed but handle reused!');
+            sysfreememsize(opennames[regs.AX],strlen(opennames[regs.AX])+1);
+         end;
+{$endif SYSTEMDEBUG}
+       openfiles[regs.AX]:=true;
+{$ifdef SYSTEMDEBUG}
+       opennames[regs.AX] := sysgetmem(strlen(p)+1);
+       move(p^,opennames[regs.AX]^,strlen(p)+1);
+{$endif SYSTEMDEBUG}
+    end;
+{ append mode }
+  if ((flags and $100) <> 0) and
+   (FileRec (F).Handle <> UnusedHandle) then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
 end;