* switch to a full blown win16 system unit

git-svn-id: trunk@31530 -

.gitattributes

@@ -9702,6 +9702,13 @@ rtl/win16/prt0l.asm svneol=native#text/plain
 rtl/win16/prt0m.asm svneol=native#text/plain
 rtl/win16/prt0s.asm svneol=native#text/plain
 rtl/win16/prt0t.asm svneol=native#text/plain
+rtl/win16/registers.inc svneol=native#text/plain
+rtl/win16/rtldefs.inc svneol=native#text/plain
+rtl/win16/sysdir.inc svneol=native#text/plain
+rtl/win16/sysfile.inc svneol=native#text/plain
+rtl/win16/sysheap.inc svneol=native#text/plain
+rtl/win16/sysos.inc svneol=native#text/plain
+rtl/win16/sysosh.inc svneol=native#text/plain
 rtl/win16/system.pp svneol=native#text/plain
 rtl/win32/Makefile svneol=native#text/plain
 rtl/win32/Makefile.fpc svneol=native#text/plain

rtl/win16/registers.inc

@@ -0,0 +1,9 @@
+{ Registers record used by Intr and MsDos. This include file is shared between
+  the system unit and the dos unit. }
+
+type
+  Registers = packed record
+    case Integer of
+      0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
+      1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
+  end;

rtl/win16/rtldefs.inc

