* better errorcode returning using int21h,5900

rtl/go32v2/dos.pp

@@ -1,1125 +1,1139 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    Dos unit for BP7 compatible RTL
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit dos;
-interface
-
-Uses
-  Go32;
-
-Const
-  {Bitmasks for CPU Flags}
-  fcarry     = $0001;
-  fparity    = $0004;
-  fauxiliary = $0010;
-  fzero      = $0040;
-  fsign      = $0080;
-  foverflow  = $0800;
-
-  {Bitmasks for file attribute}
-  readonly  = $01;
-  hidden    = $02;
-  sysfile   = $04;
-  volumeid  = $08;
-  directory = $10;
-  archive   = $20;
-  anyfile   = $3F;
-
-  {File Status}
-  fmclosed = $D7B0;
-  fminput  = $D7B1;
-  fmoutput = $D7B2;
-  fminout  = $D7B3;
-
-
-Type
-{ Needed for LFN Support }
-  ComStr  = String[255];
-  PathStr = String[255];
-  DirStr  = String[255];
-  NameStr = String[255];
-  ExtStr  = String[255];
-
-{
-  filerec.inc contains the definition of the filerec.
-  textrec.inc contains the definition of the textrec.
-  It is in a separate file to make it available in other units without
-  having to use the DOS unit for it.
-}
-{$i filerec.inc}
-{$i textrec.inc}
-
-  DateTime = packed record
-    Year,
-    Month,
-    Day,
-    Hour,
-    Min,
-    Sec   : word;
-  End;
-
-  searchrec = packed record
-     fill : array[1..21] of byte;
-     attr : byte;
-     time : longint;
-     { reserved : word; not in DJGPP V2 }
-     size : longint;
-     name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
-  end;
-
-  Registers = Go32.Registers;
-
-Var
-  DosError : integer;
-
-{Interrupt}
-Procedure Intr(intno: byte; var regs: registers);
-Procedure MSDos(var regs: registers);
-
-{Info/Date/Time}
-Function  DosVersion: Word;
-Procedure GetDate(var year, month, mday, wday: word);
-Procedure GetTime(var hour, minute, second, sec100: word);
-procedure SetDate(year,month,day: word);
-Procedure SetTime(hour,minute,second,sec100: word);
-Procedure UnpackTime(p: longint; var t: datetime);
-Procedure PackTime(var t: datetime; var p: longint);
-
-{Exec}
-Procedure Exec(const path: pathstr; const comline: comstr);
-Function  DosExitCode: word;
-
-{Disk}
-Function  DiskFree(drive: byte) : longint;
-Function  DiskSize(drive: byte) : longint;
-Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
-Procedure FindNext(var f: searchRec);
-Procedure FindClose(Var f: SearchRec);
-
-{File}
-Procedure GetFAttr(var f; var attr: word);
-Procedure GetFTime(var f; var time: longint);
-Function  FSearch(path: pathstr; dirlist: string): pathstr;
-Function  FExpand(const path: pathstr): pathstr;
-Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
-
-{Environment}
-Function  EnvCount: longint;
-Function  EnvStr(index: integer): string;
-Function  GetEnv(envvar: string): string;
-
-{Misc}
-Procedure SetFAttr(var f; attr: word);
-Procedure SetFTime(var f; time: longint);
-Procedure GetCBreak(var breakvalue: boolean);
-Procedure SetCBreak(breakvalue: boolean);
-Procedure GetVerify(var verify: boolean);
-Procedure SetVerify(verify: boolean);
-
-{Do Nothing Functions}
-Procedure SwapVectors;
-Procedure GetIntVec(intno: byte; var vector: pointer);
-Procedure SetIntVec(intno: byte; vector: pointer);
-Procedure Keep(exitcode: word);
-
-implementation
-
-uses
-  strings;
-
-{$ASMMODE ATT}
-
-{******************************************************************************
-                           --- Dos Interrupt ---
-******************************************************************************}
-
-var
-  dosregs : registers;
-
-procedure LoadDosError;
-begin
-  if (dosregs.flags and carryflag) <> 0 then
-  { conversion from word to integer !!
-    gave a Bound check error if ax is $FFFF !! PM }
-    doserror:=integer(dosregs.ax)
-  else
-    doserror:=0;
-end;
-
-
-procedure intr(intno : byte;var regs : registers);
-begin
-  realintr(intno,regs);
-end;
-
-
-procedure msdos(var regs : registers);
-begin
-  intr($21,regs);
-end;
-
-
-{******************************************************************************
-                        --- Info / Date / Time ---
-******************************************************************************}
-
-function dosversion : word;
-begin
-  dosregs.ax:=$3000;
-  msdos(dosregs);
-  dosversion:=dosregs.ax;
-end;
-
-
-procedure getdate(var year,month,mday,wday : word);
-begin
-  dosregs.ax:=$2a00;
-  msdos(dosregs);
-  wday:=dosregs.al;
-  year:=dosregs.cx;
-  month:=dosregs.dh;
-  mday:=dosregs.dl;
-end;
-
-
-procedure setdate(year,month,day : word);
-begin
-   dosregs.cx:=year;
-   dosregs.dh:=month;
-   dosregs.dl:=day;
-   dosregs.ah:=$2b;
-   msdos(dosregs);
-   DosError:=0;
-end;
-
-
-procedure gettime(var hour,minute,second,sec100 : word);
-begin
-  dosregs.ah:=$2c;
-  msdos(dosregs);
-  hour:=dosregs.ch;
-  minute:=dosregs.cl;
-  second:=dosregs.dh;
-  sec100:=dosregs.dl;
-  DosError:=0;
-end;
-
-
-procedure settime(hour,minute,second,sec100 : word);
-begin
-  dosregs.ch:=hour;
-  dosregs.cl:=minute;
-  dosregs.dh:=second;
-  dosregs.dl:=sec100;
-  dosregs.ah:=$2d;
-  msdos(dosregs);
-  DosError:=0;
-end;
-
-
-Procedure packtime(var t : datetime;var p : longint);
-Begin
-  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
-End;
-
-
-Procedure unpacktime(p : longint;var t : datetime);
-Begin
-  with t do
-   begin
-     sec:=(p and 31) shl 1;
-     min:=(p shr 5) and 63;
-     hour:=(p shr 11) and 31;
-     day:=(p shr 16) and 31;
-     month:=(p shr 21) and 15;
-     year:=(p shr 25)+1980;
-   end;
-End;
-
-
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-
-var
-  lastdosexitcode : word;
-
-procedure exec(const path : pathstr;const comline : comstr);
-type
-  realptr = packed record
-    ofs,seg : word;
-  end;
-  texecblock = packed record
-    envseg    : word;
-    comtail   : realptr;
-    firstFCB  : realptr;
-    secondFCB : realptr;
-    iniStack  : realptr;
-    iniCSIP   : realptr;
-  end;
-var
-  current_dos_buffer_pos,
-  arg_ofs,
-  i,la_env,
-  la_p,la_c,la_e,
-  fcb1_la,fcb2_la : longint;
-  execblock       : texecblock;
-  c,p             : string;
-
-  function paste_to_dos(src : string) : boolean;
-  var
-    c : array[0..255] of char;
-  begin
-     paste_to_dos:=false;
-     if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
-      RunError(217);
-     move(src[1],c[0],length(src));
-     c[length(src)]:=#0;
-     seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
-     current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
-     paste_to_dos:=true;
-  end;
-
-begin
-{ create command line }
-  move(comline[0],c[1],length(comline)+1);
-  c[length(comline)+2]:=#13;
-  c[0]:=char(length(comline)+2);
-{ create path }
-  p:=path;
-  for i:=1 to length(p) do
-   if p[i]='/' then
-    p[i]:='\';
-{ create buffer }
-  la_env:=transfer_buffer;
-  while (la_env and 15)<>0 do
-   inc(la_env);
-  current_dos_buffer_pos:=la_env;
-{ copy environment }
-  for i:=1 to envcount do
-   paste_to_dos(envstr(i));
-  paste_to_dos(''); { adds a double zero at the end }
-{ allow slash as backslash }
-  la_p:=current_dos_buffer_pos;
-  paste_to_dos(p);
-  la_c:=current_dos_buffer_pos;
-  paste_to_dos(c);
-  la_e:=current_dos_buffer_pos;
-  fcb1_la:=la_e;
-  la_e:=la_e+16;
-  fcb2_la:=la_e;
-  la_e:=la_e+16;
-{ allocate FCB see dosexec code }
-  arg_ofs:=1;
-  while (c[arg_ofs] in [' ',#9]) do
-   inc(arg_ofs);
-  dosregs.ax:=$2901;
-  dosregs.ds:=(la_c+arg_ofs) shr 4;
-  dosregs.esi:=(la_c+arg_ofs) and 15;
-  dosregs.es:=fcb1_la shr 4;
-  dosregs.edi:=fcb1_la and 15;
-  msdos(dosregs);
-{ allocate second FCB see dosexec code }
-  repeat
-    inc(arg_ofs);
-  until (c[arg_ofs] in [' ',#9,#13]);
-  if c[arg_ofs]<>#13 then
-   begin
-     repeat
-       inc(arg_ofs);
-     until not (c[arg_ofs] in [' ',#9]);
-   end;
-  dosregs.ax:=$2901;
-  dosregs.ds:=(la_c+arg_ofs) shr 4;
-  dosregs.si:=(la_c+arg_ofs) and 15;
-  dosregs.es:=fcb2_la shr 4;
-  dosregs.di:=fcb2_la and 15;
-  msdos(dosregs);
-  with execblock do
-   begin
-     envseg:=la_env shr 4;
-     comtail.seg:=la_c shr 4;
-     comtail.ofs:=la_c and 15;
-     firstFCB.seg:=fcb1_la shr 4;
-     firstFCB.ofs:=fcb1_la and 15;
-     secondFCB.seg:=fcb2_la shr 4;
-     secondFCB.ofs:=fcb2_la and 15;
-   end;
-  seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
-  dosregs.edx:=la_p and 15;
-  dosregs.ds:=la_p shr 4;
-  dosregs.ebx:=la_e and 15;
-  dosregs.es:=la_e shr 4;
-  dosregs.ax:=$4b00;
-  msdos(dosregs);
-  LoadDosError;
-  if DosError=0 then
-   begin
-     dosregs.ax:=$4d00;
-     msdos(dosregs);
-     LastDosExitCode:=DosRegs.al
-   end
-  else
-   LastDosExitCode:=0;
-end;
-
-
-function dosexitcode : word;
-begin
-  dosexitcode:=lastdosexitcode;
-end;
-
-
-procedure getcbreak(var breakvalue : boolean);
-begin
-  DosError:=0;
-  dosregs.ax:=$3300;
-  msdos(dosregs);
-  breakvalue:=dosregs.dl<>0;
-end;
-
-
-procedure setcbreak(breakvalue : boolean);
-begin
-  DosError:=0;
-  dosregs.ax:=$3301;
-  dosregs.dl:=ord(breakvalue);
-  msdos(dosregs);
-end;
-
-
-procedure getverify(var verify : boolean);
-begin
-  DosError:=0;
-  dosregs.ah:=$54;
-  msdos(dosregs);
-  verify:=dosregs.al<>0;
-end;
-
-
-procedure setverify(verify : boolean);
-begin
-  DosError:=0;
-  dosregs.ah:=$2e;
-  dosregs.al:=ord(verify);
-  msdos(dosregs);
-end;
-
-
-{******************************************************************************
-                               --- Disk ---
-******************************************************************************}
-
-function diskfree(drive : byte) : longint;
-begin
-  DosError:=0;
-  dosregs.dl:=drive;
-  dosregs.ah:=$36;
-  msdos(dosregs);
-  if dosregs.ax<>$FFFF then
-   diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
-  else
-   diskfree:=-1;
-end;
-
-
-function disksize(drive : byte) : longint;
-begin
-  DosError:=0;
-  dosregs.dl:=drive;
-  dosregs.ah:=$36;
-  msdos(dosregs);
-  if dosregs.ax<>$FFFF then
-   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
-  else
-   disksize:=-1;
-end;
-
-
-{******************************************************************************
-                      --- LFNFindfirst LFNFindNext ---
-******************************************************************************}
-
-type
-  LFNSearchRec=packed record
-    attr,
-    crtime,
-    crtimehi,
-    actime,
-    actimehi,
-    lmtime,
-    lmtimehi,
-    sizehi,
-    size      : longint;
-    reserved  : array[0..7] of byte;
-    name      : array[0..259] of byte;
-    shortname : array[0..13] of byte;
-  end;
-
-procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec);
-var
-  Len : longint;
-begin
-  With w do
-   begin
-     FillChar(d,sizeof(SearchRec),0);
-     if DosError=0 then
-      len:=StrLen(@Name)
-     else
-      len:=0;
-     d.Name[0]:=chr(len);
-     Move(Name[0],d.Name[1],Len);
-     d.Time:=lmTime;
-     d.Size:=Size;
-     d.Attr:=Attr and $FF;
-     Move(hdl,d.Fill,4);
-   end;
-end;
-
-
-procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
-var
-  i : longint;
-  w : LFNSearchRec;
-begin
-  { allow slash as backslash }
-  for i:=0 to strlen(path) do
-    if path[i]='/' then path[i]:='\';
-  dosregs.si:=1; { use ms-dos time }
-  { don't include the label if not asked for it, needed for network drives }
-  if attr=$8 then
-   dosregs.ecx:=8
-  else
-   dosregs.ecx:=attr and (not 8);
-  dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
-  dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=tb_segment;
-  dosregs.edi:=tb_offset;
-  dosregs.es:=tb_segment;
-  dosregs.ax:=$714e;
-  msdos(dosregs);
-  LoadDosError;
-  copyfromdos(w,sizeof(LFNSearchRec));
-  LFNSearchRec2Dos(w,dosregs.ax,s);
-end;
-
-
-procedure LFNFindNext(var s:searchrec);
-var
-  hdl : longint;
-  w   : LFNSearchRec;
-begin
-  Move(s.Fill,hdl,4);
-  dosregs.si:=1; { use ms-dos time }
-  dosregs.edi:=tb_offset;
-  dosregs.es:=tb_segment;
-  dosregs.ebx:=hdl;
-  dosregs.ax:=$714f;
-  msdos(dosregs);
-  LoadDosError;
-  copyfromdos(w,sizeof(LFNSearchRec));
-  LFNSearchRec2Dos(w,hdl,s);
-end;
-
-
-procedure LFNFindClose(var s:searchrec);
-var
-  hdl : longint;
-begin
-  Move(s.Fill,hdl,4);
-  dosregs.ebx:=hdl;
-  dosregs.ax:=$71a1;
-  msdos(dosregs);
-  LoadDosError;
-end;
-
-
-{******************************************************************************
-                     --- DosFindfirst DosFindNext ---
-******************************************************************************}
-
-procedure dossearchrec2searchrec(var f : searchrec);
-var
-  len : longint;
-begin
-  len:=StrLen(@f.Name);
-  Move(f.Name[0],f.Name[1],Len);
-  f.Name[0]:=chr(len);
-end;
-
-
-procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
-var
-   i : longint;
-begin
-  { allow slash as backslash }
-  for i:=0 to strlen(path) do
-    if path[i]='/' then path[i]:='\';
-  copytodos(f,sizeof(searchrec));
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$1a;
-  msdos(dosregs);
-  dosregs.ecx:=attr;
-  dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
-  dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$4e;
-  msdos(dosregs);
-  copyfromdos(f,sizeof(searchrec));
-  LoadDosError;
-  dossearchrec2searchrec(f);
-end;
-
-
-procedure Dosfindnext(var f : searchrec);
-begin
-  copytodos(f,sizeof(searchrec));
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  dosregs.ah:=$1a;
-  msdos(dosregs);
-  dosregs.ah:=$4f;
-  msdos(dosregs);
-  copyfromdos(f,sizeof(searchrec));
-  LoadDosError;
-  dossearchrec2searchrec(f);
-end;
-
-
-{******************************************************************************
-                     --- Findfirst FindNext ---
-******************************************************************************}
-
-procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
-var
-  path0 : array[0..256] of char;
-begin
-  doserror:=0;
-  strpcopy(path0,path);
-  if LFNSupport then
-   LFNFindFirst(path0,attr,f)
-  else
-   Dosfindfirst(path0,attr,f);
-end;
-
-
-procedure findnext(var f : searchRec);
-begin
-  doserror:=0;
-  if LFNSupport then
-   LFNFindnext(f)
-  else
-   Dosfindnext(f);
-end;
-
-
-Procedure FindClose(Var f: SearchRec);
-begin
-  DosError:=0;
-  if LFNSupport then
-   LFNFindClose(f);
-end;
-
-
-type swap_proc = procedure;
-
-var
-  _swap_in  : swap_proc;external name '_swap_in';
-  _swap_out : swap_proc;external name '_swap_out';
-  _exception_exit : pointer;external name '_exception_exit';
-  _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
-
-procedure swapvectors;
-begin
-  DosError:=0;
-  if _exception_exit<>nil then
-    if _v2prt0_exceptions_on then
-      _swap_in()
-    else
-      _swap_out();
-
-(*  asm
-{ uses four global symbols from v2prt0.as to be able to know the current
-  exception state without using dpmiexcp unit }
-            movl _exception_exit,%eax
-            orl  %eax,%eax
-            je   .Lno_excep
-            movl _v2prt0_exceptions_on,%eax
-            orl  %eax,%eax
-            je   .Lexceptions_off
-            call *_swap_out
-            jmp  .Lno_excep
-         .Lexceptions_off:
-            call *_swap_in
-         .Lno_excep:
-  end; *)
-end;
-
-
-{******************************************************************************
-                               --- File ---
-******************************************************************************}
-
-procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
-var
-   dotpos,p1,i : longint;
-begin
-  { allow slash as backslash }
-  for i:=1 to length(path) do
-   if path[i]='/' then path[i]:='\';
-  { get drive name }
-  p1:=pos(':',path);
-  if p1>0 then
-    begin
-       dir:=path[1]+':';
-       delete(path,1,p1);
-    end
-  else
-    dir:='';
-  { split the path and the name, there are no more path informtions }
-  { if path contains no backslashes                                 }
-  while true do
-    begin
-       p1:=pos('\',path);
-       if p1=0 then
-         break;
-       dir:=dir+copy(path,1,p1);
-       delete(path,1,p1);
-    end;
-  { try to find out a extension }
-  if LFNSupport then
-    begin
-       Ext:='';
-       i:=Length(Path);
-       DotPos:=256;
-       While (i>0) Do
-         Begin
-            If (Path[i]='.') Then
-              begin
-                 DotPos:=i;
-                 break;
-              end;
-            Dec(i);
-         end;
-       Ext:=Copy(Path,DotPos,255);
-       Name:=Copy(Path,1,DotPos - 1);
-    end
-  else
-    begin
-       p1:=pos('.',path);
-       if p1>0 then
-         begin
-            ext:=copy(path,p1,4);
-            delete(path,p1,length(path)-p1+1);
-         end
-       else
-         ext:='';
-       name:=path;
-    end;
-end;
-
-
-    function fexpand(const path : pathstr) : pathstr;
-       var
-         s,pa : pathstr;
-         i,j  : longint;
-       begin
-          getdir(0,s);
-          i:=ioresult;
-          if LFNSupport then
-           begin
-             pa:=path;
-           end
-          else
-           if FileNameCaseSensitive then
-            pa:=path
-           else
-            pa:=upcase(path);
-
-          { allow slash as backslash }
-          for i:=1 to length(pa) do
-           if pa[i]='/' then
-            pa[i]:='\';
-
-          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
-            begin
-               { Always uppercase driveletter }
-               if (pa[1] in ['a'..'z']) then
-                pa[1]:=Chr(Ord(Pa[1])-32);
-               { we must get the right directory }
-               getdir(ord(pa[1])-ord('A')+1,s);
-               i:=ioresult;
-               if (ord(pa[0])>2) and (pa[3]<>'\') then
-                 if pa[1]=s[1] then
-                   begin
-                     { remove ending slash if it already exists }
-                     if s[length(s)]='\' then
-                      dec(s[0]);
-                     pa:=s+'\'+copy (pa,3,length(pa));
-                   end
-                 else
-                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
-            end
-          else
-            if pa[1]='\' then
-              pa:=s[1]+':'+pa
-            else if s[0]=#3 then
-              pa:=s+pa
-            else
-              pa:=s+'\'+pa;
-
-        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
-        if length(pa) = 2 then
-         begin
-           getdir(byte(pa[1])-64,s);
-           pa := s;
-         end;
-
-        {First remove all references to '\.\'}
-          while pos ('\.\',pa)<>0 do
-           delete (pa,pos('\.\',pa),2);
-        {Now remove also all references to '\..\' + of course previous dirs..}
-          repeat
-            i:=pos('\..\',pa);
-            if i<>0 then
-             begin
-               j:=i-1;
-               while (j>1) and (pa[j]<>'\') do
-                dec (j);
-               if pa[j+1] = ':' then j := 3;
-               delete (pa,j,i-j+3);
-             end;
-          until i=0;
-
-          { Turbo Pascal gets rid of a \.. at the end of the path }
-          { Now remove also any reference to '\..'  at end of line
-            + of course previous dir.. }
-          i:=pos('\..',pa);
-          if i<>0 then
-           begin
-             if i = length(pa) - 2 then
-              begin
-                j:=i-1;
-                while (j>1) and (pa[j]<>'\') do
-                 dec (j);
-                delete (pa,j,i-j+3);
-              end;
-              pa := pa + '\';
-            end;
-          { Remove End . and \}
-          if (length(pa)>0) and (pa[length(pa)]='.') then
-           dec(byte(pa[0]));
-          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
-            accessing the current directory on the drive rather than the root!}
-          { if the last char of path = '\' then leave it in as this is what TP does! }
-          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
-           dec(byte(pa[0]));
-          { if only a drive is given in path then there should be a '\' at the
-            end of the string given back }
-          if length(pa) = 2 then pa := pa + '\';
-          fexpand:=pa;
-       end;
-
-
-Function FSearch(path: pathstr; dirlist: string): pathstr;
-var
-  i,p1   : longint;
-  s      : searchrec;
-  newdir : pathstr;
-begin
-{ check if the file specified exists }
-  findfirst(path,anyfile,s);
-  if doserror=0 then
-   begin
-     findclose(s);
-     fsearch:=path;
-     exit;
-   end;
-{ No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
-    begin
-       { allow slash as backslash }
-       for i:=1 to length(dirlist) do
-         if dirlist[i]='/' then dirlist[i]:='\';
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile,s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
-    end;
-  findclose(s);
-end;
-
-
-{******************************************************************************
-                       --- Get/Set File Time,Attr ---
-******************************************************************************}
-
-procedure getftime(var f;var time : longint);
-begin
-  dosregs.bx:=textrec(f).handle;
-  dosregs.ax:=$5700;
-  msdos(dosregs);
-  loaddoserror;
-  time:=(dosregs.dx shl 16)+dosregs.cx;
-end;
-
-
-procedure setftime(var f;time : longint);
-begin
-  dosregs.bx:=textrec(f).handle;
-  dosregs.cx:=time and $ffff;
-  dosregs.dx:=time shr 16;
-  dosregs.ax:=$5701;
-  msdos(dosregs);
-  loaddoserror;
-end;
-
-
-procedure getfattr(var f;var attr : word);
-begin
-  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  if LFNSupport then
-   begin
-     dosregs.ax:=$7143;
-     dosregs.bx:=0;
-   end
-  else
-   dosregs.ax:=$4300;
-  msdos(dosregs);
-  LoadDosError;
-  Attr:=dosregs.cx;
-end;
-
-
-procedure setfattr(var f;attr : word);
-begin
-  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
-  dosregs.edx:=tb_offset;
-  dosregs.ds:=tb_segment;
-  if LFNSupport then
-   begin
-     dosregs.ax:=$7143;
-     dosregs.bx:=1;
-   end
-  else
-   dosregs.ax:=$4301;
-  dosregs.cx:=attr;
-  msdos(dosregs);
-  LoadDosError;
-end;
-
-
-{******************************************************************************
-                             --- Environment ---
-******************************************************************************}
-
-function envcount : longint;
-var
-  hp : ppchar;
-begin
-  hp:=envp;
-  envcount:=0;
-  while assigned(hp^) do
-   begin
-     inc(envcount);
-     inc(hp);
-   end;
-end;
-
-
-function envstr(index : integer) : string;
-begin
-  if (index<=0) or (index>envcount) then
-   begin
-     envstr:='';
-     exit;
-   end;
-  envstr:=strpas(ppchar(pointer(envp)+4*(index-1))^);
-end;
-
-
-Function  GetEnv(envvar: string): string;
-var
-  hp      : ppchar;
-  hs    : string;
-  eqpos : longint;
-begin
-  envvar:=upcase(envvar);
-  hp:=envp;
-  getenv:='';
-  while assigned(hp^) do
-   begin
-     hs:=strpas(hp^);
-     eqpos:=pos('=',hs);
-     if copy(hs,1,eqpos-1)=envvar then
-      begin
-        getenv:=copy(hs,eqpos+1,255);
-        exit;
-      end;
-     inc(hp);
-   end;
-end;
-
-
-{******************************************************************************
-                             --- Not Supported ---
-******************************************************************************}
-
-Procedure keep(exitcode : word);
-Begin
-End;
-
-Procedure getintvec(intno : byte;var vector : pointer);
-Begin
-End;
-
-Procedure setintvec(intno : byte;vector : pointer);
-Begin
-End;
-
-
-end.
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,97 by the Free Pascal development team.
+
+    Dos unit for BP7 compatible RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+
+Uses
+  Go32;
+
+Const
+  {Bitmasks for CPU Flags}
+  fcarry     = $0001;
+  fparity    = $0004;
+  fauxiliary = $0010;
+  fzero      = $0040;
+  fsign      = $0080;
+  foverflow  = $0800;
+
+  {Bitmasks for file attribute}
+  readonly  = $01;
+  hidden    = $02;
+  sysfile   = $04;
+  volumeid  = $08;
+  directory = $10;
+  archive   = $20;
+  anyfile   = $3F;
+
+  {File Status}
+  fmclosed = $D7B0;
+  fminput  = $D7B1;
+  fmoutput = $D7B2;
+  fminout  = $D7B3;
+
+
+Type
+{ Needed for LFN Support }
+  ComStr  = String[255];
+  PathStr = String[255];
+  DirStr  = String[255];
+  NameStr = String[255];
+  ExtStr  = String[255];
+
+{
+  filerec.inc contains the definition of the filerec.
+  textrec.inc contains the definition of the textrec.
+  It is in a separate file to make it available in other units without
+  having to use the DOS unit for it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+  DateTime = packed record
+    Year,
+    Month,
+    Day,
+    Hour,
+    Min,
+    Sec   : word;
+  End;
+
+  searchrec = packed record
+     fill : array[1..21] of byte;
+     attr : byte;
+     time : longint;
+     { reserved : word; not in DJGPP V2 }
+     size : longint;
+     name : string[255]; { LFN Name, DJGPP uses only [12] but more can't hurt (PFV) }
+  end;
+
+  Registers = Go32.Registers;
+
+Var
+  DosError : integer;
+
+{Interrupt}
+Procedure Intr(intno: byte; var regs: registers);
+Procedure MSDos(var regs: registers);
+
+{Info/Date/Time}
+Function  DosVersion: Word;
+Procedure GetDate(var year, month, mday, wday: word);
+Procedure GetTime(var hour, minute, second, sec100: word);
+procedure SetDate(year,month,day: word);
+Procedure SetTime(hour,minute,second,sec100: word);
+Procedure UnpackTime(p: longint; var t: datetime);
+Procedure PackTime(var t: datetime; var p: longint);
+
+{Exec}
+Procedure Exec(const path: pathstr; const comline: comstr);
+Function  DosExitCode: word;
+
+{Disk}
+Function  DiskFree(drive: byte) : longint;
+Function  DiskSize(drive: byte) : longint;
+Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
+Procedure FindNext(var f: searchRec);
+Procedure FindClose(Var f: SearchRec);
+
+{File}
+Procedure GetFAttr(var f; var attr: word);
+Procedure GetFTime(var f; var time: longint);
+Function  FSearch(path: pathstr; dirlist: string): pathstr;
+Function  FExpand(const path: pathstr): pathstr;
+Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
+
+{Environment}
+Function  EnvCount: longint;
+Function  EnvStr(index: integer): string;
+Function  GetEnv(envvar: string): string;
+
+{Misc}
+Procedure SetFAttr(var f; attr: word);
+Procedure SetFTime(var f; time: longint);
+Procedure GetCBreak(var breakvalue: boolean);
+Procedure SetCBreak(breakvalue: boolean);
+Procedure GetVerify(var verify: boolean);
+Procedure SetVerify(verify: boolean);
+
+{Do Nothing Functions}
+Procedure SwapVectors;
+Procedure GetIntVec(intno: byte; var vector: pointer);
+Procedure SetIntVec(intno: byte; vector: pointer);
+Procedure Keep(exitcode: word);
+
+implementation
+
+uses
+  strings;
+
+{$ASMMODE ATT}
+
+{******************************************************************************
+                           --- Dos Interrupt ---
+******************************************************************************}
+
+var
+  dosregs : registers;
+
+procedure LoadDosError;
+var
+  r : registers;
+begin
+  if (dosregs.flags and carryflag) <> 0 then
+   begin
+     r.eax:=$5900;
+     r.ebx:=$0;
+     realintr($21,r);
+     { conversion from word to integer !!
+       gave a Bound check error if ax is $FFFF !! PM }
+     doserror:=integer(r.ax);
+     case doserror of
+      19 : DosError:=150;
+      21 : DosError:=152;
+     end;
+   end
+  else
+    doserror:=0;
+end;
+
+
+procedure intr(intno : byte;var regs : registers);
+begin
+  realintr(intno,regs);
+end;
+
+
+procedure msdos(var regs : registers);
+begin
+  intr($21,regs);
+end;
+
+
+{******************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
+
+function dosversion : word;
+begin
+  dosregs.ax:=$3000;
+  msdos(dosregs);
+  dosversion:=dosregs.ax;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+begin
+  dosregs.ax:=$2a00;
+  msdos(dosregs);
+  wday:=dosregs.al;
+  year:=dosregs.cx;
+  month:=dosregs.dh;
+  mday:=dosregs.dl;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+   dosregs.cx:=year;
+   dosregs.dh:=month;
+   dosregs.dl:=day;
+   dosregs.ah:=$2b;
+   msdos(dosregs);
+   DosError:=0;
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+begin
+  dosregs.ah:=$2c;
+  msdos(dosregs);
+  hour:=dosregs.ch;
+  minute:=dosregs.cl;
+  second:=dosregs.dh;
+  sec100:=dosregs.dl;
+  DosError:=0;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+  dosregs.ch:=hour;
+  dosregs.cl:=minute;
+  dosregs.dh:=second;
+  dosregs.dl:=sec100;
+  dosregs.ah:=$2d;
+  msdos(dosregs);
+  DosError:=0;
+end;
+
+
+Procedure packtime(var t : datetime;var p : longint);
+Begin
+  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
+End;
+
+
+Procedure unpacktime(p : longint;var t : datetime);
+Begin
+  with t do
+   begin
+     sec:=(p and 31) shl 1;
+     min:=(p shr 5) and 63;
+     hour:=(p shr 11) and 31;
+     day:=(p shr 16) and 31;
+     month:=(p shr 21) and 15;
+     year:=(p shr 25)+1980;
+   end;
+End;
+
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+var
+  lastdosexitcode : word;
+
+procedure exec(const path : pathstr;const comline : comstr);
+type
+  realptr = packed record
+    ofs,seg : word;
+  end;
+  texecblock = packed record
+    envseg    : word;
+    comtail   : realptr;
+    firstFCB  : realptr;
+    secondFCB : realptr;
+    iniStack  : realptr;
+    iniCSIP   : realptr;
+  end;
+var
+  current_dos_buffer_pos,
+  arg_ofs,
+  i,la_env,
+  la_p,la_c,la_e,
+  fcb1_la,fcb2_la : longint;
+  execblock       : texecblock;
+  c,p             : string;
+
+  function paste_to_dos(src : string) : boolean;
+  var
+    c : array[0..255] of char;
+  begin
+     paste_to_dos:=false;
+     if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
+      RunError(217);
+     move(src[1],c[0],length(src));
+     c[length(src)]:=#0;
+     seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
+     current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
+     paste_to_dos:=true;
+  end;
+
+begin
+{ create command line }
+  move(comline[0],c[1],length(comline)+1);
+  c[length(comline)+2]:=#13;
+  c[0]:=char(length(comline)+2);
+{ create path }
+  p:=path;
+  for i:=1 to length(p) do
+   if p[i]='/' then
+    p[i]:='\';
+{ create buffer }
+  la_env:=transfer_buffer;
+  while (la_env and 15)<>0 do
+   inc(la_env);
+  current_dos_buffer_pos:=la_env;
+{ copy environment }
+  for i:=1 to envcount do
+   paste_to_dos(envstr(i));
+  paste_to_dos(''); { adds a double zero at the end }
+{ allow slash as backslash }
+  la_p:=current_dos_buffer_pos;
+  paste_to_dos(p);
+  la_c:=current_dos_buffer_pos;
+  paste_to_dos(c);
+  la_e:=current_dos_buffer_pos;
+  fcb1_la:=la_e;
+  la_e:=la_e+16;
+  fcb2_la:=la_e;
+  la_e:=la_e+16;
+{ allocate FCB see dosexec code }
+  arg_ofs:=1;
+  while (c[arg_ofs] in [' ',#9]) do
+   inc(arg_ofs);
+  dosregs.ax:=$2901;
+  dosregs.ds:=(la_c+arg_ofs) shr 4;
+  dosregs.esi:=(la_c+arg_ofs) and 15;
+  dosregs.es:=fcb1_la shr 4;
+  dosregs.edi:=fcb1_la and 15;
+  msdos(dosregs);
+{ allocate second FCB see dosexec code }
+  repeat
+    inc(arg_ofs);
+  until (c[arg_ofs] in [' ',#9,#13]);
+  if c[arg_ofs]<>#13 then
+   begin
+     repeat
+       inc(arg_ofs);
+     until not (c[arg_ofs] in [' ',#9]);
+   end;
+  dosregs.ax:=$2901;
+  dosregs.ds:=(la_c+arg_ofs) shr 4;
+  dosregs.si:=(la_c+arg_ofs) and 15;
+  dosregs.es:=fcb2_la shr 4;
+  dosregs.di:=fcb2_la and 15;
+  msdos(dosregs);
+  with execblock do
+   begin
+     envseg:=la_env shr 4;
+     comtail.seg:=la_c shr 4;
+     comtail.ofs:=la_c and 15;
+     firstFCB.seg:=fcb1_la shr 4;
+     firstFCB.ofs:=fcb1_la and 15;
+     secondFCB.seg:=fcb2_la shr 4;
+     secondFCB.ofs:=fcb2_la and 15;
+   end;
+  seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
+  dosregs.edx:=la_p and 15;
+  dosregs.ds:=la_p shr 4;
+  dosregs.ebx:=la_e and 15;
+  dosregs.es:=la_e shr 4;
+  dosregs.ax:=$4b00;
+  msdos(dosregs);
+  LoadDosError;
+  if DosError=0 then
+   begin
+     dosregs.ax:=$4d00;
+     msdos(dosregs);
+     LastDosExitCode:=DosRegs.al
+   end
+  else
+   LastDosExitCode:=0;
+end;
+
+
+function dosexitcode : word;
+begin
+  dosexitcode:=lastdosexitcode;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3300;
+  msdos(dosregs);
+  breakvalue:=dosregs.dl<>0;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3301;
+  dosregs.dl:=ord(breakvalue);
+  msdos(dosregs);
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$54;
+  msdos(dosregs);
+  verify:=dosregs.al<>0;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$2e;
+  dosregs.al:=ord(verify);
+  msdos(dosregs);
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+function diskfree(drive : byte) : longint;
+begin
+  DosError:=0;
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
+  else
+   diskfree:=-1;
+end;
+
+
+function disksize(drive : byte) : longint;
+begin
+  DosError:=0;
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
+  else
+   disksize:=-1;
+end;
+
+
+{******************************************************************************
+                      --- LFNFindfirst LFNFindNext ---
+******************************************************************************}
+
+type
+  LFNSearchRec=packed record
+    attr,
+    crtime,
+    crtimehi,
+    actime,
+    actimehi,
+    lmtime,
+    lmtimehi,
+    sizehi,
+    size      : longint;
+    reserved  : array[0..7] of byte;
+    name      : array[0..259] of byte;
+    shortname : array[0..13] of byte;
+  end;
+
+procedure LFNSearchRec2Dos(const w:LFNSearchRec;hdl:longint;var d:Searchrec);
+var
+  Len : longint;
+begin
+  With w do
+   begin
+     FillChar(d,sizeof(SearchRec),0);
+     if DosError=0 then
+      len:=StrLen(@Name)
+     else
+      len:=0;
+     d.Name[0]:=chr(len);
+     Move(Name[0],d.Name[1],Len);
+     d.Time:=lmTime;
+     d.Size:=Size;
+     d.Attr:=Attr and $FF;
+     Move(hdl,d.Fill,4);
+   end;
+end;
+
+
+procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
+var
+  i : longint;
+  w : LFNSearchRec;
+begin
+  { allow slash as backslash }
+  for i:=0 to strlen(path) do
+    if path[i]='/' then path[i]:='\';
+  dosregs.si:=1; { use ms-dos time }
+  { don't include the label if not asked for it, needed for network drives }
+  if attr=$8 then
+   dosregs.ecx:=8
+  else
+   dosregs.ecx:=attr and (not 8);
+  dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
+  dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_segment;
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_segment;
+  dosregs.ax:=$714e;
+  msdos(dosregs);
+  LoadDosError;
+  copyfromdos(w,sizeof(LFNSearchRec));
+  LFNSearchRec2Dos(w,dosregs.ax,s);
+end;
+
+
+procedure LFNFindNext(var s:searchrec);
+var
+  hdl : longint;
+  w   : LFNSearchRec;
+begin
+  Move(s.Fill,hdl,4);
+  dosregs.si:=1; { use ms-dos time }
+  dosregs.edi:=tb_offset;
+  dosregs.es:=tb_segment;
+  dosregs.ebx:=hdl;
+  dosregs.ax:=$714f;
+  msdos(dosregs);
+  LoadDosError;
+  copyfromdos(w,sizeof(LFNSearchRec));
+  LFNSearchRec2Dos(w,hdl,s);
+end;
+
+
+procedure LFNFindClose(var s:searchrec);
+var
+  hdl : longint;
+begin
+  Move(s.Fill,hdl,4);
+  dosregs.ebx:=hdl;
+  dosregs.ax:=$71a1;
+  msdos(dosregs);
+  LoadDosError;
+end;
+
+
+{******************************************************************************
+                     --- DosFindfirst DosFindNext ---
+******************************************************************************}
+
+procedure dossearchrec2searchrec(var f : searchrec);
+var
+  len : longint;
+begin
+  len:=StrLen(@f.Name);
+  Move(f.Name[0],f.Name[1],Len);
+  f.Name[0]:=chr(len);
+end;
+
+
+procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
+var
+   i : longint;
+begin
+  { allow slash as backslash }
+  for i:=0 to strlen(path) do
+    if path[i]='/' then path[i]:='\';
+  copytodos(f,sizeof(searchrec));
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$1a;
+  msdos(dosregs);
+  dosregs.ecx:=attr;
+  dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
+  dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$4e;
+  msdos(dosregs);
+  copyfromdos(f,sizeof(searchrec));
+  LoadDosError;
+  dossearchrec2searchrec(f);
+end;
+
+
+procedure Dosfindnext(var f : searchrec);
+begin
+  copytodos(f,sizeof(searchrec));
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  dosregs.ah:=$1a;
+  msdos(dosregs);
+  dosregs.ah:=$4f;
+  msdos(dosregs);
+  copyfromdos(f,sizeof(searchrec));
+  LoadDosError;
+  dossearchrec2searchrec(f);
+end;
+
+
+{******************************************************************************
+                     --- Findfirst FindNext ---
+******************************************************************************}
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+  path0 : array[0..256] of char;
+begin
+  doserror:=0;
+  strpcopy(path0,path);
+  if LFNSupport then
+   LFNFindFirst(path0,attr,f)
+  else
+   Dosfindfirst(path0,attr,f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+  doserror:=0;
+  if LFNSupport then
+   LFNFindnext(f)
+  else
+   Dosfindnext(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  DosError:=0;
+  if LFNSupport then
+   LFNFindClose(f);
+end;
+
+
+type swap_proc = procedure;
+
+var
+  _swap_in  : swap_proc;external name '_swap_in';
+  _swap_out : swap_proc;external name '_swap_out';
+  _exception_exit : pointer;external name '_exception_exit';
+  _v2prt0_exceptions_on : longbool;external name '_v2prt0_exceptions_on';
+
+procedure swapvectors;
+begin
+  DosError:=0;
+  if _exception_exit<>nil then
+    if _v2prt0_exceptions_on then
+      _swap_in()
+    else
+      _swap_out();
+
+(*  asm
+{ uses four global symbols from v2prt0.as to be able to know the current
+  exception state without using dpmiexcp unit }
+            movl _exception_exit,%eax
+            orl  %eax,%eax
+            je   .Lno_excep
+            movl _v2prt0_exceptions_on,%eax
+            orl  %eax,%eax
+            je   .Lexceptions_off
+            call *_swap_out
+            jmp  .Lno_excep
+         .Lexceptions_off:
+            call *_swap_in
+         .Lno_excep:
+  end; *)
+end;
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
+var
+   dotpos,p1,i : longint;
+begin
+  { allow slash as backslash }
+  for i:=1 to length(path) do
+   if path[i]='/' then path[i]:='\';
+  { get drive name }
+  p1:=pos(':',path);
+  if p1>0 then
+    begin
+       dir:=path[1]+':';
+       delete(path,1,p1);
+    end
+  else
+    dir:='';
+  { split the path and the name, there are no more path informtions }
+  { if path contains no backslashes                                 }
+  while true do
+    begin
+       p1:=pos('\',path);
+       if p1=0 then
+         break;
+       dir:=dir+copy(path,1,p1);
+       delete(path,1,p1);
+    end;
+  { try to find out a extension }
+  if LFNSupport then
+    begin
+       Ext:='';
+       i:=Length(Path);
+       DotPos:=256;
+       While (i>0) Do
+         Begin
+            If (Path[i]='.') Then
+              begin
+                 DotPos:=i;
+                 break;
+              end;
+            Dec(i);
+         end;
+       Ext:=Copy(Path,DotPos,255);
+       Name:=Copy(Path,1,DotPos - 1);
+    end
+  else
+    begin
+       p1:=pos('.',path);
+       if p1>0 then
+         begin
+            ext:=copy(path,p1,4);
+            delete(path,p1,length(path)-p1+1);
+         end
+       else
+         ext:='';
+       name:=path;
+    end;
+end;
+
+
+    function fexpand(const path : pathstr) : pathstr;
+       var
+         s,pa : pathstr;
+         i,j  : longint;
+       begin
+          getdir(0,s);
+          i:=ioresult;
+          if LFNSupport then
+           begin
+             pa:=path;
+           end
+          else
+           if FileNameCaseSensitive then
+            pa:=path
+           else
+            pa:=upcase(path);
+
+          { allow slash as backslash }
+          for i:=1 to length(pa) do
+           if pa[i]='/' then
+            pa[i]:='\';
+
+          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z','a'..'z']) then
+            begin
+               { Always uppercase driveletter }
+               if (pa[1] in ['a'..'z']) then
+                pa[1]:=Chr(Ord(Pa[1])-32);
+               { we must get the right directory }
+               getdir(ord(pa[1])-ord('A')+1,s);
+               i:=ioresult;
+               if (ord(pa[0])>2) and (pa[3]<>'\') then
+                 if pa[1]=s[1] then
+                   begin
+                     { remove ending slash if it already exists }
+                     if s[length(s)]='\' then
+                      dec(s[0]);
+                     pa:=s+'\'+copy (pa,3,length(pa));
+                   end
+                 else
+                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
+            end
+          else
+            if pa[1]='\' then
+              pa:=s[1]+':'+pa
+            else if s[0]=#3 then
+              pa:=s+pa
+            else
+              pa:=s+'\'+pa;
+
+        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
+        if length(pa) = 2 then
+         begin
+           getdir(byte(pa[1])-64,s);
+           pa := s;
+         end;
+
+        {First remove all references to '\.\'}
+          while pos ('\.\',pa)<>0 do
+           delete (pa,pos('\.\',pa),2);
+        {Now remove also all references to '\..\' + of course previous dirs..}
+          repeat
+            i:=pos('\..\',pa);
+            if i<>0 then
+             begin
+               j:=i-1;
+               while (j>1) and (pa[j]<>'\') do
+                dec (j);
+               if pa[j+1] = ':' then j := 3;
+               delete (pa,j,i-j+3);
+             end;
+          until i=0;
+
+          { Turbo Pascal gets rid of a \.. at the end of the path }
+          { Now remove also any reference to '\..'  at end of line
+            + of course previous dir.. }
+          i:=pos('\..',pa);
+          if i<>0 then
+           begin
+             if i = length(pa) - 2 then
+              begin
+                j:=i-1;
+                while (j>1) and (pa[j]<>'\') do
+                 dec (j);
+                delete (pa,j,i-j+3);
+              end;
+              pa := pa + '\';
+            end;
+          { Remove End . and \}
+          if (length(pa)>0) and (pa[length(pa)]='.') then
+           dec(byte(pa[0]));
+          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
+            accessing the current directory on the drive rather than the root!}
+          { if the last char of path = '\' then leave it in as this is what TP does! }
+          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
+           dec(byte(pa[0]));
+          { if only a drive is given in path then there should be a '\' at the
+            end of the string given back }
+          if length(pa) = 2 then pa := pa + '\';
+          fexpand:=pa;
+       end;
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
+begin
+{ check if the file specified exists }
+  findfirst(path,anyfile,s);
+  if doserror=0 then
+   begin
+     findclose(s);
+     fsearch:=path;
+     exit;
+   end;
+{ No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+    fsearch:=''
+  else
+    begin
+       { allow slash as backslash }
+       for i:=1 to length(dirlist) do
+         if dirlist[i]='/' then dirlist[i]:='\';
+       repeat
+         p1:=pos(';',dirlist);
+         if p1<>0 then
+          begin
+            newdir:=copy(dirlist,1,p1-1);
+            delete(dirlist,1,p1);
+          end
+         else
+          begin
+            newdir:=dirlist;
+            dirlist:='';
+          end;
+         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+          newdir:=newdir+'\';
+         findfirst(newdir+path,anyfile,s);
+         if doserror=0 then
+          newdir:=newdir+path
+         else
+          newdir:='';
+       until (dirlist='') or (newdir<>'');
+       fsearch:=newdir;
+    end;
+  findclose(s);
+end;
+
+
+{******************************************************************************
+                       --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.ax:=$5700;
+  msdos(dosregs);
+  loaddoserror;
+  time:=(dosregs.dx shl 16)+dosregs.cx;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.cx:=time and $ffff;
+  dosregs.dx:=time shr 16;
+  dosregs.ax:=$5701;
+  msdos(dosregs);
+  loaddoserror;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+begin
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  if LFNSupport then
+   begin
+     dosregs.ax:=$7143;
+     dosregs.bx:=0;
+   end
+  else
+   dosregs.ax:=$4300;
+  msdos(dosregs);
+  LoadDosError;
+  Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+  copytodos(filerec(f).name,strlen(filerec(f).name)+1);
+  dosregs.edx:=tb_offset;
+  dosregs.ds:=tb_segment;
+  if LFNSupport then
+   begin
+     dosregs.ax:=$7143;
+     dosregs.bx:=1;
+   end
+  else
+   dosregs.ax:=$4301;
+  dosregs.cx:=attr;
+  msdos(dosregs);
+  LoadDosError;
+end;
+
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+var
+  hp : ppchar;
+begin
+  hp:=envp;
+  envcount:=0;
+  while assigned(hp^) do
+   begin
+     inc(envcount);
+     inc(hp);
+   end;
+end;
+
+
+function envstr(index : integer) : string;
+begin
+  if (index<=0) or (index>envcount) then
+   begin
+     envstr:='';
+     exit;
+   end;
+  envstr:=strpas(ppchar(pointer(envp)+4*(index-1))^);
+end;
+
+
+Function  GetEnv(envvar: string): string;
+var
+  hp      : ppchar;
+  hs    : string;
+  eqpos : longint;
+begin
+  envvar:=upcase(envvar);
+  hp:=envp;
+  getenv:='';
+  while assigned(hp^) do
+   begin
+     hs:=strpas(hp^);
+     eqpos:=pos('=',hs);
+     if copy(hs,1,eqpos-1)=envvar then
+      begin
+        getenv:=copy(hs,eqpos+1,255);
+        exit;
+      end;
+     inc(hp);
+   end;
+end;
+
+
+{******************************************************************************
+                             --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+End;
+
+Procedure getintvec(intno : byte;var vector : pointer);
+Begin
+End;
+
+Procedure setintvec(intno : byte;vector : pointer);
+Begin
+End;
+
+
+end.
+{
   $Log$
-  Revision 1.11  1999-09-08 18:55:49  peter
-    * pointer fixes
-
-  Revision 1.10  1999/08/13 21:23:15  peter
-    * fsearch checks first if the specified file exists and returns that
-      if it was found
-
-  Revision 1.9  1999/05/16 17:08:58  peter
-    * fixed driveletter checking
-
-  Revision 1.8  1999/05/08 19:47:22  peter
-    * check ioresult after getdir calls
-
-  Revision 1.7  1999/05/04 23:55:50  pierre
-   * unneeded assembler code converted to pascal
-
-  Revision 1.6  1999/04/28 11:42:44  peter
-    + FileNameCaseSensetive boolean
-
-  Revision 1.5  1999/04/02 00:01:29  peter
-    * fixed LFNFindfirst on network drives
-
-  Revision 1.4  1999/03/01 15:40:48  peter
-    * use external names
-    * removed all direct assembler modes
-
-  Revision 1.3  1999/01/22 15:44:59  pierre
-   Daniel change removed : broke make cycle !!
-
-  Revision 1.2  1999/01/22 10:07:03  daniel
-  - Findclose removed: This is TP incompatible!!
-
-  Revision 1.1  1998/12/21 13:07:02  peter
-    * use -FE
-
-  Revision 1.19  1998/11/23 13:53:59  peter
-    * more fexpand fixes from marco van de voort
-
-  Revision 1.18  1998/11/23 12:48:02  peter
-    * fexpand('o:') fixed to return o:\ (from the mailinglist)
-
-  Revision 1.17  1998/11/22 09:33:21  florian
-    * fexpand bug (temp. strings were too shoort) fixed, was reported
-      by Marco van de Voort
-
-  Revision 1.16  1998/11/17 09:37:41  pierre
-   * explicit conversion from word dosreg.ax to integer doserror
-
-  Revision 1.15  1998/11/01 20:27:18  peter
-    * fixed some doserror settings
-
-  Revision 1.14  1998/10/22 15:05:28  pierre
-   * fsplit adapted to long filenames
-
-  Revision 1.13  1998/09/16 16:47:24  peter
-    * merged fixes
-
-  Revision 1.11.2.2  1998/09/16 16:16:04  peter
-    * go32v1 compiles again
-
-  Revision 1.12  1998/09/11 12:46:44  pierre
-    * range check problem with LFN attr removed
-
-  Revision 1.11.2.1  1998/09/11 12:38:41  pierre
-    * conversion from LFN attr to Dos attr did not respect range checking
-
-  Revision 1.11  1998/08/28 10:45:58  peter
-    * fixed path buffer in findfirst
-
-  Revision 1.10  1998/08/27 10:30:48  pierre
-    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
-      I renamed tb_selector to tb_segment because
-        it is a real mode segment as opposed to
-        a protected mode selector
-      Fixed it for go32v1 (remove the $E0000000 offset !)
-
-  Revision 1.9  1998/08/26 10:04:01  peter
-    * new lfn check from mailinglist
-    * renamed win95 -> LFNSupport
-    + tb_selector, tb_offset for easier access to transferbuffer
-
-  Revision 1.8  1998/08/16 20:39:49  peter
-    + LFN Support
-
-  Revision 1.7  1998/08/16 09:12:13  michael
-  Corrected fexpand behaviour.
-
-  Revision 1.6  1998/08/05 21:01:50  michael
-  applied bugfix from maillist to fsearch
-
-  Revision 1.5  1998/05/31 14:18:13  peter
-    * force att or direct assembling
-    * cleanup of some files
-
-  Revision 1.4  1998/05/22 00:39:22  peter
-    * go32v1, go32v2 recompiles with the new objects
-    * remake3 works again with go32v2
-    - removed some "optimizes" from daniel which were wrong
-
-  Revision 1.3  1998/05/21 19:30:47  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-}
-
-
-
+  Revision 1.12  1999-09-10 17:14:09  peter
+    * better errorcode returning using int21h,5900
+
+  Revision 1.11  1999/09/08 18:55:49  peter
+    * pointer fixes
+
+  Revision 1.10  1999/08/13 21:23:15  peter
+    * fsearch checks first if the specified file exists and returns that
+      if it was found
+
+  Revision 1.9  1999/05/16 17:08:58  peter
+    * fixed driveletter checking
+
+  Revision 1.8  1999/05/08 19:47:22  peter
+    * check ioresult after getdir calls
+
+  Revision 1.7  1999/05/04 23:55:50  pierre
+   * unneeded assembler code converted to pascal
+
+  Revision 1.6  1999/04/28 11:42:44  peter
+    + FileNameCaseSensetive boolean
+
+  Revision 1.5  1999/04/02 00:01:29  peter
+    * fixed LFNFindfirst on network drives
+
+  Revision 1.4  1999/03/01 15:40:48  peter
+    * use external names
+    * removed all direct assembler modes
+
+  Revision 1.3  1999/01/22 15:44:59  pierre
+   Daniel change removed : broke make cycle !!
+
+  Revision 1.2  1999/01/22 10:07:03  daniel
+  - Findclose removed: This is TP incompatible!!
+
+  Revision 1.1  1998/12/21 13:07:02  peter
+    * use -FE
+
+  Revision 1.19  1998/11/23 13:53:59  peter
+    * more fexpand fixes from marco van de voort
+
+  Revision 1.18  1998/11/23 12:48:02  peter
+    * fexpand('o:') fixed to return o:\ (from the mailinglist)
+
+  Revision 1.17  1998/11/22 09:33:21  florian
+    * fexpand bug (temp. strings were too shoort) fixed, was reported
+      by Marco van de Voort
+
+  Revision 1.16  1998/11/17 09:37:41  pierre
+   * explicit conversion from word dosreg.ax to integer doserror
+
+  Revision 1.15  1998/11/01 20:27:18  peter
+    * fixed some doserror settings
+
+  Revision 1.14  1998/10/22 15:05:28  pierre
+   * fsplit adapted to long filenames
+
+  Revision 1.13  1998/09/16 16:47:24  peter
+    * merged fixes
+
+  Revision 1.11.2.2  1998/09/16 16:16:04  peter
+    * go32v1 compiles again
+
+  Revision 1.12  1998/09/11 12:46:44  pierre
+    * range check problem with LFN attr removed
+
+  Revision 1.11.2.1  1998/09/11 12:38:41  pierre
+    * conversion from LFN attr to Dos attr did not respect range checking
+
+  Revision 1.11  1998/08/28 10:45:58  peter
+    * fixed path buffer in findfirst
+
+  Revision 1.10  1998/08/27 10:30:48  pierre
+    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
+      I renamed tb_selector to tb_segment because
+        it is a real mode segment as opposed to
+        a protected mode selector
+      Fixed it for go32v1 (remove the $E0000000 offset !)
+
+  Revision 1.9  1998/08/26 10:04:01  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.8  1998/08/16 20:39:49  peter
+    + LFN Support
+
+  Revision 1.7  1998/08/16 09:12:13  michael
+  Corrected fexpand behaviour.
+
+  Revision 1.6  1998/08/05 21:01:50  michael
+  applied bugfix from maillist to fsearch
+
+  Revision 1.5  1998/05/31 14:18:13  peter
+    * force att or direct assembling
+    * cleanup of some files
+
+  Revision 1.4  1998/05/22 00:39:22  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
+
+  Revision 1.3  1998/05/21 19:30:47  peter
+    * objects compiles for linux
+    + assign(pchar), assign(char), rename(pchar), rename(char)
+    * fixed read_text_as_array
+    + read_text_as_pchar which was not yet in the rtl
+}
+
+
+

rtl/go32v2/system.pp

@@ -1,1422 +1,1439 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit system;
-
-interface
-
-{ two debug conditionnals can be used
-  - SYSTEMDEBUG
-    -for STACK checks
-    -for non closed files at exit (or at any time with GDB)
-  - SYSTEM_DEBUG_STARTUP
-    specifically for
-    - proxy command line (DJGPP feature)
-    - list of args
-    - list of env variables  (PM) }
-
-{ include system-independent routine headers }
-
-{$I systemh.inc}
-
-{ include heap support headers }
-
-{$I heaph.inc}
-
-const
-{ Default filehandles }
-  UnusedHandle    = -1;
-  StdInputHandle  = 0;
-  StdOutputHandle = 1;
-  StdErrorHandle  = 2;
-
-  FileNameCaseSensitive : boolean = false;
-
-{ Default memory segments (Tp7 compatibility) }
-  seg0040 = $0040;
-  segA000 = $A000;
-  segB000 = $B000;
-  segB800 = $B800;
-
-var
-{ Mem[] support }
-  mem  : array[0..$7fffffff] of byte absolute $0:$0;
-  memw : array[0..$7fffffff] of word absolute $0:$0;
-  meml : array[0..$7fffffff] of longint absolute $0:$0;
-{ C-compatible arguments and environment }
-  argc  : longint;
-  argv  : ppchar;
-  envp  : ppchar;
-  dos_argv0 : pchar;
-
-{$ifndef RTLLITE}
-{ System info }
-  LFNSupport : boolean;
-{$endif RTLLITE}
-
-type
-{ Dos Extender info }
-  p_stub_info = ^t_stub_info;
-  t_stub_info = packed record
-       magic         : array[0..15] of char;
-       size          : longint;
-       minstack      : longint;
-       memory_handle : longint;
-       initial_size  : longint;
-       minkeep       : word;
-       ds_selector   : word;
-       ds_segment    : word;
-       psp_selector  : word;
-       cs_selector   : word;
-       env_size      : word;
-       basename      : array[0..7] of char;
-       argv0         : array [0..15] of char;
-       dpmi_server   : array [0..15] of char;
-  end;
-
-  p_go32_info_block = ^t_go32_info_block;
-  t_go32_info_block = packed record
-       size_of_this_structure_in_bytes    : longint; {offset 0}
-       linear_address_of_primary_screen   : longint; {offset 4}
-       linear_address_of_secondary_screen : longint; {offset 8}
-       linear_address_of_transfer_buffer  : longint; {offset 12}
-       size_of_transfer_buffer            : longint; {offset 16}
-       pid                                : longint; {offset 20}
-       master_interrupt_controller_base   : byte; {offset 24}
-       slave_interrupt_controller_base    : byte; {offset 25}
-       selector_for_linear_memory         : word; {offset 26}
-       linear_address_of_stub_info_structure : longint; {offset 28}
-       linear_address_of_original_psp     : longint; {offset 32}
-       run_mode                           : word; {offset 36}
-       run_mode_info                      : word; {offset 38}
-  end;
-
-var
-  stub_info       : p_stub_info;
-  go32_info_block : t_go32_info_block;
-
-
-{
-  necessary for objects.pas, should be removed (at least from the interface
-  to the implementation)
-}
-  type
-    trealregs=record
-      realedi,realesi,realebp,realres,
-      realebx,realedx,realecx,realeax : longint;
-      realflags,
-      reales,realds,realfs,realgs,
-      realip,realcs,realsp,realss  : word;
-    end;
-  function  do_write(h,addr,len : longint) : longint;
-  function  do_read(h,addr,len : longint) : longint;
-  procedure syscopyfromdos(addr : longint; len : longint);
-  procedure syscopytodos(addr : longint; len : longint);
-  procedure sysrealintr(intnr : word;var regs : trealregs);
-  function  tb : longint;
-
-implementation
-
-{ include system independent routines }
-
-{$I system.inc}
-
-const
-  carryflag = 1;
-
-type
-  tseginfo=packed record
-    offset  : pointer;
-    segment : word;
-  end;
-
-var
-  doscmd    : string[128];  { Dos commandline copied from PSP, max is 128 chars }
-  old_int00 : tseginfo;cvar;
-  old_int75 : tseginfo;cvar;
-
-{$asmmode ATT}
-
-{*****************************************************************************
-                              Go32 Helpers
-*****************************************************************************}
-
-function far_strlen(selector : word;linear_address : longint) : longint;
-begin
-asm
-        movl linear_address,%edx
-        movl %edx,%ecx
-        movw selector,%gs
-.Larg19:
-        movb %gs:(%edx),%al
-        testb %al,%al
-        je .Larg20
-        incl %edx
-        jmp .Larg19
-.Larg20:
-        movl %edx,%eax
-        subl %ecx,%eax
-        movl %eax,__RESULT
-end;
-end;
-
-
-function tb : longint;
-begin
-  tb:=go32_info_block.linear_address_of_transfer_buffer;
-end;
-
-
-function tb_segment : longint;
-begin
-  tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
-end;
-
-
-function tb_offset : longint;
-begin
-  tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
-end;
-
-
-function tb_size : longint;
-begin
-  tb_size:=go32_info_block.size_of_transfer_buffer;
-end;
-
-
-function dos_selector : word;
-begin
-  dos_selector:=go32_info_block.selector_for_linear_memory;
-end;
-
-
-function get_ds : word;assembler;
-asm
-        movw    %ds,%ax
-end;
-
-
-function get_cs : word;assembler;
-asm
-        movw    %cs,%ax
-end;
-
-
-procedure sysseg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
-begin
-   if count=0 then
-     exit;
-   if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
-     asm
-        pushw %es
-        pushw %ds
-        cld
-        movl count,%ecx
-        movl source,%esi
-        movl dest,%edi
-        movw dseg,%ax
-        movw %ax,%es
-        movw sseg,%ax
-        movw %ax,%ds
-        movl %ecx,%eax
-        shrl $2,%ecx
-        rep
-        movsl
-        movl %eax,%ecx
-        andl $3,%ecx
-        rep
-        movsb
-        popw %ds
-        popw %es
-     end ['ESI','EDI','ECX','EAX']
-   else if (source<dest) then
-     { copy backward for overlapping }
-     asm
-        pushw %es
-        pushw %ds
-        std
-        movl count,%ecx
-        movl source,%esi
-        movl dest,%edi
-        movw dseg,%ax
-        movw %ax,%es
-        movw sseg,%ax
-        movw %ax,%ds
-        addl %ecx,%esi
-        addl %ecx,%edi
-        movl %ecx,%eax
-        andl $3,%ecx
-        orl %ecx,%ecx
-        jz .LSEG_MOVE1
-
-        { calculate esi and edi}
-        decl %esi
-        decl %edi
-        rep
-        movsb
-        incl %esi
-        incl %edi
-     .LSEG_MOVE1:
-        subl $4,%esi
-        subl $4,%edi
-        movl %eax,%ecx
-        shrl $2,%ecx
-        rep
-        movsl
-        cld
-        popw %ds
-        popw %es
-     end ['ESI','EDI','ECX'];
-end;
-
-
-function atohex(s : pchar) : longint;
-var
-  rv : longint;
-  v  : byte;
-begin
-  rv:=0;
-  while (s^ <>#0) do
-   begin
-     v:=byte(s^)-byte('0');
-     if (v > 9) then
-       dec(v,7);
-     v:=v and 15; { in case it's lower case }
-     rv:=(rv shl 4) or v;
-     inc(longint(s));
-   end;
-  atohex:=rv;
-end;
-
-var
-  _args : ppchar;external name '_args';
-
-procedure setup_arguments;
-type  arrayword = array [0..0] of word;
-var psp : word;
-    i,j : byte;
-    quote : char;
-    proxy_s : string[7];
-    al,proxy_argc,proxy_seg,proxy_ofs,lin : longint;
-    largs : array[0..127] of pchar;
-    rm_argv : ^arrayword;
-begin
-for i := 1 to 127  do
-   largs[i] := nil;
-psp:=stub_info^.psp_selector;
-largs[0]:=dos_argv0;
-argc := 1;
-sysseg_move(psp, 128, get_ds, longint(@doscmd), 128);
-{$IfDef SYSTEM_DEBUG_STARTUP}
-Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
-{$EndIf }
-
-// setup cmdline variable
-sysgetmem(cmdline,length(doscmd)+1);
-move(doscmd[1],cmdline^,length(doscmd));
-cmdline[length(doscmd)]:=#0;
-
-j := 1;
-quote := #0;
-for i:=1 to length(doscmd) do
-  Begin
-  if doscmd[i] = quote then
-    begin
-    quote := #0;
-    if (i>1) and ((doscmd[i-1]='''') or (doscmd[i-1]='"')) then
-      begin
-      j := i+1;
-      doscmd[i] := #0;
-      continue;
-      end;
-    doscmd[i] := #0;
-    largs[argc]:=@doscmd[j];
-    inc(argc);
-    j := i+1;
-    end else
-  if (quote = #0) and ((doscmd[i] = '''') or (doscmd[i]='"')) then
-    begin
-    quote := doscmd[i];
-    j := i + 1;
-    end else
-  if (quote = #0) and ((doscmd[i] = ' ')
-    or (doscmd[i] = #9) or (doscmd[i] = #10) or
-    (doscmd[i] = #12) or (doscmd[i] = #9)) then
-    begin
-    doscmd[i]:=#0;
-    if j<i then
-      begin
-      largs[argc]:=@doscmd[j];
-      inc(argc);
-      j := i+1;
-      end else inc(j);
-    end else
-  if (i = length(doscmd)) then
-    begin
-    doscmd[i+1]:=#0;
-    largs[argc]:=@doscmd[j];
-    inc(argc);
-    end;
-  end;
-
-if (argc > 1) and (far_strlen(get_ds,longint(largs[1])) = 6)  then
-  begin
-  move(largs[1]^,proxy_s[1],6);
-  proxy_s[0] := #6;
-  if (proxy_s = '!proxy') then
-    begin
-{$IfDef SYSTEM_DEBUG_STARTUP}
-    Writeln(stderr,'proxy command line ');
-{$EndIf SYSTEM_DEBUG_STARTUP}
-    proxy_argc := atohex(largs[2]);
-    proxy_seg  := atohex(largs[3]);
-    proxy_ofs := atohex(largs[4]);
-    sysgetmem(rm_argv,proxy_argc*sizeof(word));
-    sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
-    for i:=0 to proxy_argc - 1 do
-      begin
-      lin := proxy_seg*16 + rm_argv^[i];
-      al :=far_strlen(dos_selector, lin);
-      sysgetmem(largs[i],al+1);
-      sysseg_move(dos_selector, lin, get_ds,longint(largs[i]), al+1);
-{$IfDef SYSTEM_DEBUG_STARTUP}
-      Writeln(stderr,'arg ',i,' #',largs[i],'#');
-{$EndIf SYSTEM_DEBUG_STARTUP}
-      end;
-    argc := proxy_argc;
-    end;
-  end;
-sysgetmem(argv,argc shl 2);
-for i := 0 to argc-1  do
-   argv[i] := largs[i];
-  _args:=argv;
-end;
-
-
-function strcopy(dest,source : pchar) : pchar;
-begin
-  asm
-        cld
-        movl 12(%ebp),%edi
-        movl $0xffffffff,%ecx
-        xorb %al,%al
-        repne
-        scasb
-        not %ecx
-        movl 8(%ebp),%edi
-        movl 12(%ebp),%esi
-        movl %ecx,%eax
-        shrl $2,%ecx
-        rep
-        movsl
-        movl %eax,%ecx
-        andl $3,%ecx
-        rep
-        movsb
-        movl 8(%ebp),%eax
-        leave
-        ret $8
-  end;
-end;
-
-
-var
-  __stubinfo : p_stub_info;external name '__stubinfo';
-  ___dos_argv0 : pchar;external name '___dos_argv0';
-
-procedure setup_environment;
-var env_selector : word;
-    env_count : longint;
-    dos_env,cp : pchar;
-begin
-   stub_info:=__stubinfo;
-   sysgetmem(dos_env,stub_info^.env_size);
-   env_count:=0;
-   sysseg_move(stub_info^.psp_selector,$2c, get_ds, longint(@env_selector), 2);
-   sysseg_move(env_selector, 0, get_ds, longint(dos_env), stub_info^.env_size);
-  cp:=dos_env;
-  while cp ^ <> #0 do
-    begin
-    inc(env_count);
-    while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
-    inc(longint(cp)); { skip to next character }
-    end;
-  sysgetmem(envp,(env_count+1) * sizeof(pchar));
-  if (envp = nil) then exit;
-  cp:=dos_env;
-  env_count:=0;
-  while cp^ <> #0 do
-   begin
-     sysgetmem(envp[env_count],strlen(cp)+1);
-     strcopy(envp[env_count], cp);
-{$IfDef SYSTEM_DEBUG_STARTUP}
-     Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
-{$EndIf SYSTEM_DEBUG_STARTUP}
-     inc(env_count);
-     while (cp^ <> #0) do
-      inc(longint(cp)); { skip to NUL }
-     inc(longint(cp)); { skip to next character }
-   end;
-  envp[env_count]:=nil;
-  longint(cp):=longint(cp)+3;
-  sysgetmem(dos_argv0,strlen(cp)+1);
-  if (dos_argv0 = nil) then halt;
-  strcopy(dos_argv0, cp);
-  { update ___dos_argv0 also }
-  ___dos_argv0:=dos_argv0
-end;
-
-
-procedure syscopytodos(addr : longint; len : longint);
-begin
-   if len > tb_size then
-     HandleError(217);
-   sysseg_move(get_ds,addr,dos_selector,tb,len);
-end;
-
-
-procedure syscopyfromdos(addr : longint; len : longint);
-begin
-   if len > tb_size then
-     HandleError(217);
-   sysseg_move(dos_selector,tb,get_ds,addr,len);
-end;
-
-
-procedure sysrealintr(intnr : word;var regs : trealregs);
-begin
-   regs.realsp:=0;
-   regs.realss:=0;
-   asm
-      movw  intnr,%bx
-      xorl  %ecx,%ecx
-      movl  regs,%edi
-      movw  $0x300,%ax
-      int   $0x31
-   end;
-end;
-
-
-procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo);
-begin
-  asm
-        movl intaddr,%eax
-        movl (%eax),%edx
-        movw 4(%eax),%cx
-        movl $0x205,%eax
-        movb vector,%bl
-        int $0x31
-  end;
-end;
-
-
-procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo);
-begin
-  asm
-        movb    vector,%bl
-        movl    $0x204,%eax
-        int     $0x31
-        movl    intaddr,%eax
-        movl    %edx,(%eax)
-        movw    %cx,4(%eax)
-  end;
-end;
-
-
-
-   { 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}
-
-{*****************************************************************************
-                         System Dependent Exit code
-*****************************************************************************}
-
-procedure ___exit(exitcode:byte);cdecl;external name '___exit';
-
-procedure do_close(handle : longint);forward;
-
-Procedure system_exit;
-var
-  h : byte;
-begin
-  for h:=0 to max_files-1 do
-    if openfiles[h] then
-      begin
-{$ifdef SYSTEMDEBUG}
-         writeln(stderr,'file ',opennames[h],' not closed at exit');
-{$endif SYSTEMDEBUG}
-         if h>=5 then
-           do_close(h);
-      end;
-  { halt is not allways called !! }
-  { not on normal exit !! PM }
-  set_pm_interrupt($00,old_int00);
-  set_pm_interrupt($75,old_int75);
-  ___exit(exitcode);
-end;
-
-
-procedure halt(errnum : byte);
-begin
-  exitcode:=errnum;
-  do_exit;
-  { do_exit should call system_exit but this does not hurt }
-  System_exit;
-end;
-
-procedure new_int00;
-begin
-  HandleError(200);
-end;
-
-procedure new_int75;
-begin
-  asm
-        xorl    %eax,%eax
-        outb    %al,$0x0f0
-        movb    $0x20,%al
-        outb    %al,$0x0a0
-        outb    %al,$0x020
-  end;
-  HandleError(200);
-end;
-
-
-var
-  __stkbottom : longint;external name '__stkbottom';
-
-procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
-{
-  called when trying to get local stack if the compiler directive $S
-  is set this function must preserve esi !!!! because esi is set by
-  the calling proc for methods it must preserve all registers !!
-
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
-}
-begin
-  asm
-        pushl   %eax
-        pushl   %ebx
-        movl    stack_size,%ebx
-        addl    $2048,%ebx
-        movl    %esp,%eax
-        subl    %ebx,%eax
-{$ifdef SYSTEMDEBUG}
-        movl    loweststack,%ebx
-        cmpl    %eax,%ebx
-        jb      .L_is_not_lowest
-        movl    %eax,loweststack
-.L_is_not_lowest:
-{$endif SYSTEMDEBUG}
-        movl    __stkbottom,%ebx
-        cmpl    %eax,%ebx
-        jae     .L__short_on_stack
-        popl    %ebx
-        popl    %eax
-        leave
-        ret     $4
-.L__short_on_stack:
-        { can be usefull for error recovery !! }
-        popl    %ebx
-        popl    %eax
-  end['EAX','EBX'];
-  HandleError(202);
-end;
-
-
-{*****************************************************************************
-                              ParamStr/Randomize
-*****************************************************************************}
-
-function paramcount : longint;
-begin
-  paramcount := argc - 1;
-end;
-
-
-function paramstr(l : longint) : string;
-begin
-  if (l>=0) and (l+1<=argc) then
-   paramstr:=strpas(argv[l])
-  else
-   paramstr:='';
-end;
-
-
-procedure randomize;
-var
-  hl   : longint;
-  regs : trealregs;
-begin
-  regs.realeax:=$2c00;
-  sysrealintr($21,regs);
-  hl:=regs.realedx and $ffff;
-  randseed:=hl*$10000+ (regs.realecx and $ffff);
-end;
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-
-var
-  int_heap : longint;external name 'HEAP';
-  int_heapsize : longint;external name 'HEAPSIZE';
-
-function getheapstart:pointer;
-begin
-  getheapstart:=@int_heap;
-end;
-
-
-function getheapsize:longint;
-begin
-  getheapsize:=int_heapsize;
-end;
-
-
-function ___sbrk(size:longint):longint;cdecl;external name '___sbrk';
-
-function Sbrk(size : longint):longint;assembler;
-asm
-        movl    size,%eax
-        pushl   %eax
-        call    ___sbrk
-        addl    $4,%esp
-end;
-
-
-{ include standard heap management }
-{$I heap.inc}
-
-
-{****************************************************************************
-                        Low level File Routines
- ****************************************************************************}
-
-procedure AllowSlash(p:pchar);
-var
-  i : longint;
-begin
-{ allow slash as backslash }
-  for i:=0 to strlen(p) do
-   if p[i]='/' then p[i]:='\';
-end;
-
-procedure do_close(handle : longint);
-var
-  regs : trealregs;
-begin
-  regs.realebx:=handle;
-{$ifdef SYSTEMDEBUG}
-  if handle<max_files then
-    begin
-       openfiles[handle]:=false;
-       if assigned(opennames[handle]) and free_closed_names then
-         begin
-            sysfreemem(opennames[handle],strlen(opennames[handle])+1);
-            opennames[handle]:=nil;
-         end;
-    end;
-{$endif SYSTEMDEBUG}
-  regs.realeax:=$3e00;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-procedure do_erase(p : pchar);
-var
-  regs : trealregs;
-begin
-  AllowSlash(p);
-  syscopytodos(longint(p),strlen(p)+1);
-  regs.realedx:=tb_offset;
-  regs.realds:=tb_segment;
-{$ifndef RTLLITE}
-  if LFNSupport then
-   regs.realeax:=$7141
-  else
-{$endif RTLLITE}
-   regs.realeax:=$4100;
-  regs.realesi:=0;
-  regs.realecx:=0;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-procedure do_rename(p1,p2 : pchar);
-var
-  regs : trealregs;
-begin
-  AllowSlash(p1);
-  AllowSlash(p2);
-  if strlen(p1)+strlen(p2)+3>tb_size then
-   HandleError(217);
-  sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
-  sysseg_move(get_ds,longint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
-  regs.realedi:=tb_offset;
-  regs.realedx:=tb_offset + strlen(p2)+2;
-  regs.realds:=tb_segment;
-  regs.reales:=tb_segment;
-{$ifndef RTLLITE}
-  if LFNSupport then
-   regs.realeax:=$7156
-  else
-{$endif RTLLITE}
-   regs.realeax:=$5600;
-  regs.realecx:=$ff;            { attribute problem here ! }
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-function do_write(h,addr,len : longint) : longint;
-var
-  regs      : trealregs;
-  size,
-  writesize : longint;
-begin
-  writesize:=0;
-  while len > 0 do
-   begin
-     if len>tb_size then
-      size:=tb_size
-     else
-      size:=len;
-     syscopytodos(addr+writesize,size);
-     regs.realecx:=size;
-     regs.realedx:=tb_offset;
-     regs.realds:=tb_segment;
-     regs.realebx:=h;
-     regs.realeax:=$4000;
-     sysrealintr($21,regs);
-     if (regs.realflags and carryflag) <> 0 then
-      begin
-        InOutRes:=lo(regs.realeax);
-        exit(writesize);
-      end;
-     inc(writesize,regs.realeax);
-     dec(len,regs.realeax);
-     { stop when not the specified size is written }
-     if regs.realeax<size then
-      break;
-   end;
-  Do_Write:=WriteSize;
-end;
-
-
-function do_read(h,addr,len : longint) : longint;
-var
-  regs     : trealregs;
-  size,
-  readsize : longint;
-begin
-  readsize:=0;
-  while len > 0 do
-   begin
-     if len>tb_size then
-      size:=tb_size
-     else
-      size:=len;
-     regs.realecx:=size;
-     regs.realedx:=tb_offset;
-     regs.realds:=tb_segment;
-     regs.realebx:=h;
-     regs.realeax:=$3f00;
-     sysrealintr($21,regs);
-     if (regs.realflags and carryflag) <> 0 then
-      begin
-        InOutRes:=lo(regs.realeax);
-        do_read:=0;
-        exit;
-      end;
-     syscopyfromdos(addr+readsize,regs.realeax);
-     inc(readsize,regs.realeax);
-     dec(len,regs.realeax);
-     { stop when not the specified size is read }
-     if regs.realeax<size then
-      break;
-   end;
-  do_read:=readsize;
-end;
-
-
-function do_filepos(handle : longint) : longint;
-var
-  regs : trealregs;
-begin
-  regs.realebx:=handle;
-  regs.realecx:=0;
-  regs.realedx:=0;
-  regs.realeax:=$4201;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   Begin
-     InOutRes:=lo(regs.realeax);
-     do_filepos:=0;
-   end
-  else
-   do_filepos:=lo(regs.realedx) shl 16+lo(regs.realeax);
-end;
-
-
-procedure do_seek(handle,pos : longint);
-var
-  regs : trealregs;
-begin
-  regs.realebx:=handle;
-  regs.realecx:=pos shr 16;
-  regs.realedx:=pos and $ffff;
-  regs.realeax:=$4200;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-
-function do_seekend(handle:longint):longint;
-var
-  regs : trealregs;
-begin
-  regs.realebx:=handle;
-  regs.realecx:=0;
-  regs.realedx:=0;
-  regs.realeax:=$4202;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   Begin
-     InOutRes:=lo(regs.realeax);
-     do_seekend:=0;
-   end
-  else
-   do_seekend:=lo(regs.realedx) shl 16+lo(regs.realeax);
-end;
-
-
-function do_filesize(handle : longint) : longint;
-var
-  aktfilepos : longint;
-begin
-  aktfilepos:=do_filepos(handle);
-  do_filesize:=do_seekend(handle);
-  do_seek(handle,aktfilepos);
-end;
-
-
-{ truncate at a given position }
-procedure do_truncate (handle,pos:longint);
-var
-  regs : trealregs;
-begin
-  do_seek(handle,pos);
-  regs.realecx:=0;
-  regs.realedx:=tb_offset;
-  regs.realds:=tb_segment;
-  regs.realebx:=handle;
-  regs.realeax:=$4000;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(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
-  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   : trealregs;
-  action : longint;
-begin
-  AllowSlash(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
-   begin
-     filerec(f).mode:=fmoutput;
-     action:=$12; {create file function}
-   end;
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case filerec(f).mode of
-       fminput : filerec(f).handle:=StdInputHandle;
-      fmappend,
-      fmoutput : begin
-                   filerec(f).handle:=StdOutputHandle;
-                   filerec(f).mode:=fmoutput; {fool fmappend}
-                 end;
-     end;
-     exit;
-   end;
-{ real dos call }
-  syscopytodos(longint(p),strlen(p)+1);
-{$ifndef RTLLITE}
-  if LFNSupport then
-   regs.realeax:=$716c
-  else
-{$endif RTLLITE}
-   regs.realeax:=$6c00;
-  regs.realedx:=action;
-  regs.realds:=tb_segment;
-  regs.realesi:=tb_offset;
-  regs.realebx:=$2000+(flags and $ff);
-  regs.realecx:=$20;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   begin
-     InOutRes:=lo(regs.realeax);
-     exit;
-   end
-  else
-   filerec(f).handle:=regs.realeax;
-{$ifdef SYSTEMDEBUG}
-  if regs.realeax<max_files then
-    begin
-       if openfiles[regs.realeax] and
-          assigned(opennames[regs.realeax]) then
-         begin
-            Writeln(stderr,'file ',opennames[regs.realeax],'(',regs.realeax,') not closed but handle reused!');
-            sysfreemem(opennames[regs.realeax],strlen(opennames[regs.realeax])+1);
-         end;
-       openfiles[regs.realeax]:=true;
-       sysgetmem(opennames[regs.realeax],strlen(p)+1);
-       move(p^,opennames[regs.realeax]^,strlen(p)+1);
-    end;
-{$endif SYSTEMDEBUG}
-{ append mode }
-  if (flags and $100)<>0 then
-   begin
-     do_seekend(filerec(f).handle);
-     filerec(f).mode:=fmoutput; {fool fmappend}
-   end;
-end;
-
-
-function do_isdevice(handle:longint):boolean;
-var
-  regs : trealregs;
-begin
-  regs.realebx:=handle;
-  regs.realeax:=$4400;
-  sysrealintr($21,regs);
-  do_isdevice:=(regs.realedx and $80)<>0;
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{$DEFINE EOF_CTRLZ}
-
-{$i text.inc}
-
-
-{*****************************************************************************
-                           Generic Handling
-*****************************************************************************}
-
-{$ifdef TEST_GENERIC}
-{$i generic.inc}
-{$endif TEST_GENERIC}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-procedure DosDir(func:byte;const s:string);
-var
-  buffer : array[0..255] of char;
-  regs   : trealregs;
-begin
-  move(s[1],buffer,length(s));
-  buffer[length(s)]:=#0;
-  AllowSlash(pchar(@buffer));
-  syscopytodos(longint(@buffer),length(s)+1);
-  regs.realedx:=tb_offset;
-  regs.realds:=tb_segment;
-{$ifndef RTLLITE}
-  if LFNSupport then
-   regs.realeax:=$7100+func
-  else
-{$endif RTLLITE}
-   regs.realeax:=func shl 8;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   InOutRes:=lo(regs.realeax);
-end;
-
-
-procedure mkdir(const s : string);[IOCheck];
-begin
-  If InOutRes <> 0 then
-   exit;
-  DosDir($39,s);
-end;
-
-
-procedure rmdir(const s : string);[IOCheck];
-begin
-  If InOutRes <> 0 then
-   exit;
-  DosDir($3a,s);
-end;
-
-
-procedure chdir(const s : string);[IOCheck];
-var
-  regs : trealregs;
-begin
-  If InOutRes <> 0 then
-   exit;
-{ First handle Drive changes }
-  if (length(s)>=2) and (s[2]=':') then
-   begin
-     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
-     regs.realeax:=$0e00;
-     sysrealintr($21,regs);
-     regs.realeax:=$1900;
-     sysrealintr($21,regs);
-     if byte(regs.realeax)<>byte(regs.realedx) then
-      begin
-        Inoutres:=15;
-        exit;
-      end;
-   end;
-{ do the normal dos chdir }
-  DosDir($3b,s);
-end;
-
-
-procedure getdir(drivenr : byte;var dir : shortstring);
-var
-  temp : array[0..255] of char;
-  i    : longint;
-  regs : trealregs;
-begin
-  regs.realedx:=drivenr;
-  regs.realesi:=tb_offset;
-  regs.realds:=tb_segment;
-{$ifndef RTLLITE}
-  if LFNSupport then
-   regs.realeax:=$7147
-  else
-{$endif RTLLITE}
-   regs.realeax:=$4700;
-  sysrealintr($21,regs);
-  if (regs.realflags and carryflag) <> 0 then
-   Begin
-     InOutRes:=lo(regs.realeax);
-     exit;
-   end
-  else
-   syscopyfromdos(longint(@temp),251);
-{ conversion to Pascal string including slash conversion }
-  i:=0;
-  while (temp[i]<>#0) do
-   begin
-     if temp[i]='/' then
-      temp[i]:='\';
-     dir[i+4]:=temp[i];
-     inc(i);
-   end;
-  dir[2]:=':';
-  dir[3]:='\';
-  dir[0]:=char(i+3);
-{ upcase the string }
-  if not FileNameCaseSensitive then
-   dir:=upcase(dir);
-  if drivenr<>0 then   { Drive was supplied. We know it }
-   dir[1]:=char(65+drivenr-1)
-  else
-   begin
-   { We need to get the current drive from DOS function 19H  }
-   { because the drive was the default, which can be unknown }
-     regs.realeax:=$1900;
-     sysrealintr($21,regs);
-     i:= (regs.realeax and $ff) + ord('A');
-     dir[1]:=chr(i);
-   end;
-end;
-
-
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
-
-{$ifndef RTLLITE}
-function CheckLFN:boolean;
-var
-  regs     : TRealRegs;
-  RootName : pchar;
-begin
-{ Check LFN API on drive c:\ }
-  RootName:='C:\';
-  syscopytodos(longint(RootName),strlen(RootName)+1);
-{ Call 'Get Volume Information' ($71A0) }
-  regs.realeax:=$71a0;
-  regs.reales:=tb_segment;
-  regs.realedi:=tb_offset;
-  regs.realecx:=32;
-  regs.realds:=tb_segment;
-  regs.realedx:=tb_offset;
-  regs.realflags:=carryflag;
-  sysrealintr($21,regs);
-{ If carryflag=0 and LFN API bit in ebx is set then use Long file names }
-  CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
-end;
-{$endif RTLLITE}
-
-{$ifdef MT}
-{$I thread.inc}
-{$endif MT}
-
-var
-  temp_int : tseginfo;
-Begin
-{ save old int 0 and 75 }
-  get_pm_interrupt($00,old_int00);
-  get_pm_interrupt($75,old_int75);
-  temp_int.segment:=get_cs;
-  temp_int.offset:=@new_int00;
-  set_pm_interrupt($00,temp_int);
-{  temp_int.offset:=@new_int75;
-  set_pm_interrupt($75,temp_int); }
-{ to test stack depth }
-  loweststack:=maxlongint;
-{ Setup heap }
-  InitHeap;
-{$ifdef MT}
-  { before this, you can't use thread vars !!!! }
-  { threadvarblocksize is calculate before the initialization }
-  { of the system unit                                        }
-  sysgetmem(mainprogramthreadblock,threadvarblocksize);
-{$endif MT}
-  InitExceptions;
-{ Setup stdin, stdout and stderr }
-  OpenStdIO(Input,fmInput,StdInputHandle);
-  OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-{ Setup environment and arguments }
-  Setup_Environment;
-  Setup_Arguments;
-{ Use LFNSupport LFN }
-  LFNSupport:=CheckLFN;
-  if LFNSupport then
-   FileNameCaseSensitive:=true;
-{ Reset IO Error }
-  InOutRes:=0;
-End.
-{
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,97 by the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit system;
+
+interface
+
+{ two debug conditionnals can be used
+  - SYSTEMDEBUG
+    -for STACK checks
+    -for non closed files at exit (or at any time with GDB)
+  - SYSTEM_DEBUG_STARTUP
+    specifically for
+    - proxy command line (DJGPP feature)
+    - list of args
+    - list of env variables  (PM) }
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+{ include heap support headers }
+
+{$I heaph.inc}
+
+const
+{ Default filehandles }
+  UnusedHandle    = -1;
+  StdInputHandle  = 0;
+  StdOutputHandle = 1;
+  StdErrorHandle  = 2;
+
+  FileNameCaseSensitive : boolean = false;
+
+{ Default memory segments (Tp7 compatibility) }
+  seg0040 = $0040;
+  segA000 = $A000;
+  segB000 = $B000;
+  segB800 = $B800;
+
+var
+{ Mem[] support }
+  mem  : array[0..$7fffffff] of byte absolute $0:$0;
+  memw : array[0..$7fffffff] of word absolute $0:$0;
+  meml : array[0..$7fffffff] of longint absolute $0:$0;
+{ C-compatible arguments and environment }
+  argc  : longint;
+  argv  : ppchar;
+  envp  : ppchar;
+  dos_argv0 : pchar;
+
+{$ifndef RTLLITE}
+{ System info }
+  LFNSupport : boolean;
+{$endif RTLLITE}
+
+type
+{ Dos Extender info }
+  p_stub_info = ^t_stub_info;
+  t_stub_info = packed record
+       magic         : array[0..15] of char;
+       size          : longint;
+       minstack      : longint;
+       memory_handle : longint;
+       initial_size  : longint;
+       minkeep       : word;
+       ds_selector   : word;
+       ds_segment    : word;
+       psp_selector  : word;
+       cs_selector   : word;
+       env_size      : word;
+       basename      : array[0..7] of char;
+       argv0         : array [0..15] of char;
+       dpmi_server   : array [0..15] of char;
+  end;
+
+  p_go32_info_block = ^t_go32_info_block;
+  t_go32_info_block = packed record
+       size_of_this_structure_in_bytes    : longint; {offset 0}
+       linear_address_of_primary_screen   : longint; {offset 4}
+       linear_address_of_secondary_screen : longint; {offset 8}
+       linear_address_of_transfer_buffer  : longint; {offset 12}
+       size_of_transfer_buffer            : longint; {offset 16}
+       pid                                : longint; {offset 20}
+       master_interrupt_controller_base   : byte; {offset 24}
+       slave_interrupt_controller_base    : byte; {offset 25}
+       selector_for_linear_memory         : word; {offset 26}
+       linear_address_of_stub_info_structure : longint; {offset 28}
+       linear_address_of_original_psp     : longint; {offset 32}
+       run_mode                           : word; {offset 36}
+       run_mode_info                      : word; {offset 38}
+  end;
+
+var
+  stub_info       : p_stub_info;
+  go32_info_block : t_go32_info_block;
+
+
+{
+  necessary for objects.pas, should be removed (at least from the interface
+  to the implementation)
+}
+  type
+    trealregs=record
+      realedi,realesi,realebp,realres,
+      realebx,realedx,realecx,realeax : longint;
+      realflags,
+      reales,realds,realfs,realgs,
+      realip,realcs,realsp,realss  : word;
+    end;
+  function  do_write(h,addr,len : longint) : longint;
+  function  do_read(h,addr,len : longint) : longint;
+  procedure syscopyfromdos(addr : longint; len : longint);
+  procedure syscopytodos(addr : longint; len : longint);
+  procedure sysrealintr(intnr : word;var regs : trealregs);
+  function  tb : longint;
+
+implementation
+
+{ include system independent routines }
+
+{$I system.inc}
+
+const
+  carryflag = 1;
+
+type
+  tseginfo=packed record
+    offset  : pointer;
+    segment : word;
+  end;
+
+var
+  doscmd    : string[128];  { Dos commandline copied from PSP, max is 128 chars }
+  old_int00 : tseginfo;cvar;
+  old_int75 : tseginfo;cvar;
+
+{$asmmode ATT}
+
+{*****************************************************************************
+                              Go32 Helpers
+*****************************************************************************}
+
+function far_strlen(selector : word;linear_address : longint) : longint;
+begin
+asm
+        movl linear_address,%edx
+        movl %edx,%ecx
+        movw selector,%gs
+.Larg19:
+        movb %gs:(%edx),%al
+        testb %al,%al
+        je .Larg20
+        incl %edx
+        jmp .Larg19
+.Larg20:
+        movl %edx,%eax
+        subl %ecx,%eax
+        movl %eax,__RESULT
+end;
+end;
+
+
+function tb : longint;
+begin
+  tb:=go32_info_block.linear_address_of_transfer_buffer;
+end;
+
+
+function tb_segment : longint;
+begin
+  tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+end;
+
+
+function tb_offset : longint;
+begin
+  tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+end;
+
+
+function tb_size : longint;
+begin
+  tb_size:=go32_info_block.size_of_transfer_buffer;
+end;
+
+
+function dos_selector : word;
+begin
+  dos_selector:=go32_info_block.selector_for_linear_memory;
+end;
+
+
+function get_ds : word;assembler;
+asm
+        movw    %ds,%ax
+end;
+
+
+function get_cs : word;assembler;
+asm
+        movw    %cs,%ax
+end;
+
+
+procedure sysseg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+begin
+   if count=0 then
+     exit;
+   if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+     asm
+        pushw %es
+        pushw %ds
+        cld
+        movl count,%ecx
+        movl source,%esi
+        movl dest,%edi
+        movw dseg,%ax
+        movw %ax,%es
+        movw sseg,%ax
+        movw %ax,%ds
+        movl %ecx,%eax
+        shrl $2,%ecx
+        rep
+        movsl
+        movl %eax,%ecx
+        andl $3,%ecx
+        rep
+        movsb
+        popw %ds
+        popw %es
+     end ['ESI','EDI','ECX','EAX']
+   else if (source<dest) then
+     { copy backward for overlapping }
+     asm
+        pushw %es
+        pushw %ds
+        std
+        movl count,%ecx
+        movl source,%esi
+        movl dest,%edi
+        movw dseg,%ax
+        movw %ax,%es
+        movw sseg,%ax
+        movw %ax,%ds
+        addl %ecx,%esi
+        addl %ecx,%edi
+        movl %ecx,%eax
+        andl $3,%ecx
+        orl %ecx,%ecx
+        jz .LSEG_MOVE1
+
+        { calculate esi and edi}
+        decl %esi
+        decl %edi
+        rep
+        movsb
+        incl %esi
+        incl %edi
+     .LSEG_MOVE1:
+        subl $4,%esi
+        subl $4,%edi
+        movl %eax,%ecx
+        shrl $2,%ecx
+        rep
+        movsl
+        cld
+        popw %ds
+        popw %es
+     end ['ESI','EDI','ECX'];
+end;
+
+
+function atohex(s : pchar) : longint;
+var
+  rv : longint;
+  v  : byte;
+begin
+  rv:=0;
+  while (s^ <>#0) do
+   begin
+     v:=byte(s^)-byte('0');
+     if (v > 9) then
+       dec(v,7);
+     v:=v and 15; { in case it's lower case }
+     rv:=(rv shl 4) or v;
+     inc(longint(s));
+   end;
+  atohex:=rv;
+end;
+
+var
+  _args : ppchar;external name '_args';
+
+procedure setup_arguments;
+type  arrayword = array [0..0] of word;
+var psp : word;
+    i,j : byte;
+    quote : char;
+    proxy_s : string[7];
+    al,proxy_argc,proxy_seg,proxy_ofs,lin : longint;
+    largs : array[0..127] of pchar;
+    rm_argv : ^arrayword;
+begin
+for i := 1 to 127  do
+   largs[i] := nil;
+psp:=stub_info^.psp_selector;
+largs[0]:=dos_argv0;
+argc := 1;
+sysseg_move(psp, 128, get_ds, longint(@doscmd), 128);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
+{$EndIf }
+
+// setup cmdline variable
+sysgetmem(cmdline,length(doscmd)+1);
+move(doscmd[1],cmdline^,length(doscmd));
+cmdline[length(doscmd)]:=#0;
+
+j := 1;
+quote := #0;
+for i:=1 to length(doscmd) do
+  Begin
+  if doscmd[i] = quote then
+    begin
+    quote := #0;
+    if (i>1) and ((doscmd[i-1]='''') or (doscmd[i-1]='"')) then
+      begin
+      j := i+1;
+      doscmd[i] := #0;
+      continue;
+      end;
+    doscmd[i] := #0;
+    largs[argc]:=@doscmd[j];
+    inc(argc);
+    j := i+1;
+    end else
+  if (quote = #0) and ((doscmd[i] = '''') or (doscmd[i]='"')) then
+    begin
+    quote := doscmd[i];
+    j := i + 1;
+    end else
+  if (quote = #0) and ((doscmd[i] = ' ')
+    or (doscmd[i] = #9) or (doscmd[i] = #10) or
+    (doscmd[i] = #12) or (doscmd[i] = #9)) then
+    begin
+    doscmd[i]:=#0;
+    if j<i then
+      begin
+      largs[argc]:=@doscmd[j];
+      inc(argc);
+      j := i+1;
+      end else inc(j);
+    end else
+  if (i = length(doscmd)) then
+    begin
+    doscmd[i+1]:=#0;
+    largs[argc]:=@doscmd[j];
+    inc(argc);
+    end;
+  end;
+
+if (argc > 1) and (far_strlen(get_ds,longint(largs[1])) = 6)  then
+  begin
+  move(largs[1]^,proxy_s[1],6);
+  proxy_s[0] := #6;
+  if (proxy_s = '!proxy') then
+    begin
+{$IfDef SYSTEM_DEBUG_STARTUP}
+    Writeln(stderr,'proxy command line ');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+    proxy_argc := atohex(largs[2]);
+    proxy_seg  := atohex(largs[3]);
+    proxy_ofs := atohex(largs[4]);
+    sysgetmem(rm_argv,proxy_argc*sizeof(word));
+    sysseg_move(dos_selector,proxy_seg*16+proxy_ofs, get_ds,longint(rm_argv),proxy_argc*sizeof(word));
+    for i:=0 to proxy_argc - 1 do
+      begin
+      lin := proxy_seg*16 + rm_argv^[i];
+      al :=far_strlen(dos_selector, lin);
+      sysgetmem(largs[i],al+1);
+      sysseg_move(dos_selector, lin, get_ds,longint(largs[i]), al+1);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+      Writeln(stderr,'arg ',i,' #',largs[i],'#');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+      end;
+    argc := proxy_argc;
+    end;
+  end;
+sysgetmem(argv,argc shl 2);
+for i := 0 to argc-1  do
+   argv[i] := largs[i];
+  _args:=argv;
+end;
+
+
+function strcopy(dest,source : pchar) : pchar;
+begin
+  asm
+        cld
+        movl 12(%ebp),%edi
+        movl $0xffffffff,%ecx
+        xorb %al,%al
+        repne
+        scasb
+        not %ecx
+        movl 8(%ebp),%edi
+        movl 12(%ebp),%esi
+        movl %ecx,%eax
+        shrl $2,%ecx
+        rep
+        movsl
+        movl %eax,%ecx
+        andl $3,%ecx
+        rep
+        movsb
+        movl 8(%ebp),%eax
+        leave
+        ret $8
+  end;
+end;
+
+
+var
+  __stubinfo : p_stub_info;external name '__stubinfo';
+  ___dos_argv0 : pchar;external name '___dos_argv0';
+
+procedure setup_environment;
+var env_selector : word;
+    env_count : longint;
+    dos_env,cp : pchar;
+begin
+   stub_info:=__stubinfo;
+   sysgetmem(dos_env,stub_info^.env_size);
+   env_count:=0;
+   sysseg_move(stub_info^.psp_selector,$2c, get_ds, longint(@env_selector), 2);
+   sysseg_move(env_selector, 0, get_ds, longint(dos_env), stub_info^.env_size);
+  cp:=dos_env;
+  while cp ^ <> #0 do
+    begin
+    inc(env_count);
+    while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
+    inc(longint(cp)); { skip to next character }
+    end;
+  sysgetmem(envp,(env_count+1) * sizeof(pchar));
+  if (envp = nil) then exit;
+  cp:=dos_env;
+  env_count:=0;
+  while cp^ <> #0 do
+   begin
+     sysgetmem(envp[env_count],strlen(cp)+1);
+     strcopy(envp[env_count], cp);
+{$IfDef SYSTEM_DEBUG_STARTUP}
+     Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
+{$EndIf SYSTEM_DEBUG_STARTUP}
+     inc(env_count);
+     while (cp^ <> #0) do
+      inc(longint(cp)); { skip to NUL }
+     inc(longint(cp)); { skip to next character }
+   end;
+  envp[env_count]:=nil;
+  longint(cp):=longint(cp)+3;
+  sysgetmem(dos_argv0,strlen(cp)+1);
+  if (dos_argv0 = nil) then halt;
+  strcopy(dos_argv0, cp);
+  { update ___dos_argv0 also }
+  ___dos_argv0:=dos_argv0
+end;
+
+
+procedure syscopytodos(addr : longint; len : longint);
+begin
+   if len > tb_size then
+     HandleError(217);
+   sysseg_move(get_ds,addr,dos_selector,tb,len);
+end;
+
+
+procedure syscopyfromdos(addr : longint; len : longint);
+begin
+   if len > tb_size then
+     HandleError(217);
+   sysseg_move(dos_selector,tb,get_ds,addr,len);
+end;
+
+
+procedure sysrealintr(intnr : word;var regs : trealregs);
+begin
+   regs.realsp:=0;
+   regs.realss:=0;
+   asm
+      movw  intnr,%bx
+      xorl  %ecx,%ecx
+      movl  regs,%edi
+      movw  $0x300,%ax
+      int   $0x31
+   end;
+end;
+
+
+procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo);
+begin
+  asm
+        movl intaddr,%eax
+        movl (%eax),%edx
+        movw 4(%eax),%cx
+        movl $0x205,%eax
+        movb vector,%bl
+        int $0x31
+  end;
+end;
+
+
+procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo);
+begin
+  asm
+        movb    vector,%bl
+        movl    $0x204,%eax
+        int     $0x31
+        movl    intaddr,%eax
+        movl    %edx,(%eax)
+        movw    %cx,4(%eax)
+  end;
+end;
+
+
+procedure getinoutres;
+var
+  regs : trealregs;
+begin
+  regs.realeax:=$5900;
+  regs.realebx:=$0;
+  sysrealintr($21,regs);
+  InOutRes:=lo(regs.realeax);
+  case InOutRes of
+   19 : InOutRes:=150;
+   21 : InOutRes:=152;
+  end;
+end;
+
+
+   { 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}
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+
+procedure ___exit(exitcode:byte);cdecl;external name '___exit';
+
+procedure do_close(handle : longint);forward;
+
+Procedure system_exit;
+var
+  h : byte;
+begin
+  for h:=0 to max_files-1 do
+    if openfiles[h] then
+      begin
+{$ifdef SYSTEMDEBUG}
+         writeln(stderr,'file ',opennames[h],' not closed at exit');
+{$endif SYSTEMDEBUG}
+         if h>=5 then
+           do_close(h);
+      end;
+  { halt is not allways called !! }
+  { not on normal exit !! PM }
+  set_pm_interrupt($00,old_int00);
+  set_pm_interrupt($75,old_int75);
+  ___exit(exitcode);
+end;
+
+
+procedure halt(errnum : byte);
+begin
+  exitcode:=errnum;
+  do_exit;
+  { do_exit should call system_exit but this does not hurt }
+  System_exit;
+end;
+
+procedure new_int00;
+begin
+  HandleError(200);
+end;
+
+procedure new_int75;
+begin
+  asm
+        xorl    %eax,%eax
+        outb    %al,$0x0f0
+        movb    $0x20,%al
+        outb    %al,$0x0a0
+        outb    %al,$0x020
+  end;
+  HandleError(200);
+end;
+
+
+var
+  __stkbottom : longint;external name '__stkbottom';
+
+procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
+{
+  called when trying to get local stack if the compiler directive $S
+  is set this function must preserve esi !!!! because esi is set by
+  the calling proc for methods it must preserve all registers !!
+
+  With a 2048 byte safe area used to write to StdIo without crossing
+  the stack boundary
+}
+begin
+  asm
+        pushl   %eax
+        pushl   %ebx
+        movl    stack_size,%ebx
+        addl    $2048,%ebx
+        movl    %esp,%eax
+        subl    %ebx,%eax
+{$ifdef SYSTEMDEBUG}
+        movl    loweststack,%ebx
+        cmpl    %eax,%ebx
+        jb      .L_is_not_lowest
+        movl    %eax,loweststack
+.L_is_not_lowest:
+{$endif SYSTEMDEBUG}
+        movl    __stkbottom,%ebx
+        cmpl    %eax,%ebx
+        jae     .L__short_on_stack
+        popl    %ebx
+        popl    %eax
+        leave
+        ret     $4
+.L__short_on_stack:
+        { can be usefull for error recovery !! }
+        popl    %ebx
+        popl    %eax
+  end['EAX','EBX'];
+  HandleError(202);
+end;
+
+
+{*****************************************************************************
+                              ParamStr/Randomize
+*****************************************************************************}
+
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
+
+
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l+1<=argc) then
+   paramstr:=strpas(argv[l])
+  else
+   paramstr:='';
+end;
+
+
+procedure randomize;
+var
+  hl   : longint;
+  regs : trealregs;
+begin
+  regs.realeax:=$2c00;
+  sysrealintr($21,regs);
+  hl:=regs.realedx and $ffff;
+  randseed:=hl*$10000+ (regs.realecx and $ffff);
+end;
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+var
+  int_heap : longint;external name 'HEAP';
+  int_heapsize : longint;external name 'HEAPSIZE';
+
+function getheapstart:pointer;
+begin
+  getheapstart:=@int_heap;
+end;
+
+
+function getheapsize:longint;
+begin
+  getheapsize:=int_heapsize;
+end;
+
+
+function ___sbrk(size:longint):longint;cdecl;external name '___sbrk';
+
+function Sbrk(size : longint):longint;assembler;
+asm
+        movl    size,%eax
+        pushl   %eax
+        call    ___sbrk
+        addl    $4,%esp
+end;
+
+
+{ include standard heap management }
+{$I heap.inc}
+
+
+{****************************************************************************
+                        Low level File Routines
+ ****************************************************************************}
+
+procedure AllowSlash(p:pchar);
+var
+  i : longint;
+begin
+{ allow slash as backslash }
+  for i:=0 to strlen(p) do
+   if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(handle : longint);
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+{$ifdef SYSTEMDEBUG}
+  if handle<max_files then
+    begin
+       openfiles[handle]:=false;
+       if assigned(opennames[handle]) and free_closed_names then
+         begin
+            sysfreemem(opennames[handle],strlen(opennames[handle])+1);
+            opennames[handle]:=nil;
+         end;
+    end;
+{$endif SYSTEMDEBUG}
+  regs.realeax:=$3e00;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+procedure do_erase(p : pchar);
+var
+  regs : trealregs;
+begin
+  AllowSlash(p);
+  syscopytodos(longint(p),strlen(p)+1);
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_segment;
+{$ifndef RTLLITE}
+  if LFNSupport then
+   regs.realeax:=$7141
+  else
+{$endif RTLLITE}
+   regs.realeax:=$4100;
+  regs.realesi:=0;
+  regs.realecx:=0;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+var
+  regs : trealregs;
+begin
+  AllowSlash(p1);
+  AllowSlash(p2);
+  if strlen(p1)+strlen(p2)+3>tb_size then
+   HandleError(217);
+  sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
+  sysseg_move(get_ds,longint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
+  regs.realedi:=tb_offset;
+  regs.realedx:=tb_offset + strlen(p2)+2;
+  regs.realds:=tb_segment;
+  regs.reales:=tb_segment;
+{$ifndef RTLLITE}
+  if LFNSupport then
+   regs.realeax:=$7156
+  else
+{$endif RTLLITE}
+   regs.realeax:=$5600;
+  regs.realecx:=$ff;            { attribute problem here ! }
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+function do_write(h,addr,len : longint) : longint;
+var
+  regs      : trealregs;
+  size,
+  writesize : longint;
+begin
+  writesize:=0;
+  while len > 0 do
+   begin
+     if len>tb_size then
+      size:=tb_size
+     else
+      size:=len;
+     syscopytodos(addr+writesize,size);
+     regs.realecx:=size;
+     regs.realedx:=tb_offset;
+     regs.realds:=tb_segment;
+     regs.realebx:=h;
+     regs.realeax:=$4000;
+     sysrealintr($21,regs);
+     if (regs.realflags and carryflag) <> 0 then
+      begin
+        GetInOutRes;
+        exit(writesize);
+      end;
+     inc(writesize,regs.realeax);
+     dec(len,regs.realeax);
+     { stop when not the specified size is written }
+     if regs.realeax<size then
+      break;
+   end;
+  Do_Write:=WriteSize;
+end;
+
+
+function do_read(h,addr,len : longint) : longint;
+var
+  regs     : trealregs;
+  size,
+  readsize : longint;
+begin
+  readsize:=0;
+  while len > 0 do
+   begin
+     if len>tb_size then
+      size:=tb_size
+     else
+      size:=len;
+     regs.realecx:=size;
+     regs.realedx:=tb_offset;
+     regs.realds:=tb_segment;
+     regs.realebx:=h;
+     regs.realeax:=$3f00;
+     sysrealintr($21,regs);
+     if (regs.realflags and carryflag) <> 0 then
+      begin
+        GetInOutRes;
+        do_read:=0;
+        exit;
+      end;
+     syscopyfromdos(addr+readsize,regs.realeax);
+     inc(readsize,regs.realeax);
+     dec(len,regs.realeax);
+     { stop when not the specified size is read }
+     if regs.realeax<size then
+      break;
+   end;
+  do_read:=readsize;
+end;
+
+
+function do_filepos(handle : longint) : longint;
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+  regs.realecx:=0;
+  regs.realedx:=0;
+  regs.realeax:=$4201;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   Begin
+     GetInOutRes;
+     do_filepos:=0;
+   end
+  else
+   do_filepos:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+procedure do_seek(handle,pos : longint);
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+  regs.realecx:=pos shr 16;
+  regs.realedx:=pos and $ffff;
+  regs.realeax:=$4200;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+
+function do_seekend(handle:longint):longint;
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+  regs.realecx:=0;
+  regs.realedx:=0;
+  regs.realeax:=$4202;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   Begin
+     GetInOutRes;
+     do_seekend:=0;
+   end
+  else
+   do_seekend:=lo(regs.realedx) shl 16+lo(regs.realeax);
+end;
+
+
+function do_filesize(handle : longint) : longint;
+var
+  aktfilepos : longint;
+begin
+  aktfilepos:=do_filepos(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,aktfilepos);
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate (handle,pos:longint);
+var
+  regs : trealregs;
+begin
+  do_seek(handle,pos);
+  regs.realecx:=0;
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_segment;
+  regs.realebx:=handle;
+  regs.realeax:=$4000;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+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   : trealregs;
+  action : longint;
+begin
+  AllowSlash(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
+   begin
+     filerec(f).mode:=fmoutput;
+     action:=$12; {create file function}
+   end;
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case filerec(f).mode of
+       fminput : filerec(f).handle:=StdInputHandle;
+      fmappend,
+      fmoutput : begin
+                   filerec(f).handle:=StdOutputHandle;
+                   filerec(f).mode:=fmoutput; {fool fmappend}
+                 end;
+     end;
+     exit;
+   end;
+{ real dos call }
+  syscopytodos(longint(p),strlen(p)+1);
+{$ifndef RTLLITE}
+  if LFNSupport then
+   regs.realeax:=$716c
+  else
+{$endif RTLLITE}
+   regs.realeax:=$6c00;
+  regs.realedx:=action;
+  regs.realds:=tb_segment;
+  regs.realesi:=tb_offset;
+  regs.realebx:=$2000+(flags and $ff);
+  regs.realecx:=$20;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   begin
+     GetInOutRes;
+     exit;
+   end
+  else
+   filerec(f).handle:=regs.realeax;
+{$ifdef SYSTEMDEBUG}
+  if regs.realeax<max_files then
+    begin
+       if openfiles[regs.realeax] and
+          assigned(opennames[regs.realeax]) then
+         begin
+            Writeln(stderr,'file ',opennames[regs.realeax],'(',regs.realeax,') not closed but handle reused!');
+            sysfreemem(opennames[regs.realeax],strlen(opennames[regs.realeax])+1);
+         end;
+       openfiles[regs.realeax]:=true;
+       sysgetmem(opennames[regs.realeax],strlen(p)+1);
+       move(p^,opennames[regs.realeax]^,strlen(p)+1);
+    end;
+{$endif SYSTEMDEBUG}
+{ append mode }
+  if (flags and $100)<>0 then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
+end;
+
+
+function do_isdevice(handle:longint):boolean;
+var
+  regs : trealregs;
+begin
+  regs.realebx:=handle;
+  regs.realeax:=$4400;
+  sysrealintr($21,regs);
+  do_isdevice:=(regs.realedx and $80)<>0;
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$DEFINE EOF_CTRLZ}
+
+{$i text.inc}
+
+
+{*****************************************************************************
+                           Generic Handling
+*****************************************************************************}
+
+{$ifdef TEST_GENERIC}
+{$i generic.inc}
+{$endif TEST_GENERIC}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+procedure DosDir(func:byte;const s:string);
+var
+  buffer : array[0..255] of char;
+  regs   : trealregs;
+begin
+  move(s[1],buffer,length(s));
+  buffer[length(s)]:=#0;
+  AllowSlash(pchar(@buffer));
+  syscopytodos(longint(@buffer),length(s)+1);
+  regs.realedx:=tb_offset;
+  regs.realds:=tb_segment;
+{$ifndef RTLLITE}
+  if LFNSupport then
+   regs.realeax:=$7100+func
+  else
+{$endif RTLLITE}
+   regs.realeax:=func shl 8;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   GetInOutRes;
+end;
+
+
+procedure mkdir(const s : string);[IOCheck];
+begin
+  If InOutRes <> 0 then
+   exit;
+  DosDir($39,s);
+end;
+
+
+procedure rmdir(const s : string);[IOCheck];
+begin
+  If InOutRes <> 0 then
+   exit;
+  DosDir($3a,s);
+end;
+
+
+procedure chdir(const s : string);[IOCheck];
+var
+  regs : trealregs;
+begin
+  If InOutRes <> 0 then
+   exit;
+{ First handle Drive changes }
+  if (length(s)>=2) and (s[2]=':') then
+   begin
+     regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
+     regs.realeax:=$0e00;
+     sysrealintr($21,regs);
+     regs.realeax:=$1900;
+     sysrealintr($21,regs);
+     if byte(regs.realeax)<>byte(regs.realedx) then
+      begin
+        Inoutres:=15;
+        exit;
+      end;
+   end;
+{ do the normal dos chdir }
+  DosDir($3b,s);
+end;
+
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+  temp : array[0..255] of char;
+  i    : longint;
+  regs : trealregs;
+begin
+  regs.realedx:=drivenr;
+  regs.realesi:=tb_offset;
+  regs.realds:=tb_segment;
+{$ifndef RTLLITE}
+  if LFNSupport then
+   regs.realeax:=$7147
+  else
+{$endif RTLLITE}
+   regs.realeax:=$4700;
+  sysrealintr($21,regs);
+  if (regs.realflags and carryflag) <> 0 then
+   Begin
+     GetInOutRes;
+     exit;
+   end
+  else
+   syscopyfromdos(longint(@temp),251);
+{ conversion to Pascal string including slash conversion }
+  i:=0;
+  while (temp[i]<>#0) do
+   begin
+     if temp[i]='/' then
+      temp[i]:='\';
+     dir[i+4]:=temp[i];
+     inc(i);
+   end;
+  dir[2]:=':';
+  dir[3]:='\';
+  dir[0]:=char(i+3);
+{ upcase the string }
+  if not FileNameCaseSensitive then
+   dir:=upcase(dir);
+  if drivenr<>0 then   { Drive was supplied. We know it }
+   dir[1]:=char(65+drivenr-1)
+  else
+   begin
+   { We need to get the current drive from DOS function 19H  }
+   { because the drive was the default, which can be unknown }
+     regs.realeax:=$1900;
+     sysrealintr($21,regs);
+     i:= (regs.realeax and $ff) + ord('A');
+     dir[1]:=chr(i);
+   end;
+end;
+
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+{$ifndef RTLLITE}
+function CheckLFN:boolean;
+var
+  regs     : TRealRegs;
+  RootName : pchar;
+begin
+{ Check LFN API on drive c:\ }
+  RootName:='C:\';
+  syscopytodos(longint(RootName),strlen(RootName)+1);
+{ Call 'Get Volume Information' ($71A0) }
+  regs.realeax:=$71a0;
+  regs.reales:=tb_segment;
+  regs.realedi:=tb_offset;
+  regs.realecx:=32;
+  regs.realds:=tb_segment;
+  regs.realedx:=tb_offset;
+  regs.realflags:=carryflag;
+  sysrealintr($21,regs);
+{ If carryflag=0 and LFN API bit in ebx is set then use Long file names }
+  CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
+end;
+{$endif RTLLITE}
+
+{$ifdef MT}
+{$I thread.inc}
+{$endif MT}
+
+var
+  temp_int : tseginfo;
+Begin
+{ save old int 0 and 75 }
+  get_pm_interrupt($00,old_int00);
+  get_pm_interrupt($75,old_int75);
+  temp_int.segment:=get_cs;
+  temp_int.offset:=@new_int00;
+  set_pm_interrupt($00,temp_int);
+{  temp_int.offset:=@new_int75;
+  set_pm_interrupt($75,temp_int); }
+{ to test stack depth }
+  loweststack:=maxlongint;
+{ Setup heap }
+  InitHeap;
+{$ifdef MT}
+  { before this, you can't use thread vars !!!! }
+  { threadvarblocksize is calculate before the initialization }
+  { of the system unit                                        }
+  sysgetmem(mainprogramthreadblock,threadvarblocksize);
+{$endif MT}
+  InitExceptions;
+{ Setup stdin, stdout and stderr }
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Setup environment and arguments }
+  Setup_Environment;
+  Setup_Arguments;
+{ Use LFNSupport LFN }
+  LFNSupport:=CheckLFN;
+  if LFNSupport then
+   FileNameCaseSensitive:=true;
+{ Reset IO Error }
+  InOutRes:=0;
+End.
+{
   $Log$
-  Revision 1.17  1999-09-10 15:40:33  peter
-    * fixed do_open flags to be > $100, becuase filemode can be upto 255
-
-  Revision 1.16  1999/09/08 16:09:18  peter
-    * do_isdevice not called if already error
-
-  Revision 1.15  1999/08/19 14:03:16  pierre
-   * use sysgetmem for startup and debug allocations
-
-  Revision 1.14  1999/07/19 07:57:49  michael
-  + Small fix from Michael Baikov in setup_params
-
-  Revision 1.13  1999/05/19 16:54:21  pierre
-   * closes all handles >+ 5
-
-  Revision 1.12  1999/05/17 21:52:33  florian
-    * most of the Object Pascal stuff moved to the system unit
-
-  Revision 1.11  1999/05/04 23:28:40  pierre
-    SYSTEM_DEBUG_STARTUP used to output args and env at start
-
-  Revision 1.10  1999/04/28 11:42:45  peter
-    + FileNameCaseSensetive boolean
-
-  Revision 1.9  1999/04/28 06:01:25  florian
-    * define MT for multithreading introduced
-
-  Revision 1.8  1999/04/08 12:23:02  peter
-    * removed os.inc
-
-  Revision 1.7  1999/03/10 22:15:28  florian
-    + system.cmdline variable for go32v2 and win32 added
-
-  Revision 1.6  1999/03/01 15:40:52  peter
-    * use external names
-    * removed all direct assembler modes
-
-  Revision 1.5  1999/01/18 10:05:50  pierre
-   + system_exit procedure added
-
-  Revision 1.4  1998/12/30 22:17:59  peter
-    * fixed mem decls to use $0:$0
-
-  Revision 1.3  1998/12/28 15:50:45  peter
-    + stdout, which is needed when you write something in the system unit
-      to the screen. Like the runtime error
-
-  Revision 1.2  1998/12/21 14:22:02  pierre
-   * old_int?? transformed to cvar to be readable by dpmiexcp
-
-  Revision 1.1  1998/12/21 13:07:03  peter
-    * use -FE
-
-  Revision 1.25  1998/12/15 22:42:52  peter
-    * removed temp symbols
-
-  Revision 1.24  1998/11/29 22:28:10  peter
-    + io-error 103 added
-
-  Revision 1.23  1998/11/16 14:15:02  pierre
-    * changed getdir(byte,string) to getdir(byte,shortstring)
-
-  Revision 1.22  1998/10/26 14:49:46  pierre
-   * system debug info output to stderr
-
-  Revision 1.21  1998/10/20 07:34:07  pierre
-   + systemdebug reports about unclosed files at exit
-
-  Revision 1.20  1998/10/13 21:41:06  peter
-    + int 0 for divide by zero
-
-  Revision 1.19  1998/09/14 10:48:05  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.18  1998/08/28 10:48:04  peter
-    * fixed chdir with drive changing
-    * updated checklfn from mailinglist
-
-  Revision 1.17  1998/08/27 10:30:51  pierre
-    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
-      I renamed tb_selector to tb_segment because
-        it is a real mode segment as opposed to
-        a protected mode selector
-      Fixed it for go32v1 (remove the $E0000000 offset !)
-
-  Revision 1.16  1998/08/26 10:04:03  peter
-    * new lfn check from mailinglist
-    * renamed win95 -> LFNSupport
-    + tb_selector, tb_offset for easier access to transferbuffer
-
-  Revision 1.15  1998/08/19 10:56:34  pierre
-    + added some special code for C interface
-      to avoid loading of crt1.o or dpmiexcp.o from the libc.a
-
-  Revision 1.14  1998/08/04 14:34:38  pierre
-    * small bug fix to get it compiled with bugfix version !!
-      (again the asmmode problem !!!
-      Peter it was really not the best idea you had !!)
-
-  Revision 1.13  1998/07/30 13:26:22  michael
-  + Added support for ErrorProc variable. All internal functions are required
-    to call HandleError instead of runerror from now on.
-    This is necessary for exception support.
-
-  Revision 1.12  1998/07/13 21:19:08  florian
-    * some problems with ansi string support fixed
-
-  Revision 1.11  1998/07/07 12:33:08  carl
-    * added 2k buffer for stack checking for correct io on error
-
-  Revision 1.10  1998/07/02 12:29:20  carl
-    * IOCheck for rmdir,chdir and mkdir as in TP
-    NOTE: I'm pretty SURE this will not compile and link correctly with FPC
-  0.99.5
-
-  Revision 1.9  1998/07/01 15:29:57  peter
-    * better readln/writeln
-
-  Revision 1.8  1998/06/26 08:19:10  pierre
-    + all debug in ifdef SYSTEMDEBUG
-    + added local arrays :
-      opennames names of opened files
-      fileopen boolean array to know if still open
-      usefull with gdb if you get problems about too
-      many open files !!
-
-  Revision 1.7  1998/06/15 15:17:08  daniel
-  * RTLLITE conditional added to produce smaller RTL.
-
-  Revision 1.6  1998/05/31 14:18:29  peter
-    * force att or direct assembling
-    * cleanup of some files
-
-  Revision 1.5  1998/05/21 19:30:52  peter
-    * objects compiles for linux
-    + assign(pchar), assign(char), rename(pchar), rename(char)
-    * fixed read_text_as_array
-    + read_text_as_pchar which was not yet in the rtl
-
-  Revision 1.4  1998/05/04 17:58:41  peter
-    * fix for smartlinking with _ARGS
-
-  Revision 1.3  1998/05/04 16:21:54  florian
-    + LFNSupport flag to the interface moved
-}
+  Revision 1.18  1999-09-10 17:14:09  peter
+    * better errorcode returning using int21h,5900
+
+  Revision 1.17  1999/09/10 15:40:33  peter
+    * fixed do_open flags to be > $100, becuase filemode can be upto 255
+
+  Revision 1.16  1999/09/08 16:09:18  peter
+    * do_isdevice not called if already error
+
+  Revision 1.15  1999/08/19 14:03:16  pierre
+   * use sysgetmem for startup and debug allocations
+
+  Revision 1.14  1999/07/19 07:57:49  michael
+  + Small fix from Michael Baikov in setup_params
+
+  Revision 1.13  1999/05/19 16:54:21  pierre
+   * closes all handles >+ 5
+
+  Revision 1.12  1999/05/17 21:52:33  florian
+    * most of the Object Pascal stuff moved to the system unit
+
+  Revision 1.11  1999/05/04 23:28:40  pierre
+    SYSTEM_DEBUG_STARTUP used to output args and env at start
+
+  Revision 1.10  1999/04/28 11:42:45  peter
+    + FileNameCaseSensetive boolean
+
+  Revision 1.9  1999/04/28 06:01:25  florian
+    * define MT for multithreading introduced
+
+  Revision 1.8  1999/04/08 12:23:02  peter
+    * removed os.inc
+
+  Revision 1.7  1999/03/10 22:15:28  florian
+    + system.cmdline variable for go32v2 and win32 added
+
+  Revision 1.6  1999/03/01 15:40:52  peter
+    * use external names
+    * removed all direct assembler modes
+
+  Revision 1.5  1999/01/18 10:05:50  pierre
+   + system_exit procedure added
+
+  Revision 1.4  1998/12/30 22:17:59  peter
+    * fixed mem decls to use $0:$0
+
+  Revision 1.3  1998/12/28 15:50:45  peter
+    + stdout, which is needed when you write something in the system unit
+      to the screen. Like the runtime error
+
+  Revision 1.2  1998/12/21 14:22:02  pierre
+   * old_int?? transformed to cvar to be readable by dpmiexcp
+
+  Revision 1.1  1998/12/21 13:07:03  peter
+    * use -FE
+
+  Revision 1.25  1998/12/15 22:42:52  peter
+    * removed temp symbols
+
+  Revision 1.24  1998/11/29 22:28:10  peter
+    + io-error 103 added
+
+  Revision 1.23  1998/11/16 14:15:02  pierre
+    * changed getdir(byte,string) to getdir(byte,shortstring)
+
+  Revision 1.22  1998/10/26 14:49:46  pierre
+   * system debug info output to stderr
+
+  Revision 1.21  1998/10/20 07:34:07  pierre
+   + systemdebug reports about unclosed files at exit
+
+  Revision 1.20  1998/10/13 21:41:06  peter
+    + int 0 for divide by zero
+
+  Revision 1.19  1998/09/14 10:48:05  peter
+    * FPC_ names
+    * Heap manager is now system independent
+
+  Revision 1.18  1998/08/28 10:48:04  peter
+    * fixed chdir with drive changing
+    * updated checklfn from mailinglist
+
+  Revision 1.17  1998/08/27 10:30:51  pierre
+    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
+      I renamed tb_selector to tb_segment because
+        it is a real mode segment as opposed to
+        a protected mode selector
+      Fixed it for go32v1 (remove the $E0000000 offset !)
+
+  Revision 1.16  1998/08/26 10:04:03  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.15  1998/08/19 10:56:34  pierre
+    + added some special code for C interface
+      to avoid loading of crt1.o or dpmiexcp.o from the libc.a
+
+  Revision 1.14  1998/08/04 14:34:38  pierre
+    * small bug fix to get it compiled with bugfix version !!
+      (again the asmmode problem !!!
+      Peter it was really not the best idea you had !!)
+
+  Revision 1.13  1998/07/30 13:26:22  michael
+  + Added support for ErrorProc variable. All internal functions are required
+    to call HandleError instead of runerror from now on.
+    This is necessary for exception support.
+
+  Revision 1.12  1998/07/13 21:19:08  florian
+    * some problems with ansi string support fixed
+
+  Revision 1.11  1998/07/07 12:33:08  carl
+    * added 2k buffer for stack checking for correct io on error
+
+  Revision 1.10  1998/07/02 12:29:20  carl
+    * IOCheck for rmdir,chdir and mkdir as in TP
+    NOTE: I'm pretty SURE this will not compile and link correctly with FPC
+  0.99.5
+
+  Revision 1.9  1998/07/01 15:29:57  peter
+    * better readln/writeln
+
+  Revision 1.8  1998/06/26 08:19:10  pierre
+    + all debug in ifdef SYSTEMDEBUG
+    + added local arrays :
+      opennames names of opened files
+      fileopen boolean array to know if still open
+      usefull with gdb if you get problems about too
+      many open files !!
+
+  Revision 1.7  1998/06/15 15:17:08  daniel
+  * RTLLITE conditional added to produce smaller RTL.
+
+  Revision 1.6  1998/05/31 14:18:29  peter
+    * force att or direct assembling
+    * cleanup of some files
+
+  Revision 1.5  1998/05/21 19:30:52  peter
+    * objects compiles for linux
+    + assign(pchar), assign(char), rename(pchar), rename(char)
+    * fixed read_text_as_array
+    + read_text_as_pchar which was not yet in the rtl
+
+  Revision 1.4  1998/05/04 17:58:41  peter
+    * fix for smartlinking with _ARGS
+
+  Revision 1.3  1998/05/04 16:21:54  florian
+    + LFNSupport flag to the interface moved
+}