diff --git a/rtl/msdos/sysfile.inc b/rtl/msdos/sysfile.inc index 5429550f33..5cf30ffef8 100644 --- a/rtl/msdos/sysfile.inc +++ b/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 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 0) and + (FileRec (F).Handle <> UnusedHandle) then + begin + do_seekend(filerec(f).handle); + filerec(f).mode:=fmoutput; {fool fmappend} + end; end;