@@ -0,0 +1,24 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2012 by Free Pascal development team
+
+    This file contains platform-specific defines that are used in
+    multiple RTL units.
+
+    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.
+
+ **********************************************************************}
+
+{ the single byte OS APIs always use UTF-8 }
+{ define FPCRTL_FILESYSTEM_UTF8}
+
+{ The OS supports a single byte file system operations API that we use }
+{$define FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+{ The OS supports a two byte file system operations API that we use }
+{ define FPCRTL_FILESYSTEM_TWO_BYTE_API}

rtl/win16/sysdir.inc

@@ -0,0 +1,139 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit for the Win32 API.
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+procedure DosDir(func:byte;s: rawbytestring);
+var
+  regs   : Registers;
+  len    : Integer;
+begin
+(*  DoDirSeparators(s);
+  { True DOS does not like backslashes at end
+    Win95 DOS accepts this !!
+    but "\" and "c:\" should still be kept and accepted hopefully PM }
+  len:=length(s);
+  if (len>0) and (s[len]='\') and
+     Not ((len=1) or ((len=3) and (s[2]=':'))) then
+    s[len]:=#0;
+  regs.DX:=Ofs(s[1]);
+  regs.DS:=Seg(s[1]);
+  if LFNSupport then
+   regs.AX:=$7100+func
+  else
+   regs.AX:=func shl 8;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);*)
+end;
+
+Procedure do_MkDir(const s: rawbytestring);
+begin
+{   DosDir($39,s);}
+end;
+
+Procedure do_RmDir(const s: rawbytestring);
+begin
+{  if s='.' then
+    begin
+      InOutRes:=16;
+      exit;
+    end;
+  DosDir($3a,s);}
+end;
+
+Procedure do_ChDir(const s: rawbytestring);
+var
+  regs : Registers;
+  len  : Integer;
+begin
+(*  len:=Length(s);
+{ First handle Drive changes }
+  if (len>=2) and (s[2]=':') then
+   begin
+     regs.DX:=(ord(s[1]) and (not 32))-ord('A');
+     regs.AX:=$0e00;
+     MsDos(regs);
+     regs.AX:=$1900;
+     MsDos(regs);
+     if regs.AL<>regs.DL then
+      begin
+        Inoutres:=15;
+        exit;
+      end;
+     { DosDir($3b,'c:') give Path not found error on
+       pure DOS PM }
+     if len=2 then
+       exit;
+   end;
+{ do the normal dos chdir }
+  DosDir($3b,s);*)
+end;
+
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+var
+  temp : array[0..260] of char;
+  i    : integer;
+  regs : Registers;
+begin
+(*  regs.DX:=drivenr;
+  regs.SI:=Ofs(temp);
+  regs.DS:=Seg(temp);
+  if LFNSupport then
+   regs.AX:=$7147
+  else
+   regs.AX:=$4700;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   Begin
+     GetInOutRes (regs.AX);
+     Dir := char (DriveNr + 64) + ':\';
+     SetCodePage (Dir,DefaultFileSystemCodePage,false);
+     exit;
+   end
+  else
+    temp[252] := #0;  { to avoid shortstring buffer overflow }
+{ conversion to Pascal string including slash conversion }
+  i:=0;
+  SetLength(dir,260);
+  while (temp[i]<>#0) do
+   begin
+     if temp[i] in AllowDirectorySeparators then
+       temp[i]:=DirectorySeparator;
+     dir[i+4]:=temp[i];
+     inc(i);
+   end;
+  dir[2]:=':';
+  dir[3]:='\';
+  SetLength(dir,i+3);
+  SetCodePage (dir,DefaultFileSystemCodePage,false);
+{ upcase the string }
+  if not FileNameCasePreserving 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.AX:=$1900;
+     MsDos(regs);
+     i:= (regs.AX and $ff) + ord('A');
+     dir[1]:=chr(i);
+   end;*)
+end;

rtl/win16/sysfile.inc

@@ -0,0 +1,401 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Low leve file functions
+
+    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.
+
+ **********************************************************************}
+
+   { Keep Track of open files }
+{   const
+      max_files = 50;
+   var
+      openfiles : array [0..max_files-1] of boolean;}
+{$ifdef SYSTEMDEBUG}
+{      opennames : array [0..max_files-1] of pchar;
+   const
+      free_closed_names : boolean = true;}
+{$endif SYSTEMDEBUG}
+
+
+{****************************************************************************
+                        Low level File Routines
+ ****************************************************************************}
+
+procedure do_close(handle : thandle);
+var
+  regs : Registers;
+begin
+(*  if Handle<=4 then
+   exit;
+  regs.BX:=handle;
+  if handle<max_files then
+    begin
+       openfiles[handle]:=false;
+{$ifdef SYSTEMDEBUG}
+       if assigned(opennames[handle]) and free_closed_names then
+         begin
+            sysfreememsize(opennames[handle],strlen(opennames[handle])+1);
+            opennames[handle]:=nil;
+         end;
+{$endif SYSTEMDEBUG}
+    end;
+  regs.AX:=$3e00;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);*)
+end;
+
+
+procedure do_erase(p : pchar; pchangeable: boolean);
+var
+  regs : Registers;
+  oldp : pchar;
+begin
+(*  oldp:=p;
+  DoDirSeparators(p,pchangeable);
+  regs.DX:=Ofs(p^);
+  regs.DS:=Seg(p^);
+  if LFNSupport then
+   regs.AX:=$7141
+  else
+   regs.AX:=$4100;
+  regs.SI:=0;
+  regs.CX:=0;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);
+  if p<>oldp then
+    freemem(p);*)
+end;
+
+
+procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
+var
+  regs : Registers;
+  oldp1, oldp2 : pchar;
+begin
+(*  oldp1:=p1;
+  oldp2:=p2;
+  DoDirSeparators(p1,p1changeable);
+  DoDirSeparators(p2,p2changeable);
+  regs.DS:=Seg(p1^);
+  regs.DX:=Ofs(p1^);
+  regs.ES:=Seg(p2^);
+  regs.DI:=Ofs(p2^);
+  if LFNSupport then
+   regs.AX:=$7156
+  else
+   regs.AX:=$5600;
+  regs.CX:=$ff;            { attribute problem here ! }
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);
+  if p1<>oldp1 then
+    freemem(p1);
+  if p2<>oldp2 then
+    freemem(p2);*)
+end;
+
+
+function do_write(h:thandle;addr:pointer;len : longint) : longint;
+var
+  regs: Registers;
+begin
+(*  regs.AH := $40;
+  regs.BX := h;
+  regs.CX := len;
+  regs.DS := Seg(addr^);
+  regs.DX := Ofs(addr^);
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+  begin
+    GetInOutRes(regs.AX);
+    exit(0);
+  end;
+  do_write := regs.AX;*)
+end;
+
+
+function do_read(h:thandle;addr:pointer;len : longint) : longint;
+var
+  regs: Registers;
+begin
+(*  regs.AH := $3F;
+  regs.BX := h;
+  regs.CX := len;
+  regs.DS := Seg(addr^);
+  regs.DX := Ofs(addr^);
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+  begin
+    GetInOutRes(regs.AX);
+    exit(0);
+  end;
+  do_read := regs.AX;*)
+end;
+
+
+function do_filepos(handle : thandle) : longint;
+var
+  regs : Registers;
+begin
+(*  regs.BX:=handle;
+  regs.CX:=0;
+  regs.DX:=0;
+  regs.AX:=$4201;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   Begin
+     GetInOutRes(regs.AX);
+     do_filepos:=0;
+   end
+  else
+   do_filepos:=(longint(regs.DX) shl 16) + regs.AX;*)
+end;
+
+
+procedure do_seek(handle:thandle;pos : longint);
+var
+  regs : Registers;
+begin
+(*  regs.BX:=handle;
+  regs.CX:=pos shr 16;
+  regs.DX:=pos and $ffff;
+  regs.AX:=$4200;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);*)
+end;
+
+
+
+function do_seekend(handle:thandle):longint;
+var
+  regs : Registers;
+begin
+(*  regs.BX:=handle;
+  regs.CX:=0;
+  regs.DX:=0;
+  regs.AX:=$4202;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   Begin
+     GetInOutRes(regs.AX);
+     do_seekend:=0;
+   end
+  else
+   do_seekend:=(longint(regs.DX) shl 16) + regs.AX;*)
+end;
+
+
+function do_filesize(handle : thandle) : 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:thandle;pos:longint);
+var
+  regs : Registers;
+begin
+{  do_seek(handle,pos);
+  regs.CX:=0;
+  regs.BX:=handle;
+  regs.AX:=$4000;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);}
+end;
+
+{const
+  FileHandleCount : word = 20;
+
+function Increase_file_handle_count : boolean;
+var
+  regs : Registers;
+begin
+  Inc(FileHandleCount,10);
+  regs.BX:=FileHandleCount;
+  regs.AX:=$6700;
+  MsDos(regs);
+  if (regs.Flags and fCarry) <> 0 then
+   begin
+    Increase_file_handle_count:=false;
+    Dec (FileHandleCount, 10);
+   end
+  else
+    Increase_file_handle_count:=true;
+end;}
+
+procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+var
+  regs   : Registers;
+  action : word;
+  oldp : pchar;
+begin
+{ close first if opened }
+(*  if ((flags and $10000)=0) then
+   begin
+     case filerec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file handle }
+  filerec(f).handle:=UnusedHandle;
+  action:=$1;
+{ convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : filerec(f).mode:=fminput;
+   1 : filerec(f).mode:=fmoutput;
+   2 : filerec(f).mode:=fminout;
+  end;
+  if (flags and $1000)<>0 then
+   action:=$12; {create file function}
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+  oldp:=p;
+  DoDirSeparators(p,pchangeable);
+{$ifndef RTLLITE}
+  if LFNSupport then
+   begin
+     regs.AX := $716c;                        { Use LFN Open/Create API }
+     regs.DX := action;             { action if file does/doesn't exist }
+     regs.SI := Ofs(p^);
+     regs.BX := $2000 + (flags and $ff);               { file open mode }
+   end
+  else
+{$endif RTLLITE}
+   begin
+     if (action and $00f0) <> 0 then
+       regs.AX := $3c00                     { Map to Create/Replace API }
+     else
+       regs.AX := $3d00 + (flags and $ff);   { Map to Open_Existing API }
+     regs.DX := Ofs(p^);
+   end;
+  regs.DS := Seg(p^);
+  regs.CX := $20;                                     { file attributes }
+  MsDos(regs);
+{$ifndef RTLLITE}
+  if (regs.Flags and fCarry) <> 0 then
+    if regs.AX=4 then
+      if Increase_file_handle_count then
+        begin
+          { Try again }
+          if LFNSupport then
+            begin
+              regs.AX := $716c;                 {Use LFN Open/Create API}
+              regs.DX := action;      {action if file does/doesn't exist}
+              regs.SI := Ofs(p^);
+              regs.BX := $2000 + (flags and $ff);        {file open mode}
+            end
+          else
+            begin
+              if (action and $00f0) <> 0 then
+                regs.AX := $3c00              {Map to Create/Replace API}
+              else
+                regs.AX := $3d00 + (flags and $ff);     {Map to Open API}
+              regs.DX := Ofs(p^);
+            end;
+          regs.DS := Seg(p^);
+          regs.CX := $20;                               {file attributes}
+          MsDos(regs);
+        end;
+{$endif RTLLITE}
+  if (regs.Flags and fCarry) <> 0 then
+    begin
+      FileRec(f).mode:=fmclosed;
+      GetInOutRes(regs.AX);
+      if oldp<>p then
+        freemem(p);
+      exit;
+    end
+  else
+    begin
+      filerec(f).handle:=regs.AX;
+{$ifndef RTLLITE}
+      { for systems that have more then 20 by default ! }
+      if regs.AX>FileHandleCount then
+        FileHandleCount:=regs.AX;
+{$endif RTLLITE}
+    end;
+  if regs.AX<max_files then
+    begin
+{$ifdef SYSTEMDEBUG}
+       if openfiles[regs.AX] and
+          assigned(opennames[regs.AX]) then
+         begin
+            Writeln(stderr,'file ',opennames[regs.AX],'(',regs.AX,') not closed but handle reused!');
+            sysfreememsize(opennames[regs.AX],strlen(opennames[regs.AX])+1);
+         end;
+{$endif SYSTEMDEBUG}
+       openfiles[regs.AX]:=true;
+{$ifdef SYSTEMDEBUG}
+       opennames[regs.AX] := sysgetmem(strlen(p)+1);
+       move(p^,opennames[regs.AX]^,strlen(p)+1);
+{$endif SYSTEMDEBUG}
+    end;
+{ append mode }
+  if ((flags and $100) <> 0) and
+   (FileRec (F).Handle <> UnusedHandle) then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
+
+  if oldp<>p then
+    freemem(p);*)
+end;
+
+
+function do_isdevice(handle:THandle):boolean;
+var
+  regs: Registers;
+begin
+(*  regs.AX := $4400;
+  regs.BX := handle;
+  MsDos(regs);
+  do_isdevice := (regs.DL and $80) <> 0;
+  if (regs.Flags and fCarry) <> 0 then
+   GetInOutRes(regs.AX);*)
+end;

rtl/win16/sysheap.inc

@@ -0,0 +1,30 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+function SysOSAlloc (size: ptruint): pointer;
+begin
+  Result := nil;
+end;
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+end;

rtl/win16/sysos.inc

@@ -0,0 +1,34 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2013 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+procedure GetInOutRes(def: Word);
+{var
+  regs : Registers;}
+begin
+{  regs.AX:=$5900;
+  regs.BX:=$0;
+  MsDos(regs);
+  InOutRes:=regs.AX;
+  case InOutRes of
+   19 : InOutRes:=150;
+   21 : InOutRes:=152;
+   32 : InOutRes:=5;
+  end;
+  if InOutRes=0 then
+    InOutRes:=Def;}
+end;
+

rtl/win16/sysosh.inc

@@ -0,0 +1,26 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2013 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+  THandle = Word;
+  TThreadID = THandle;
+
+   PRTLCriticalSection = ^TRTLCriticalSection;
+   TRTLCriticalSection = record
+     Locked: boolean
+   end;

rtl/win16/system.pp

@@ -2,31 +2,294 @@ unit system;
 
 interface
 
-type
-  HResult=word;
-  LPCTSTR=^char;far;
+{$DEFINE FPC_NO_DEFAULT_HEAP}
+
+{$DEFINE FPC_INCLUDE_SOFTWARE_MUL}
+{$DEFINE FPC_INCLUDE_SOFTWARE_MOD_DIV}
+
+{$DEFINE FPC_USE_SMALL_DEFAULTSTACKSIZE}
+{ To avoid warnings in thread.inc code,
+  but value must be really given after
+  systemh.inc is included otherwise the
+  $mode switch is not effective }
+
+{$I systemh.inc}
+{$I tnyheaph.inc}
+
+const
+  LineEnding = #13#10;
+  { LFNSupport is a variable here, defined below!!! }
+  DirectorySeparator = '\';
+  DriveSeparator = ':';
+  ExtensionSeparator = '.';
+  PathSeparator = ';';
+  AllowDirectorySeparators : set of char = ['\','/'];
+  AllowDriveSeparators : set of char = [':'];
+  { FileNameCaseSensitive and FileNameCasePreserving are defined separately below!!! }
+  maxExitCode = 255;
+  MaxPathLen = 256;
+
+const
+{ Default filehandles }
+  UnusedHandle    = $ffff;{ instead of -1, as it is a word value}
+  StdInputHandle  = 0;
+  StdOutputHandle = 1;
+  StdErrorHandle  = 2;
+
+  FileNameCaseSensitive : boolean = false;
+  FileNameCasePreserving: boolean = false;
+  CtrlZMarksEOF: boolean = true; (* #26 is considered as end of file *)
+
+  sLineBreak = LineEnding;
+  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+{ Default memory segments (Tp7 compatibility) }
+{  seg0040: Word = $0040;
+  segA000: Word = $A000;
+  segB000: Word = $B000;
+  segB800: Word = $B800;}
+{ The value that needs to be added to the segment to move the pointer by
+  64K bytes (BP7 compatibility) }
+  SelectorInc: Word = $1000;
+
+var
+{ Mem[] support }
+  mem  : array[0..$7fff-1] of byte absolute $0:$0;
+  memw : array[0..($7fff div sizeof(word))-1] of word absolute $0:$0;
+  meml : array[0..($7fff div sizeof(longint))-1] of longint absolute $0:$0;
+{ C-compatible arguments and environment }
+  argc:longint; //!! public name 'operatingsystem_parameter_argc';
+  argv:PPchar; //!! public name 'operatingsystem_parameter_argv';
+  envp:PPchar; //!! public name 'operatingsystem_parameter_envp';
+  dos_argv0 : pchar; //!! public name 'dos_argv0';
+
+{ The DOS Program Segment Prefix segment (TP7 compatibility) }
+  PrefixSeg:Word;public name '__fpc_PrefixSeg';
+
+{  SaveInt00: FarPointer;public name '__SaveInt00';}
+
+  AllFilesMask: string [3];
+{$ifndef RTLLITE}
+{ System info }
+  LFNSupport : boolean;
+{$ELSE RTLLITE}
+const
+  LFNSupport = false;
+{$endif RTLLITE}
 
-procedure fpc_InitializeUnits;compilerproc;
-procedure fpc_do_exit;compilerproc;
 
 procedure InitTask;external 'KERNEL';
 procedure WaitEvent;external 'KERNEL';
 procedure InitApp;external 'USER';
-procedure MessageBox(hWnd: word; lpText, lpCaption: LPCTSTR; uType: word);external 'USER';
+procedure MessageBox(hWnd: word; lpText, lpCaption: PChar; uType: word);external 'USER';
 
 implementation
 
-procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS'];compilerproc;
+const
+  fCarry = 1;
+
+  { used for an offset fixup for accessing the proc parameters in asm routines
+    that use nostackframe. We can't use the parameter name directly, because
+    i8086 doesn't support sp relative addressing. }
+{$ifdef FPC_X86_CODE_FAR}
+  extra_param_offset = 2;
+{$else FPC_X86_CODE_FAR}
+  extra_param_offset = 0;
+{$endif FPC_X86_CODE_FAR}
+{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
+  extra_data_offset = 2;
+{$else}
+  extra_data_offset = 0;
+{$endif}
+
+type
+  PFarByte = ^Byte;far;
+  PFarChar = ^Char;far;
+  PFarWord = ^Word;far;
+
+{$I registers.inc}
+
+{$I system.inc}
+
+{$I tinyheap.inc}
+
+{procedure fpc_InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS'];compilerproc;
 begin
   MessageBox(0, 'Hello, world!', 'yo', 0);
-end;
+end;}
 
-procedure fpc_do_exit;[public,alias:'FPC_DO_EXIT'];compilerproc;
+{procedure fpc_do_exit;[public,alias:'FPC_DO_EXIT'];compilerproc;
 begin
   asm
     mov ax, 4c00h
     int 21h
   end;
+end;}
+{*****************************************************************************
+                              ParamStr/Randomize
+*****************************************************************************}
+
+{function GetProgramName: string;
+var
+  dos_env_seg: Word;
+  ofs: Word;
+  Ch, Ch2: Char;
+begin
+  if dos_version < $300 then
+    begin
+      GetProgramName := '';
+      exit;
+    end;
+  dos_env_seg := PFarWord(Ptr(PrefixSeg, $2C))^;
+  ofs := 1;
+  repeat
+    Ch := PFarChar(Ptr(dos_env_seg,ofs - 1))^;
+    Ch2 := PFarChar(Ptr(dos_env_seg,ofs))^;
+    if (Ch = #0) and (Ch2 = #0) then
+      begin
+        Inc(ofs, 3);
+        GetProgramName := '';
+        repeat
+          Ch := PFarChar(Ptr(dos_env_seg,ofs))^;
+          if Ch <> #0 then
+            GetProgramName := GetProgramName + Ch;
+          Inc(ofs);
+          if ofs = 0 then
+            begin
+              GetProgramName := '';
+              exit;
+            end;
+        until Ch = #0;
+        exit;
+      end;
+    Inc(ofs);
+    if ofs = 0 then
+      begin
+        GetProgramName := '';
+        exit;
+      end;
+  until false;
+end;}
+
+
+{function GetCommandLine: string;
+var
+  len, I: Integer;
+begin
+  len := PFarByte(Ptr(PrefixSeg, $80))^;
+  SetLength(GetCommandLine, len);
+  for I := 1 to len do
+    GetCommandLine[I] := PFarChar(Ptr(PrefixSeg, $80 + I))^;
+end;}
+
+
+{function GetArg(ArgNo: Integer; out ArgResult: string): Integer;
+var
+  cmdln: string;
+  I: Integer;
+  InArg: Boolean;
+begin
+  cmdln := GetCommandLine;
+  ArgResult := '';
+  I := 1;
+  InArg := False;
+  GetArg := 0;
+  for I := 1 to Length(cmdln) do
+    begin
+      if not InArg and (cmdln[I] <> ' ') then
+        begin
+          InArg := True;
+          Inc(GetArg);
+        end;
+      if InArg and (cmdln[I] = ' ') then
+        InArg := False;
+      if InArg and (GetArg = ArgNo) then
+        ArgResult := ArgResult + cmdln[I];
+    end;
+end;}
+
+
+function paramcount : longint;
+{var
+  tmpstr: string;}
+begin
+{  paramcount := GetArg(-1, tmpstr);}
+  paramcount:=0;
+end;
+
+
+function paramstr(l : longint) : string;
+begin
+{  if l = 0 then
+    paramstr := GetProgramName
+  else
+    GetArg(l, paramstr);}
+  paramstr:='';
+end;
+
+procedure randomize;
+{var
+  hl   : longint;
+  regs : Registers;}
+begin
+{  regs.AH:=$2C;
+  MsDos(regs);
+  hl:=regs.DX;
+  randseed:=hl*$10000+ regs.CX;}
+end;
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+
+procedure system_exit;
+{var
+  h : byte;}
+begin
+(*  RestoreInterruptHandlers;
+  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;
+{$ifndef FPC_MM_TINY}
+  if not CheckNullArea then
+    writeln(stderr, 'Nil pointer assignment');
+{$endif FPC_MM_TINY}*)
+  asm
+    mov al, byte [exitcode]
+    mov ah, 4Ch
+    int 21h
+  end;
+end;
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+function GetProcessID: SizeUInt;
+begin
+  GetProcessID := PrefixSeg;
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
+begin
+  MessageBox(0, 'Hello, world!', 'yo', 0);
 end.