+ Haiku support by Olivier Coursière based on old BeOS support

git-svn-id: trunk@11014 -

.gitattributes

@@ -489,6 +489,7 @@ compiler/systems/i_embed.pas svneol=native#text/plain
 compiler/systems/i_emx.pas svneol=native#text/plain
 compiler/systems/i_gba.pas svneol=native#text/plain
 compiler/systems/i_go32v2.pas svneol=native#text/plain
+compiler/systems/i_haiku.pas svneol=native#text/plain
 compiler/systems/i_linux.pas svneol=native#text/plain
 compiler/systems/i_macos.pas svneol=native#text/plain
 compiler/systems/i_morph.pas svneol=native#text/plain
@@ -511,6 +512,7 @@ compiler/systems/t_embed.pas svneol=native#text/plain
 compiler/systems/t_emx.pas svneol=native#text/plain
 compiler/systems/t_gba.pas svneol=native#text/plain
 compiler/systems/t_go32v2.pas svneol=native#text/plain
+compiler/systems/t_haiku.pas svneol=native#text/plain
 compiler/systems/t_linux.pas svneol=native#text/plain
 compiler/systems/t_macos.pas svneol=native#text/plain
 compiler/systems/t_morph.pas svneol=native#text/plain
@@ -1102,6 +1104,7 @@ packages/fcl-base/src/fptimer.pp svneol=native#text/plain
 packages/fcl-base/src/gettext.pp svneol=native#text/plain
 packages/fcl-base/src/go32v2/custapp.inc svneol=native#text/plain
 packages/fcl-base/src/go32v2/eventlog.inc svneol=native#text/plain
+packages/fcl-base/src/haiku/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/idea.pp svneol=native#text/plain
 packages/fcl-base/src/inicol.pp svneol=native#text/plain
 packages/fcl-base/src/inifiles.pp svneol=native#text/plain
@@ -1483,6 +1486,7 @@ packages/fcl-process/src/dbugintf.pp svneol=native#text/plain
 packages/fcl-process/src/dbugmsg.pp svneol=native#text/plain
 packages/fcl-process/src/go32v2/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/go32v2/process.inc svneol=native#text/plain
+packages/fcl-process/src/haiku/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/morphos/pipes.inc svneol=native#text/plain
 packages/fcl-process/src/morphos/process.inc svneol=native#text/plain
 packages/fcl-process/src/netware/pipes.inc svneol=native#text/plain
@@ -5111,6 +5115,42 @@ rtl/go32v2/v2prt0.as svneol=native#text/plain
 rtl/go32v2/varutils.pp svneol=native#text/plain
 rtl/go32v2/vesamode.pp svneol=native#text/plain
 rtl/go32v2/video.pp svneol=native#text/plain
+rtl/haiku/Makefile.fpc svneol=native#text/plain
+rtl/haiku/baseunix.pp svneol=native#text/plain
+rtl/haiku/bethreads.pp svneol=native#text/plain
+rtl/haiku/classes.pp svneol=native#text/plain
+rtl/haiku/errno.inc svneol=native#text/plain
+rtl/haiku/errnostr.inc svneol=native#text/plain
+rtl/haiku/i386/cprt0.as svneol=native#text/plain
+rtl/haiku/i386/dllprt.as svneol=native#text/plain
+rtl/haiku/i386/dllprt.cpp svneol=native#text/plain
+rtl/haiku/i386/func.as svneol=native#text/plain
+rtl/haiku/i386/prt0.as svneol=native#text/plain
+rtl/haiku/i386/sighnd.inc svneol=native#text/plain
+rtl/haiku/osmacro.inc svneol=native#text/plain
+rtl/haiku/ossysc.inc svneol=native#text/plain
+rtl/haiku/ostypes.inc svneol=native#text/plain
+rtl/haiku/pthread.inc svneol=native#text/plain
+rtl/haiku/ptypes.inc svneol=native#text/plain
+rtl/haiku/settimeo.inc svneol=native#text/plain
+rtl/haiku/signal.inc svneol=native#text/plain
+rtl/haiku/suuid.inc svneol=native#text/plain
+rtl/haiku/syscall.inc svneol=native#text/plain
+rtl/haiku/syscallh.inc svneol=native#text/plain
+rtl/haiku/sysconst.inc svneol=native#text/plain
+rtl/haiku/sysheap.inc svneol=native#text/plain
+rtl/haiku/sysnr.inc svneol=native#text/plain
+rtl/haiku/sysos.inc svneol=native#text/plain
+rtl/haiku/sysosh.inc svneol=native#text/plain
+rtl/haiku/system.pp svneol=native#text/plain
+rtl/haiku/termio.pp svneol=native#text/plain
+rtl/haiku/termios.inc svneol=native#text/plain
+rtl/haiku/termiosproc.inc svneol=native#text/plain
+rtl/haiku/tthread.inc svneol=native#text/plain
+rtl/haiku/unixsock.inc svneol=native#text/plain
+rtl/haiku/unxconst.inc svneol=native#text/plain
+rtl/haiku/unxfunc.inc svneol=native#text/plain
+rtl/haiku/unxsockh.inc svneol=native#text/plain
 rtl/i386/cpu.pp svneol=native#text/plain
 rtl/i386/fastmove.inc svneol=native#text/plain
 rtl/i386/i386.inc svneol=native#text/plain

compiler/README

@@ -19,7 +19,7 @@ Use the make utility as following
       
 If an option is omitted, then target CPU/OS will be same as current CPU/OS
  
-Possibles targets are : linux go32v2 win32 os2 freebsd beos netbsd amiga
+Possibles targets are : linux go32v2 win32 os2 freebsd beos netbsd amiga haiku
 atari sunos qnx netware openbsd wdosx palmos macos macosx emx
    
 Possible compiler switches (* marks a currently required switch):

compiler/catch.pas

@@ -31,14 +31,12 @@ Unit catch;
 interface
 uses
 {$ifdef unix}
- {$ifndef beos}
   {$define has_signal}
   {$ifdef havelinuxrtl10}
     Linux,
   {$else}
     BaseUnix,Unix,
   {$endif}
- {$endif}
 {$endif}
 {$ifdef go32v2}
 {$define has_signal}

compiler/i386/ag386nsm.pas

@@ -1146,6 +1146,18 @@ interface
             labelprefix : '..@';
             comment : '; ';
           );
+          
+       as_i386_nasmhaiku_info : tasminfo =
+          (
+            id           : as_i386_nasmhaiku;
+            idtxt  : 'NASMELF';
+            asmbin : 'nasm';
+            asmcmd : '-f elf -o $OBJ $ASM';
+            supported_target : system_i386_haiku;
+            flags : [af_allowdirect,af_needar,af_no_debug];
+            labelprefix : '..@';
+            comment : '; ';
+          );
 
 
 initialization
@@ -1154,5 +1166,6 @@ initialization
   RegisterAssembler(as_i386_nasmwdosx_info,T386NasmAssembler);
   RegisterAssembler(as_i386_nasmobj_info,T386NasmAssembler);
   RegisterAssembler(as_i386_nasmbeos_info,T386NasmAssembler);
+  RegisterAssembler(as_i386_nasmhaiku_info,T386NasmAssembler);
   RegisterAssembler(as_i386_nasmelf_info,T386NasmAssembler);
 end.

compiler/i386/cputarg.pas

@@ -65,6 +65,9 @@ implementation
     {$ifndef NOTARGETBEOS}
       ,t_beos
     {$endif}
+    {$ifndef NOTARGETHAIKU}
+      ,t_haiku
+    {$endif}
     {$ifndef NOTARGETWDOSX}
       ,t_wdosx
     {$endif}

compiler/systems.pas

@@ -143,7 +143,8 @@ interface
              system_i386_symbian,       { 59 }
              system_arm_symbian,        { 60 }
              system_x86_64_darwin,      { 61 }
-             system_avr_embedded        { 62 }
+             system_avr_embedded,       { 62 }
+             system_i386_haiku          { 63 }             
        );
 
      type
@@ -173,6 +174,7 @@ interface
              ,as_x86_64_elf64
              ,as_sparc_elf32
              ,as_ggas                  { gnu assembler called "gas" instead of "as" }
+             ,as_i386_nasmhaiku
        );
 
        tar = (ar_none

compiler/systems/i_beos.pas

@@ -102,7 +102,9 @@ unit i_beos;
 initialization
 {$ifdef cpu86}
   {$ifdef beos}
-    set_source_info(system_i386_beos_info);
+    {$ifndef haiku}
+      set_source_info(system_i386_beos_info);
+    {$endif haiku}
   {$endif beos}
 {$endif cpu86}
 end.

compiler/systems/i_haiku.pas

@@ -0,0 +1,109 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman
+    Copyright (c) 2008-2008 by Olivier Coursière
+
+    This unit implements support information structures for Haiku
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+{ This unit implements support information structures for Haiku. }
+unit i_haiku;
+
+  interface
+
+    uses
+       systems;
+
+    const
+       system_i386_haiku_info : tsysteminfo =
+          (
+            system       : system_i386_Haiku;
+            name         : 'Haiku for i386';
+            shortname    : 'Haiku';
+            flags        : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses,
+                            tf_smartlink_sections, tf_smartlink_library];
+            cpu          : cpu_i386;
+            unit_env     : 'HAIKUUNITS';
+            extradefines : 'BEOS;UNIX;HASUNIX';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_i386_elf32;
+            assemextern  : as_gas;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 0;
+                localalignmax   : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            { Stack size used to be 256 K under BeOS. So, it was the value 
+              used in previous version of FPC for BeOS (but lost in the road 
+              to 2.* ;-).
+              According to buildtools/gcc/gcc/config/i386/beos-elf.h in the 
+              Haiku's repository, this value was increased to 1Mb since r4.1b3.
+              Under R5, this value is even greater. listarea report a default 
+              size of 16 Mb for the user stack of the main thread.
+              People who still use BeOS nowadays should use R5 (or Haiku), 
+              so i use this new value.  
+            }
+            stacksize    : 16 * 1024 * 1024;
+            abi : abi_default
+          );
+
+  implementation
+
+initialization
+{$ifdef cpu86}
+  {$ifdef haiku}
+    set_source_info(system_i386_haiku_info);
+  {$endif haiku}
+{$endif cpu86}
+end.

compiler/systems/t_beos.pas

@@ -248,7 +248,8 @@ begin
    LinkRes.Add('ld -o $1 -e 0 $2 $3 $4 $5 $6 $7 $8 $9\');
   }
   LinkRes.Add('-m');
-  LinkRes.Add('elf_i386_be');
+//  LinkRes.Add('elf_i386_be');
+  LinkRes.Add('elf_i386_haiku');
   LinkRes.Add('-shared');
   LinkRes.Add('-Bsymbolic');
 

compiler/systems/t_haiku.pas

@@ -0,0 +1,497 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman
+    Copyright (c) 2008-2008 by Olivier Coursiere
+
+    This unit implements support import,export,link routines
+    for the (i386) Haiku target.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_haiku;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    symsym,symdef,
+    import,export,link;
+
+  type
+    timportlibhaiku=class(timportlib)
+      procedure generatelib;override;
+    end;
+
+    texportlibhaiku=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkerhaiku=class(texternallinker)
+    private
+      Function  WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean;
+    public
+      constructor Create;override;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+implementation
+
+  uses
+    SysUtils,
+    cutils,cfileutl,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_haiku,ogbase;
+
+{*****************************************************************************
+                               TIMPORTLIBHAIKU
+*****************************************************************************}
+
+    procedure timportlibhaiku.generatelib;
+      var
+        i : longint;
+        ImportLibrary : TImportLibrary;
+      begin
+        for i:=0 to current_module.ImportLibraryList.Count-1 do
+          begin
+            ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
+            current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
+          end;
+      end;
+
+
+{*****************************************************************************
+                               TEXPORTLIBHAIKU
+*****************************************************************************}
+
+procedure texportlibhaiku.preparelib(const s:string);
+begin
+end;
+
+
+procedure texportlibhaiku.exportprocedure(hp : texported_item);
+var
+  hp2 : texported_item;
+begin
+  { first test the index value }
+  if (hp.options and eo_index)<>0 then
+   begin
+     Message1(parser_e_no_export_with_index_for_target,'haiku');
+     exit;
+   end;
+  { now place in correct order }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) and
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
+  { insert hp there !! }
+  if assigned(hp2) and (hp2.name^=hp.name^) then
+    begin
+      { this is not allowed !! }
+      Message1(parser_e_export_name_double,hp.name^);
+      exit;
+    end;
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.concat(hp)
+  else if assigned(hp2) then
+    begin
+       hp.next:=hp2;
+       hp.previous:=hp2.previous;
+       if assigned(hp2.previous) then
+         hp2.previous.next:=hp;
+       hp2.previous:=hp;
+    end
+  else
+    current_module._exports.concat(hp);
+end;
+
+
+procedure texportlibhaiku.exportvar(hp : texported_item);
+begin
+  hp.is_var:=true;
+  exportprocedure(hp);
+end;
+
+
+procedure texportlibhaiku.generatelib;
+var
+  hp2 : texported_item;
+  pd  : tprocdef;
+begin
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if (not hp2.is_var) and
+        (hp2.sym.typ=procsym) then
+      begin
+        { the manglednames can already be the same when the procedure
+          is declared with cdecl }
+        pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
+        if pd.mangledname<>hp2.name^ then
+         begin
+{$ifdef i386}
+           { place jump in al_procedures }
+           current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90));
+           current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
+           current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname)));
+           current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
+{$endif i386}
+         end;
+      end
+     else
+      Message1(parser_e_no_export_of_variables_for_target,'haiku');
+     hp2:=texported_item(hp2.next);
+   end;
+end;
+
+
+{*****************************************************************************
+                                  TLINKERHAIKU
+*****************************************************************************}
+
+Constructor TLinkerHaiku.Create;
+var
+  s : string;
+  i : integer;
+begin
+  Inherited Create;
+  s:=GetEnvironmentVariable('BELIBRARIES');
+  { convert to correct format in case under unix system }
+  for i:=1 to length(s) do
+    if s[i] = ':' then
+      s[i] := ';';
+  { just in case we have a single path : add the ending ; }
+  { since that is what the compiler expects.              }
+  if pos(';',s) = 0 then
+    s:=s+';';
+  LibrarySearchPath.AddPath(sysrootpath,s,true); {format:'path1;path2;...'}
+end;
+
+
+procedure TLinkerHaiku.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE `cat $RES`';
+     DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE `cat $RES`';
+     DllCmd[2]:='strip --strip-unneeded $EXE';
+(*
+     ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.';
+{     ExeCmd[1]:='sh $RES $EXE $OPT $DYNLINK $STATIC $STRIP -L.';}
+      DllCmd[1]:='sh $RES $EXE $OPT -L.';
+
+{     DllCmd[1]:='sh $RES $EXE $OPT -L. -g -nostart -soname=$EXE';
+ }    DllCmd[2]:='strip --strip-unneeded $EXE';
+{     DynamicLinker:='/lib/ld-beos.so.2';}
+*)
+   end;
+end;
+
+
+function TLinkerHaiku.WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  i        : integer;
+  cprtobj,
+  prtobj   : string[80];
+  HPath    : TCmdStrListItem;
+  s        : TCmdStr;
+  linklibc : boolean;
+begin
+  WriteResponseFile:=False;
+{ set special options for some targets }
+  linklibc:=(SharedLibFiles.Find('root')<>nil);
+
+  prtobj:='prt0';
+  cprtobj:='cprt0';
+  if (cs_profile in current_settings.moduleswitches) or
+     (not SharedLibFiles.Empty) then
+   begin
+     AddSharedLibrary('root');
+     linklibc:=true;
+   end;
+
+  if (not linklibc) and makelib then
+   begin
+     linklibc:=true;
+     cprtobj:='dllprt.o';
+   end;
+
+  if linklibc then
+   prtobj:=cprtobj;
+
+  { Open link.res file }
+  LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
+  {
+  if not isdll then
+   LinkRes.Add('ld -o $1 $2 $3 $4 $5 $6 $7 $8 $9 \')
+  else
+   LinkRes.Add('ld -o $1 -e 0 $2 $3 $4 $5 $6 $7 $8 $9\');
+  }
+  LinkRes.Add('-m');
+  LinkRes.Add('elf_i386_haiku');
+  LinkRes.Add('-shared');
+  LinkRes.Add('-Bsymbolic');
+
+  { Write path to search libraries }
+  HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TCmdStrListItem(HPath.Next);
+   end;
+  HPath:=TCmdStrListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TCmdStrListItem(HPath.Next);
+   end;
+
+  { try to add crti and crtbegin if linking to C }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crti.o',false,s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crtbegin.o',false,s) then
+      LinkRes.AddFileName(s);
+{      s:=librarysearchpath.FindFile('start_dyn.o',found)+'start_dyn.o';
+     if found then LinkRes.AddFileName(s+' \');}
+
+     if prtobj<>'' then
+      LinkRes.AddFileName(FindObjectFile(prtobj,'',false));
+
+//     if isdll then
+//      LinkRes.AddFileName(FindObjectFile('func.o','',false));
+
+     if librarysearchpath.FindFile('init_term_dyn.o',false,s) then
+      LinkRes.AddFileName(s);
+   end
+  else
+   begin
+     if prtobj<>'' then
+      LinkRes.AddFileName(FindObjectFile(prtobj,'',false));
+   end;
+
+  { main objectfiles }
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+
+{  LinkRes.Add('-lroot \');
+  LinkRes.Add('/boot/develop/tools/gnupro/lib/gcc-lib/i586-beos/2.9-beos-991026/crtend.o \');
+  LinkRes.Add('/boot/develop/lib/x86/crtn.o \');}
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(s)
+      end;
+   end;
+
+  { Write sharedlibraries like -l<lib> }
+  if not SharedLibFiles.Empty then
+   begin
+     While not SharedLibFiles.Empty do
+      begin
+        S:=SharedLibFiles.GetFirst;
+        if s<>'c' then
+         begin
+           i:=Pos(target_info.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           LinkRes.Add('-l'+s);
+         end
+        else
+         begin
+           linklibc:=true;
+         end;
+      end;
+     { be sure that libc is the last lib }
+{     if linklibc then
+       LinkRes.Add('-lroot');}
+{     if linkdynamic and (Info.DynamicLinker<>'') then
+       LinkRes.AddFileName(Info.DynamicLinker);}
+   end;
+  if isdll then
+   LinkRes.Add('-lroot');
+
+  { objects which must be at the end }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crtend.o',false,s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crtn.o',false,s) then
+      LinkRes.AddFileName(s);
+   end;
+
+{ Write and Close response }
+  linkres.Add(' ');
+  linkres.writetodisk;
+  linkres.free;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerHaiku.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr : TCmdStr;
+  success : boolean;
+  DynLinkStr : string[60];
+  GCSectionsStr,
+  StaticStr,
+  StripStr   : string[40];
+begin
+  if not(cs_link_nolink in current_settings.globalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  GCSectionsStr:='';
+  if (cs_link_staticflag in current_settings.globalswitches) then
+   StaticStr:='-static';
+  if (cs_link_strip in current_settings.globalswitches) then
+   StripStr:='-s';
+
+  if (cs_link_smart in current_settings.globalswitches) and
+     (tf_smartlink_sections in target_info.flags) then
+      GCSectionsStr:='--gc-sections';
+
+  If (cs_profile in current_settings.moduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   begin
+     DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+     if cshared Then
+       DynLinkStr:='--shared ' + DynLinkStr;
+     if rlinkpath<>'' Then
+       DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr;
+   End;
+
+{ Write used files and libraries }
+  WriteResponseFile(false,false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,true);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_nolink in current_settings.globalswitches) then
+   DeleteFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+Function TLinkerHaiku.MakeSharedLibrary:boolean;
+var
+  binstr,
+  cmdstr,
+  SoNameStr : TCmdStr;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+
+ begin
+  MakeSharedLibrary:=false;
+  if not(cs_link_nolink in current_settings.globalswitches) then
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  if (cs_link_staticflag in current_settings.globalswitches) then
+   StaticStr:='-static';
+  if (cs_link_strip in current_settings.globalswitches) then
+   StripStr:='-s';
+  If (cs_profile in current_settings.moduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   begin
+     DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+     if cshared Then
+       DynLinkStr:='--shared ' + DynLinkStr;
+     if rlinkpath<>'' Then
+       DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr;
+   End;
+{ Write used files and libraries }
+  WriteResponseFile(true,true);
+
+  SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^);
+
+{ Call linker }
+  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  Replace(cmdstr,'$SONAME',SoNameStr);
+
+  success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true);
+
+{ Strip the library ? }
+  if success and (cs_link_strip in current_settings.globalswitches) then
+   begin
+     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
+     Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
+     success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false);
+   end;
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_nolink in current_settings.globalswitches) then
+   DeleteFile(outputexedir+Info.ResName);
+
+  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
+end;
+
+
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+initialization
+{$ifdef i386}
+  RegisterExternalLinker(system_i386_haiku_info,TLinkerhaiku);
+  RegisterImport(system_i386_haiku,timportlibhaiku);
+  RegisterExport(system_i386_haiku,texportlibhaiku);
+  RegisterTarget(system_i386_haiku_info);
+{$endif i386}
+end.

compiler/x86/agx86int.pas

@@ -712,7 +712,7 @@ implementation
                   AsmWriteln(#9#9+prefix); but not masm PM
                   prefix:=''; }
                   if target_asm.id in [as_i386_nasmcoff,as_i386_nasmwin32,as_i386_nasmwdosx,
-                    as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos] then
+                    as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos,as_i386_nasmhaiku] then
                      begin
                        AsmWriteln(prefix);
                        prefix:='';

packages/fcl-base/Makefile.fpc

@@ -15,7 +15,8 @@ units=contnrs inifiles rtfpars idea base64 gettext \
       iostream cachecls avl_tree uriparser \
       eventlog custapp wformat whtml wtex rttiutils bufstream \
       streamex blowfish streamio inicol pooledmm libtar streamcoll maskutils
-units_beos=syncobjs 
+units_beos=syncobjs
+units_haiku=syncobjs
 units_freebsd=syncobjs daemonapp fptimer
 units_darwin=syncobjs daemonapp fptimer 
 units_solaris=syncobjs daemonapp fptimer
@@ -41,6 +42,7 @@ includedir_openbsd=src/unix
 includedir_solaris=src/unix
 includedir_qnx=src/unix
 includedir_beos=src/unix
+includedir_haiku=src/unix
 includedir_emx=src/os2
 includedir_win32=src/win
 includedir_win64=src/win

packages/fcl-base/src/haiku/eventlog.inc

@@ -0,0 +1,22 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Generic event logging facility.
+
+    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.
+
+ **********************************************************************}
+
+{ ---------------------------------------------------------------------
+    Include event log that maps to file event log.
+  ---------------------------------------------------------------------}
+
+{$i felog.inc}
+
+

packages/fcl-net/Makefile.fpc

@@ -16,6 +16,7 @@ units_darwin=netdb resolve ssockets
 units_solaris=netdb resolve ssockets 
 units_qnx=netdb resolve ssockets 
 units_beos=netdb resolve ssockets 
+units_haiku=netdb resolve ssockets 
 units_emx=resolve ssockets 
 units_os2=resolve ssockets 
 units_win32=resolve ssockets 
@@ -47,6 +48,7 @@ includedir_openbsd=src/unix
 includedir_solaris=src/unix
 includedir_qnx=src/unix
 includedir_beos=src/unix
+includedir_haiku=src/unix
 includedir_emx=src/os2
 includedir_win32=src/win
 includedir_win64=src/win

packages/fcl-process/Makefile.fpc

@@ -9,6 +9,7 @@ version=2.0.0
 [target]
 units=pipes process
 units_beos=simpleipc dbugmsg dbugintf
+units_haiku=simpleipc dbugmsg dbugintf
 units_freebsd=simpleipc dbugmsg dbugintf
 units_darwin=simpleipc dbugmsg dbugintf
 units_solaris=simpleipc dbugmsg dbugintf
@@ -22,6 +23,7 @@ units_qnx=simpleipc dbugmsg dbugintf
 units_os2=simpleipc dbugmsg dbugintf
 units_emx=simpleipc dbugmsg dbugintf
 rsts_beos=process simpleipc
+rsts_haiku=process simpleipc
 rsts_freebsd=process simpleipc
 rsts_darwin=process simpleipc
 rsts_solaris=process simpleipc
@@ -46,6 +48,7 @@ includedir_openbsd=src/unix
 includedir_solaris=src/unix
 includedir_qnx=src/unix
 includedir_beos=src/unix
+includedir_haiku=src/unix
 includedir_emx=src/os2
 includedir_win32=src/win
 includedir_win64=src/win

packages/fcl-process/src/haiku/pipes.inc

@@ -0,0 +1,30 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt
+
+    DOS/go32v2 specific part of pipe stream.
+
+    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.
+
+ **********************************************************************}
+
+// No pipes under beos, sorry...
+
+Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
+
+begin
+  Result := False;
+end;
+
+
+Function TInputPipeStream.GetNumBytesAvailable: DWord;
+
+begin
+  Result := 0;
+end;
+

rtl/Makefile.fpc

@@ -18,6 +18,7 @@ dirs_emx=emx
 dirs_freebsd=freebsd
 dirs_darwin=darwin
 dirs_beos=beos
+dirs_haiku=haiku
 dirs_amiga=amiga
 dirs_netbsd=netbsd
 dirs_macos=macos

rtl/haiku/Makefile.fpc

@@ -0,0 +1,260 @@
+#
+#   Makefile.fpc for Free Pascal BeOS RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=prt0 cprt0 func dllprt
+units=system baseunix unixtype ctypes objpas macpas strings \
+#      beos \
+      errors dos dl objects \
+      sysconst sysutils \
+      types charset ucomplex typinfo classes fgl math varutils \
+      cpu mmx getopts heaptrc lineinfo lnfodwrf variants \
+      rtlconsts syscall unix unixutil strutils termio initc \
+      cmem crt video mouse keyboard \
+      dateutils fmtbcd sockets dynlibs cwstring cthreads
+rsts=math varutils typinfo variants sysconst rtlconsts dateutils
+implicitunits=exeinfo
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=haiku
+cpu=i386
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) $(OSPROCINC) $(BEOSINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) $(BEOSINC)
+targetdir=.
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+      unix  \
+      dos crt objects printer \
+      sysutils typinfo math \
+      $(CPU_UNITS) getopts heaptrc \
+      errors sockets ipc dynlibs
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNIXINC=$(RTL)/unix
+BEOSINC=$(RTL)/beos
+
+UNITPREFIX=rtl
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+override FPCOPT+= -dHASUNIX -n -dFPC_USE_LIBC -Si
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+GRAPHDIR=$(INC)/graph
+
+[rules]
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+SYSTEMUNIT=system
+
+#
+# Loaders
+#
+
+prt0$(OEXT) : $(CPU_TARGET)/prt0.as
+        $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
+
+cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
+        $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as
+
+func$(OEXT) : $(CPU_TARGET)/func.as
+        $(AS) -o $(UNITTARGETDIRPREFIX)func$(OEXT) $(CPU_TARGET)/func.as
+
+dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
+        $(AS) -o $(UNITTARGETDIRPREFIX)dllprt$(OEXT) $(CPU_TARGET)/dllprt.as
+
+#
+# system Units (system, Objpas, Strings)
+#
+
+system$(PPUEXT) : system.pp $(SYSDEPS) $(UNIXINC)/sysunixh.inc
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) types$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+                   $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# system Dependent Units
+#
+
+# beos$(PPUEXT) : beos.pp $(SYSTEMUNIT)$(PPUEXT)
+
+baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
+
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+                 sysconst.inc $(UNIXINC)/timezone.inc \
+                 baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+#
+# TP7 Compatible RTL Units
+#
+
+# dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+#               beos$(PPUEXT) system$(PPUEXT)
+
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+               unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(INC) -Fu$(INC) $(UNIXINC)/dos.pp
+                       
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/crt.pp $(REDIR)
+
+video$(PPUEXT) : video.pp $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) -Fu$(UNIXINC) $(UNIXINC)/video.pp $(REDIR)
+        
+keyboard$(PPUEXT) : $(UNIXINC)/keyboard.pp mouse$(PPUEXT) $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/keyboard.pp $(REDIR) -dNOGPM
+
+                       
+objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+
+#
+# Delphi Compatible Units
+#
+
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
+                    objpas$(PPUEXT) $(OBJPASDIR)/sysconst$(PPUEXT) # beos$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(UNIXINC) $(UNIXINC)/sysutils.pp
+
+classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
+                   sysutils$(PPUEXT) $(OBJPASDIR)/typinfo$(PPUEXT) types$(PPUEXT) $(OBJPASDIR)/rtlconsts$(PPUEXT) 
+#                   $(UNIXINC)/systhrd$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR) -Fi$(OBJPASDIR)/classes classes.pp
+
+fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/fgl.pp
+
+typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
+        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
+
+math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/math.pp
+
+gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/gettext.pp
+
+varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
+                    $(OBJPASDIR)/varutilh.inc varutils.pp
+				$(COMPILER) -Fi$(OBJPASDIR) $(UNIXINC)/varutils.pp
+
+fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) variants$(PPUEXT) classes$(PPUEXT) system$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/fmtbcd.pp
+
+types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+       	$(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/sysconst.pp
+
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+         $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                    sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/strutils.pp
+
+#
+# Mac Pascal Model
+#
+
+macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/macpas.pp $(REDIR)
+        
+#
+# Other system-independent RTL Units
+#
+
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
+        $(COMPILER) $(INC)/heaptrc.pp
+
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
+
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
+
+#
+# Other system-dependent RTL Units
+#
+
+termio$(PPUEXT) : baseunix$(PPUEXT)
+
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/mouse.pp $(REDIR) -dNOGPM
+
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+                   unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) math$(PPUEXT)
+        $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
+
+cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
+
+
+

rtl/haiku/baseunix.pp

@@ -0,0 +1,154 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Carl Eric Codere development team
+
+    Base Unix unit modelled after POSIX 2001.
+
+    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 BaseUnix;
+
+Interface
+
+uses UnixType;
+
+{$i aliasptp.inc}
+
+{$packrecords C}
+{$define oldreaddir}		// Keep using readdir system call instead
+				// of userland getdents stuff.
+{$define usedomain}		// Allow uname with "domain" entry.
+				// (which is a GNU extension)
+{$define posixworkaround}	// Temporary ugly workaround for signal handler.
+				// (mainly until baseunix migration is complete)
+
+{$ifndef FPC_USE_LIBC}
+{$define FPC_USE_SYSCALL}
+{$endif}
+
+{$i errno.inc}		{ Error numbers }
+{$i ostypes.inc}
+
+{$ifdef FPC_USE_LIBC}
+const clib = 'root';
+const netlib = 'net';
+{$i oscdeclh.inc}
+{$ELSE}
+{$i bunxh.inc}		{ Functions}
+{$ENDIF}
+
+function fpgeterrno:longint; 
+procedure fpseterrno(err:longint); 
+
+{$ifndef ver1_0}
+property errno : cint read fpgeterrno write fpseterrno;
+{$endif}
+
+{$i bunxovlh.inc}
+
+{$ifdef FPC_USE_LIBC}
+{$ifdef beos}
+function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+Function fpFlock (var fd : text; mode : longint) : cint; 
+Function fpFlock (var fd : File; mode : longint) : cint; 
+Function fpFlock (fd, mode : longint) : cint; 
+Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
+{$endif}
+{$endif}
+
+{ Fairly portable constants. I'm not going to waste time to duplicate and alias
+them anywhere}
+
+Const
+  MAP_FAILED    = pointer(-1);  { mmap() has failed }
+  MAP_SHARED    =  $1;          { Share changes }
+  MAP_PRIVATE   =  $2;          { Changes are private }
+  MAP_TYPE      =  $f;          { Mask for type of mapping }
+  MAP_FIXED     = $10;          { Interpret addr exactly }
+
+// MAP_ANON(YMOUS) is OS dependant but used in the RTL and in ostypes.inc
+// Under BSD without -YMOUS, so alias it:
+  MAP_ANON	= MAP_ANONYMOUS;
+
+  PROT_READ     =  $1;          { page can be read }
+  PROT_WRITE    =  $2;          { page can be written }
+  PROT_EXEC     =  $4;          { page can be executed }
+  PROT_NONE     =  $0;          { page can not be accessed }
+
+implementation
+
+{$i genfuncs.inc}       // generic calls. (like getenv)
+{$I gensigset.inc}     // general sigset funcs implementation.
+{$I genfdset.inc}      // general fdset funcs.
+
+{$ifndef FPC_USE_LIBC}
+  {$i syscallh.inc}       // do_syscall declarations themselves
+  {$i sysnr.inc}          // syscall numbers.
+  {$i bsyscall.inc}  			// cpu specific syscalls
+  {$i bunxsysc.inc}       // syscalls in system unit.
+//  {$i settimeo.inc}
+{$endif}
+{$i settimeo.inc}
+{$i osmacro.inc}        { macro implenenations }
+{$i bunxovl.inc}        { redefs and overloads implementation }
+
+{$ifndef ver1_0}
+function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+{$else}
+// workaround for 1.0.10 bugs.
+
+function intgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+procedure intseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+
+function fpgeterrno:longint; 
+begin
+  fpgeterrno:=intgeterrno;
+end;
+
+procedure fpseterrno(err:longint); 
+begin
+  intseterrno(err);
+end;
+
+{$endif}
+
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+begin
+  fpsettimeofday := settimeofday(tp, tzp);
+end;
+
+Function fpFlock (var fd : File; mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+Function fpFlock (var fd : Text; mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+Function fpFlock (fd, mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+function snooze(microseconds : bigtime_t) : status_t; cdecl; external 'root' name 'snooze';
+
+Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
+begin
+  case snooze((req^.tv_nsec div 1000) + (req^.tv_sec * 1000 * 1000)) of
+    B_OK : FpNanoSleep := 0;
+    B_INTERRUPTED : FpNanoSleep := - 1;
+    else
+      FpNanoSleep := - 1;
+  end;
+end;
+
+end.

rtl/haiku/bethreads.pp

@@ -0,0 +1,519 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Peter Vreman,
+    member of the Free Pascal development team.
+
+    BeOS (bethreads) threading support implementation
+
+    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.
+
+ **********************************************************************}
+{$mode objfpc}
+
+unit bethreads;
+interface
+{$S-}
+
+Procedure SetBeThreadManager;
+
+implementation
+
+Uses
+  systhrds,
+  BaseUnix,
+  unix,
+  unixtype,
+  sysutils;
+
+{*****************************************************************************
+                             Generic overloaded
+*****************************************************************************}
+
+{ Include OS specific parts. }
+
+{*****************************************************************************
+                             Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+    const
+      threadvarblocksize : dword = 0;
+
+    var
+      TLSKey : pthread_key_t;
+
+    procedure BeInitThreadvar(var offset : dword;size : dword);
+      begin
+        offset:=threadvarblocksize;
+        inc(threadvarblocksize,size);
+      end;
+
+    function BeRelocateThreadvar(offset : dword) : pointer;
+      begin
+        BeRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
+      end;
+
+
+    procedure BeAllocateThreadVars;
+      var
+        dataindex : pointer;
+      begin
+        { we've to allocate the memory from system  }
+        { because the FPC heap management uses      }
+        { exceptions which use threadvars but       }
+        { these aren't allocated yet ...            }
+        { allocate room on the heap for the thread vars }
+        DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+        FillChar(DataIndex^,threadvarblocksize,0);
+        pthread_setspecific(tlskey,dataindex);
+      end;
+
+
+    procedure BeReleaseThreadVars;
+      begin
+        {$ifdef ver1_0}
+        Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize);
+        {$else}
+        Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
+        {$endif}
+      end;
+
+{ Include OS independent Threadvar initialization }
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+                            Thread starting
+*****************************************************************************}
+
+    type
+      pthreadinfo = ^tthreadinfo;
+      tthreadinfo = record
+        f : tthreadfunc;
+        p : pointer;
+        stklen : cardinal;
+      end;
+
+    procedure DoneThread;
+      begin
+        { Release Threadvars }
+{$ifdef HASTHREADVAR}
+        CReleaseThreadVars;
+{$endif HASTHREADVAR}
+      end;
+
+
+    function ThreadMain(param : pointer) : pointer;cdecl;
+      var
+        ti : tthreadinfo;
+{$ifdef DEBUG_MT}
+        // in here, don't use write/writeln before having called
+        // InitThread! I wonder if anyone ever debugged these routines,
+        // because they will have crashed if DEBUG_MT was enabled!
+        // this took me the good part of an hour to figure out
+        // why it was crashing all the time!
+        // this is kind of a workaround, we simply write(2) to fd 0
+        s: string[100]; // not an ansistring
+{$endif DEBUG_MT}
+      begin
+{$ifdef DEBUG_MT}
+        s := 'New thread started, initing threadvars'#10;
+        fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+{$ifdef HASTHREADVAR}
+        { Allocate local thread vars, this must be the first thing,
+          because the exception management and io depends on threadvars }
+        CAllocateThreadVars;
+{$endif HASTHREADVAR}
+        { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+        s := 'New thread started, initialising ...'#10;
+        fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+        ti:=pthreadinfo(param)^;
+        dispose(pthreadinfo(param));
+        { Initialize thread }
+        InitThread(ti.stklen);
+        { Start thread function }
+{$ifdef DEBUG_MT}
+        writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+        ThreadMain:=pointer(ti.f(ti.p));
+        DoneThread;
+        pthread_detach(pthread_t(pthread_self()));
+      end;
+
+
+    function BeBeginThread(sa : Pointer;stacksize : dword;
+                         ThreadFunction : tthreadfunc;p : pointer;
+                         creationFlags : dword; var ThreadId : THandle) : DWord;
+      var
+        ti : pthreadinfo;
+        thread_attr : pthread_attr_t;
+      begin
+{$ifdef DEBUG_MT}
+        writeln('Creating new thread');
+{$endif DEBUG_MT}
+        { Initialize multithreading if not done }
+        if not IsMultiThread then
+         begin
+{$ifdef HASTHREADVAR}
+          { We're still running in single thread mode, setup the TLS }
+           pthread_key_create(@TLSKey,nil);
+           InitThreadVars(@CRelocateThreadvar);
+{$endif HASTHREADVAR}
+           IsMultiThread:=true;
+         end;
+        { the only way to pass data to the newly created thread
+          in a MT safe way, is to use the heap }
+        new(ti);
+        ti^.f:=ThreadFunction;
+        ti^.p:=p;
+        ti^.stklen:=stacksize;
+        { call pthread_create }
+{$ifdef DEBUG_MT}
+        writeln('Starting new thread');
+{$endif DEBUG_MT}
+        pthread_attr_init(@thread_attr);
+        pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
+
+        // will fail under linux -- apparently unimplemented
+        pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
+
+        // don't create detached, we need to be able to join (waitfor) on
+        // the newly created thread!
+        //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
+        if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
+          threadid := 0;
+        end;
+        BeBeginThread:=threadid;
+{$ifdef DEBUG_MT}
+        writeln('BeginThread returning ',BeBeginThread);
+{$endif DEBUG_MT}
+      end;
+
+
+    procedure BeEndThread(ExitCode : DWord);
+      begin
+        DoneThread;
+        pthread_detach(pthread_t(pthread_self()));
+        pthread_exit(pointer(ExitCode));
+      end;
+
+
+{$warning threadhandle can be larger than a dword}
+    function  BeSuspendThread (threadHandle : dword) : dword;
+    begin
+      {$Warning SuspendThread needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeResumeThread  (threadHandle : dword) : dword;
+    begin
+      {$Warning ResumeThread needs to be implemented}
+    end;
+
+    procedure CThreadSwitch;  {give time to other threads}
+    begin
+      {extern int pthread_yield (void) __THROW;}
+      {$Warning ThreadSwitch needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeKillThread (threadHandle : dword) : dword;
+    begin
+      pthread_detach(pthread_t(threadHandle));
+      CKillThread := pthread_cancel(pthread_t(threadHandle));
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout}
+    var
+      LResultP: Pointer;
+      LResult: DWord;
+    begin
+      LResult := 0;
+      LResultP := @LResult;
+      pthread_join(pthread_t(threadHandle), @LResultP);
+      CWaitForThreadTerminate := LResult;
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
+    begin
+      {$Warning ThreadSetPriority needs to be implemented}
+    end;
+
+
+{$warning threadhandle can be larger than a dword}
+    function  BeThreadGetPriority (threadHandle : dword): Integer;
+    begin
+      {$Warning ThreadGetPriority needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeGetCurrentThreadId : dword;
+    begin
+      CGetCurrentThreadId:=dword(pthread_self());
+    end;
+
+
+{*****************************************************************************
+                          Delphi/Win32 compatibility
+*****************************************************************************}
+
+    procedure BeInitCriticalSection(var CS);
+
+    var
+      MAttr : pthread_mutexattr_t;
+      res: longint;
+    begin
+      res:=pthread_mutexattr_init(@MAttr);
+      if res=0 then
+        begin
+          res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+          if res=0 then
+            res := pthread_mutex_init(@CS,@MAttr)
+          else
+            { No recursive mutex support :/ }
+            res := pthread_mutex_init(@CS,NIL);
+        end
+      else 
+        res:= pthread_mutex_init(@CS,NIL);
+      pthread_mutexattr_destroy(@MAttr);
+      if res <> 0 then
+        runerror(6);
+    end;                           
+
+    procedure BeEnterCriticalSection(var CS);
+      begin
+         if pthread_mutex_lock(@CS) <> 0 then
+           runerror(6);
+      end;
+
+    procedure BeLeaveCriticalSection(var CS);
+      begin
+         if pthread_mutex_unlock(@CS) <> 0 then
+           runerror(6)
+      end;
+
+    procedure BeDoneCriticalSection(var CS);
+      begin
+         if pthread_mutex_destroy(@CS) <> 0 then
+           runerror(6);
+      end;
+
+
+{*****************************************************************************
+                           Heap Mutex Protection
+*****************************************************************************}
+
+    var
+      HeapMutex : pthread_mutex_t;
+
+    procedure BeThreadHeapMutexInit;
+      begin
+         pthread_mutex_init(@heapmutex,nil);
+      end;
+
+    procedure BeThreadHeapMutexDone;
+      begin
+         pthread_mutex_destroy(@heapmutex);
+      end;
+
+    procedure BeThreadHeapMutexLock;
+      begin
+         pthread_mutex_lock(@heapmutex);
+      end;
+
+    procedure BeThreadHeapMutexUnlock;
+      begin
+         pthread_mutex_unlock(@heapmutex);
+      end;
+
+    const
+      BeThreadMemoryMutexManager : TMemoryMutexManager = (
+        MutexInit : @BeThreadHeapMutexInit;
+        MutexDone : @BeThreadHeapMutexDone;
+        MutexLock : @BeThreadHeapMutexLock;
+        MutexUnlock : @BeThreadHeapMutexUnlock;
+      );
+
+    procedure InitHeapMutexes;
+      begin
+        SetMemoryMutexManager(BeThreadMemoryMutexManager);
+      end;
+
+Function BeInitThreads : Boolean;
+
+begin
+{$ifdef DEBUG_MT}
+  Writeln('Entering InitThreads.');
+{$endif}  
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=LoadPthreads;
+{$endif}
+  ThreadID := SizeUInt (pthread_self);
+{$ifdef DEBUG_MT}
+  Writeln('InitThreads : ',Result);
+{$endif DEBUG_MT}
+end;
+
+Function BeDoneThreads : Boolean;
+
+begin
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=UnloadPthreads;
+{$endif}
+end;
+
+type
+     TPthreadMutex = pthread_mutex_t;
+     Tbasiceventstate=record
+         FSem: Pointer;
+         FManualReset: Boolean;
+         FEventSection: TPthreadMutex;
+	end;
+     plocaleventstate = ^tbasiceventstate;  
+//     peventstate=pointer;
+
+Const 
+	wrSignaled = 0;
+	wrTimeout  = 1;
+	wrAbandoned= 2;
+	wrError	   = 3;
+
+function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+var
+  MAttr : pthread_mutexattr_t;
+  res   : cint;
+
+
+begin
+  new(plocaleventstate(result));
+  plocaleventstate(result)^.FManualReset:=AManualReset;
+  plocaleventstate(result)^.FSem:=New(PSemaphore);  //sem_t.
+//  plocaleventstate(result)^.feventsection:=nil;
+  res:=pthread_mutexattr_init(@MAttr);
+  if res=0 then
+    begin
+      res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+      if Res=0 then
+        Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
+      else
+        res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+    end
+  else
+    res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+  pthread_mutexattr_destroy(@MAttr);
+  if res <> 0 then
+    runerror(6);
+  if sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState)) <> 0 then
+    runerror(6);
+end;
+
+procedure Intbasiceventdestroy(state:peventstate);
+
+begin
+  sem_destroy(psem_t(  plocaleventstate(state)^.FSem));
+end;
+
+procedure IntbasiceventResetEvent(state:peventstate);
+
+begin
+  While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
+    ;
+end;
+
+procedure IntbasiceventSetEvent(state:peventstate);
+
+Var
+  Value : Longint;
+
+begin
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  Try
+    sem_getvalue(plocaleventstate(state)^.FSem,@value);
+    if Value=0 then
+      sem_post(psem_t( plocaleventstate(state)^.FSem));
+  finally
+    pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+  end;
+end;
+
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+  If TimeOut<>Cardinal($FFFFFFFF) then
+    result:=wrError
+  else
+    begin
+      sem_wait(psem_t(plocaleventstate(state)^.FSem));
+      result:=wrSignaled;
+      if plocaleventstate(state)^.FManualReset then
+        begin
+          pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+          Try
+              intbasiceventresetevent(State);
+              sem_post(psem_t( plocaleventstate(state)^.FSem));
+            Finally
+          pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+        end;
+      end;
+    end;
+end;
+
+Var
+  BeThreadManager : TThreadManager;
+
+Procedure SetBeThreadManager;
+
+begin
+  With BeThreadManager do
+    begin
+    InitManager            :=@BeInitThreads;
+    DoneManager            :=@BeDoneThreads;
+    BeginThread            :=@BeBeginThread;
+    EndThread              :=@BeEndThread;
+    SuspendThread          :=@BeSuspendThread;
+    ResumeThread           :=@BeResumeThread;
+    KillThread             :=@BeKillThread;
+    ThreadSwitch           :=@BeThreadSwitch;
+    WaitForThreadTerminate :=@BeWaitForThreadTerminate;
+    ThreadSetPriority      :=@BeThreadSetPriority;
+    ThreadGetPriority      :=@BeThreadGetPriority;
+    GetCurrentThreadId     :=@BeGetCurrentThreadId;
+    InitCriticalSection    :=@BeInitCriticalSection;
+    DoneCriticalSection    :=@BeDoneCriticalSection;
+    EnterCriticalSection   :=@BeEnterCriticalSection;
+    LeaveCriticalSection   :=@BeLeaveCriticalSection;
+{$ifdef hasthreadvar}
+    InitThreadVar          :=@BeInitThreadVar;
+    RelocateThreadVar      :=@BeRelocateThreadVar;
+    AllocateThreadVars     :=@BeAllocateThreadVars;
+    ReleaseThreadVars      :=@BeReleaseThreadVars;
+{$endif}
+    BasicEventCreate       :=@intBasicEventCreate;       
+    BasicEventDestroy      :=@intBasicEventDestroy;
+    BasicEventResetEvent   :=@intBasicEventResetEvent;
+    BasicEventSetEvent     :=@intBasicEventSetEvent;
+    BasiceventWaitFor      :=@intBasiceventWaitFor;
+    end;
+  SetThreadManager(BeThreadManager);
+  InitHeapMutexes;
+end;
+
+initialization
+  SetBeThreadManager;
+end.

rtl/haiku/classes.pp

@@ -0,0 +1,52 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for BeOS
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  sysutils,
+  rtlconsts,
+  types,  
+  typinfo;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  baseunix,unix;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+
+{$ifndef ver1_0}
+  if ThreadsInited then
+     DoneThreads;
+{$endif}
+end.

rtl/haiku/errno.inc

@@ -0,0 +1,424 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    BeOS POSIX compliant error codes
+
+    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.
+
+ **********************************************************************}
+
+const
+
+  LONG_MIN = -2147483648;
+
+//----- Error baselines ---------------------------------------
+  B_GENERAL_ERROR_BASE      = LONG_MIN;
+  B_OS_ERROR_BASE           = B_GENERAL_ERROR_BASE + $1000;
+  B_APP_ERROR_BASE          = B_GENERAL_ERROR_BASE + $2000;
+  B_INTERFACE_ERROR_BASE    = B_GENERAL_ERROR_BASE + $3000;
+  B_MEDIA_ERROR_BASE        = B_GENERAL_ERROR_BASE + $4000; // - 0x41ff
+  B_TRANSLATION_ERROR_BASE  = B_GENERAL_ERROR_BASE + $4800; // - 0x48ff
+  B_MIDI_ERROR_BASE         = B_GENERAL_ERROR_BASE + $5000;
+  B_STORAGE_ERROR_BASE      = B_GENERAL_ERROR_BASE + $6000;
+  B_POSIX_ERROR_BASE        = B_GENERAL_ERROR_BASE + $7000;
+  B_MAIL_ERROR_BASE         = B_GENERAL_ERROR_BASE + $8000;
+  B_PRINT_ERROR_BASE        = B_GENERAL_ERROR_BASE + $9000;
+  B_DEVICE_ERROR_BASE       = B_GENERAL_ERROR_BASE + $a000;
+
+  //--- Developer-defined errors start at (B_ERRORS_END+1)
+  B_ERRORS_END = B_GENERAL_ERROR_BASE + $ffff;
+
+//----- General Errors ----------------------------------------
+  B_NO_MEMORY         = B_GENERAL_ERROR_BASE;
+  B_IO_ERROR          = B_GENERAL_ERROR_BASE + 1;
+  B_PERMISSION_DENIED = B_GENERAL_ERROR_BASE + 2;
+  B_BAD_INDEX         = B_GENERAL_ERROR_BASE + 3;
+  B_BAD_TYPE          = B_GENERAL_ERROR_BASE + 4;
+  B_BAD_VALUE         = B_GENERAL_ERROR_BASE + 5;
+  B_MISMATCHED_VALUES = B_GENERAL_ERROR_BASE + 6;
+  B_NAME_NOT_FOUND    = B_GENERAL_ERROR_BASE + 7;
+  B_NAME_IN_USE       = B_GENERAL_ERROR_BASE + 8;
+  B_TIMED_OUT         = B_GENERAL_ERROR_BASE + 9;
+  B_INTERRUPTED       = B_GENERAL_ERROR_BASE + 10;
+  B_WOULD_BLOCK       = B_GENERAL_ERROR_BASE + 11;
+  B_CANCELED          = B_GENERAL_ERROR_BASE + 12;
+  B_NO_INIT           = B_GENERAL_ERROR_BASE + 13;
+  B_BUSY              = B_GENERAL_ERROR_BASE + 14;
+  B_NOT_ALLOWED       = B_GENERAL_ERROR_BASE + 15;
+
+  B_ERROR = -1;
+  B_OK = 0;
+  B_NO_ERROR = 0;
+
+//----- Kernel Kit Errors -------------------------------------
+  B_BAD_SEM_ID   = B_OS_ERROR_BASE;
+  B_NO_MORE_SEMS = B_OS_ERROR_BASE + 1;
+
+  B_BAD_THREAD_ID    = B_OS_ERROR_BASE + $100;
+  B_NO_MORE_THREADS  = B_BAD_THREAD_ID + 1;
+  B_BAD_THREAD_STATE = B_BAD_THREAD_ID + 2;
+  B_BAD_TEAM_ID      = B_BAD_THREAD_ID + 3;
+  B_NO_MORE_TEAMS    = B_BAD_THREAD_ID + 4;
+
+  B_BAD_PORT_ID   = B_OS_ERROR_BASE + $200;
+  B_NO_MORE_PORTS = B_BAD_PORT_ID + 1;
+
+  B_BAD_IMAGE_ID      = B_OS_ERROR_BASE + $300;
+  B_BAD_ADDRESS       = B_BAD_IMAGE_ID + 1;
+  B_NOT_AN_EXECUTABLE = B_BAD_IMAGE_ID + 2;
+  B_MISSING_LIBRARY   = B_BAD_IMAGE_ID + 3;
+  B_MISSING_SYMBOL    = B_BAD_IMAGE_ID + 4;
+
+  B_DEBUGGER_ALREADY_INSTALLED = B_OS_ERROR_BASE + $400;
+
+//----- Application Kit Errors --------------------------------
+  B_BAD_REPLY                         = B_APP_ERROR_BASE;
+  B_DUPLICATE_REPLY                   = B_APP_ERROR_BASE + 1;
+  B_MESSAGE_TO_SELF                   = B_APP_ERROR_BASE + 2;
+  B_BAD_HANDLER                       = B_APP_ERROR_BASE + 3;
+  B_ALREADY_RUNNING                   = B_APP_ERROR_BASE + 4;
+  B_LAUNCH_FAILED                     = B_APP_ERROR_BASE + 5;
+  B_AMBIGUOUS_APP_LAUNCH              = B_APP_ERROR_BASE + 6;
+  B_UNKNOWN_MIME_TYPE                 = B_APP_ERROR_BASE + 7;
+  B_BAD_SCRIPT_SYNTAX                 = B_APP_ERROR_BASE + 8;
+  B_LAUNCH_FAILED_NO_RESOLVE_LINK     = B_APP_ERROR_BASE + 9;
+  B_LAUNCH_FAILED_EXECUTABLE          = B_APP_ERROR_BASE + 10;
+  B_LAUNCH_FAILED_APP_NOT_FOUND       = B_APP_ERROR_BASE + 11;
+  B_LAUNCH_FAILED_APP_IN_TRASH        = B_APP_ERROR_BASE + 12;
+  B_LAUNCH_FAILED_NO_PREFERRED_APP    = B_APP_ERROR_BASE + 13;
+  B_LAUNCH_FAILED_FILES_APP_NOT_FOUND = B_APP_ERROR_BASE + 14;
+  B_BAD_MIME_SNIFFER_RULE             = B_APP_ERROR_BASE + 15;
+
+//----- Storage Kit/File System Errors ------------------------
+  B_FILE_ERROR          = B_STORAGE_ERROR_BASE;
+  B_FILE_NOT_FOUND      = B_STORAGE_ERROR_BASE + 1; // discouraged; use B_ENTRY_NOT_FOUND in new code
+  B_FILE_EXISTS         = B_STORAGE_ERROR_BASE + 2;
+  B_ENTRY_NOT_FOUND     = B_STORAGE_ERROR_BASE + 3;
+  B_NAME_TOO_LONG       = B_STORAGE_ERROR_BASE + 4;
+  B_NOT_A_DIRECTORY     = B_STORAGE_ERROR_BASE + 5;
+  B_DIRECTORY_NOT_EMPTY = B_STORAGE_ERROR_BASE + 6;
+  B_DEVICE_FULL         = B_STORAGE_ERROR_BASE + 7;
+  B_READ_ONLY_DEVICE    = B_STORAGE_ERROR_BASE + 8;
+  B_IS_A_DIRECTORY      = B_STORAGE_ERROR_BASE + 9;
+  B_NO_MORE_FDS         = B_STORAGE_ERROR_BASE + 10;
+  B_CROSS_DEVICE_LINK   = B_STORAGE_ERROR_BASE + 11;
+  B_LINK_LIMIT          = B_STORAGE_ERROR_BASE + 12;
+  B_BUSTED_PIPE         = B_STORAGE_ERROR_BASE + 13;
+  B_UNSUPPORTED         = B_STORAGE_ERROR_BASE + 14;
+  B_PARTITION_TOO_SMALL = B_STORAGE_ERROR_BASE + 15;
+
+//----- POSIX Errors ------------------------------------------
+  E2BIG           = B_POSIX_ERROR_BASE + 1;
+  ECHILD          = B_POSIX_ERROR_BASE + 2;
+  EDEADLK         = B_POSIX_ERROR_BASE + 3;
+  EFBIG           = B_POSIX_ERROR_BASE + 4;
+  EMLINK          = B_POSIX_ERROR_BASE + 5;
+  ENFILE          = B_POSIX_ERROR_BASE + 6;
+  ENODEV          = B_POSIX_ERROR_BASE + 7;
+  ENOLCK          = B_POSIX_ERROR_BASE + 8;
+  ENOSYS          = B_POSIX_ERROR_BASE + 9;
+  ENOTTY          = B_POSIX_ERROR_BASE + 10;
+  ENXIO           = B_POSIX_ERROR_BASE + 11;
+  ESPIPE          = B_POSIX_ERROR_BASE + 12;
+  ESRCH           = B_POSIX_ERROR_BASE + 13;
+  EFPOS           = B_POSIX_ERROR_BASE + 14;
+  ESIGPARM        = B_POSIX_ERROR_BASE + 15;
+  EDOM            = B_POSIX_ERROR_BASE + 16;
+  ERANGE          = B_POSIX_ERROR_BASE + 17;
+  EPROTOTYPE      = B_POSIX_ERROR_BASE + 18;
+  EPROTONOSUPPORT = B_POSIX_ERROR_BASE + 19;
+  EPFNOSUPPORT    = B_POSIX_ERROR_BASE + 20;
+  EAFNOSUPPORT    = B_POSIX_ERROR_BASE + 21;
+  EADDRINUSE      = B_POSIX_ERROR_BASE + 22;
+  EADDRNOTAVAIL   = B_POSIX_ERROR_BASE + 23;
+  ENETDOWN        = B_POSIX_ERROR_BASE + 24;
+  ENETUNREACH     = B_POSIX_ERROR_BASE + 25;
+  ENETRESET       = B_POSIX_ERROR_BASE + 26;
+  ECONNABORTED    = B_POSIX_ERROR_BASE + 27;
+  ECONNRESET      = B_POSIX_ERROR_BASE + 28;
+  EISCONN         = B_POSIX_ERROR_BASE + 29;
+  ENOTCONN        = B_POSIX_ERROR_BASE + 30;
+  ESHUTDOWN       = B_POSIX_ERROR_BASE + 31;
+  ECONNREFUSED    = B_POSIX_ERROR_BASE + 32;
+  EHOSTUNREACH    = B_POSIX_ERROR_BASE + 33;
+  ENOPROTOOPT     = B_POSIX_ERROR_BASE + 34;
+  ENOBUFS         = B_POSIX_ERROR_BASE + 35;
+  EINPROGRESS     = B_POSIX_ERROR_BASE + 36;
+  EALREADY        = B_POSIX_ERROR_BASE + 37;
+  EILSEQ          = B_POSIX_ERROR_BASE + 38;
+  ENOMSG          = B_POSIX_ERROR_BASE + 39;
+  ESTALE          = B_POSIX_ERROR_BASE + 40;
+  EOVERFLOW       = B_POSIX_ERROR_BASE + 41;
+  EMSGSIZE        = B_POSIX_ERROR_BASE + 42;
+  EOPNOTSUPP      = B_POSIX_ERROR_BASE + 43;                      
+  ENOTSOCK        = B_POSIX_ERROR_BASE + 44;
+
+  ENOMEM       = B_NO_MEMORY;
+  EACCES       = B_PERMISSION_DENIED;
+  EINTR        = B_INTERRUPTED;
+  EIO          = B_IO_ERROR;
+  EBUSY        = B_BUSY;
+  EFAULT       = B_BAD_ADDRESS;
+  ETIMEDOUT    = B_TIMED_OUT;
+  EAGAIN       = B_WOULD_BLOCK; // SysV compatibility
+  EWOULDBLOCK  = B_WOULD_BLOCK; // BSD compatibility
+  EBADF        = B_FILE_ERROR;
+  EEXIST       = B_FILE_EXISTS;
+  EINVAL       = B_BAD_VALUE;
+  ENAMETOOLONG = B_NAME_TOO_LONG;
+  ENOENT       = B_ENTRY_NOT_FOUND;
+  EPERM        = B_NOT_ALLOWED;
+  ENOTDIR      = B_NOT_A_DIRECTORY;
+  EISDIR       = B_IS_A_DIRECTORY;
+  ENOTEMPTY    = B_DIRECTORY_NOT_EMPTY;
+  ENOSPC       = B_DEVICE_FULL;
+  EROFS        = B_READ_ONLY_DEVICE;
+  EMFILE       = B_NO_MORE_FDS;
+  EXDEV        = B_CROSS_DEVICE_LINK;
+  ELOOP        = B_LINK_LIMIT;
+  ENOEXEC      = B_NOT_AN_EXECUTABLE;
+  EPIPE        = B_BUSTED_PIPE;
+
+//----- Media Kit Errors --------------------------------------
+  B_STREAM_NOT_FOUND       = B_MEDIA_ERROR_BASE;
+  B_SERVER_NOT_FOUND       = B_MEDIA_ERROR_BASE + 1;
+  B_RESOURCE_NOT_FOUND     = B_MEDIA_ERROR_BASE + 2;
+  B_RESOURCE_UNAVAILABLE   = B_MEDIA_ERROR_BASE + 3;
+  B_BAD_SUBSCRIBER         = B_MEDIA_ERROR_BASE + 4;
+  B_SUBSCRIBER_NOT_ENTERED = B_MEDIA_ERROR_BASE + 5;
+  B_BUFFER_NOT_AVAILABLE   = B_MEDIA_ERROR_BASE + 6;
+  B_LAST_BUFFER_ERROR      = B_MEDIA_ERROR_BASE + 7;
+
+//----- Mail Kit Errors ---------------------------------------
+  B_MAIL_NO_DAEMON      = B_MAIL_ERROR_BASE;
+  B_MAIL_UNKNOWN_USER   = B_MAIL_ERROR_BASE + 1;
+  B_MAIL_WRONG_PASSWORD = B_MAIL_ERROR_BASE + 2;
+  B_MAIL_UNKNOWN_HOST   = B_MAIL_ERROR_BASE + 3;
+  B_MAIL_ACCESS_ERROR   = B_MAIL_ERROR_BASE + 4;
+  B_MAIL_UNKNOWN_FIELD  = B_MAIL_ERROR_BASE + 5;
+  B_MAIL_NO_RECIPIENT   = B_MAIL_ERROR_BASE + 6;
+  B_MAIL_INVALID_MAIL   = B_MAIL_ERROR_BASE + 7;
+
+//----- Printing Errors --------------------------------------
+  B_NO_PRINT_SERVER = B_PRINT_ERROR_BASE;
+
+//----- Device Kit Errors -------------------------------------
+  B_DEV_INVALID_IOCTL          = B_DEVICE_ERROR_BASE;
+  B_DEV_NO_MEMORY              = B_DEVICE_ERROR_BASE + 1;
+  B_DEV_BAD_DRIVE_NUM          = B_DEVICE_ERROR_BASE + 2;
+  B_DEV_NO_MEDIA               = B_DEVICE_ERROR_BASE + 3;
+  B_DEV_UNREADABLE             = B_DEVICE_ERROR_BASE + 4;
+  B_DEV_FORMAT_ERROR           = B_DEVICE_ERROR_BASE + 5;
+  B_DEV_TIMEOUT                = B_DEVICE_ERROR_BASE + 6;
+  B_DEV_RECALIBRATE_ERROR      = B_DEVICE_ERROR_BASE + 7;
+  B_DEV_SEEK_ERROR             = B_DEVICE_ERROR_BASE + 8;
+  B_DEV_ID_ERROR               = B_DEVICE_ERROR_BASE + 9;
+  B_DEV_READ_ERROR             = B_DEVICE_ERROR_BASE + 10;
+  B_DEV_WRITE_ERROR            = B_DEVICE_ERROR_BASE + 11;
+  B_DEV_NOT_READY              = B_DEVICE_ERROR_BASE + 12;
+  B_DEV_MEDIA_CHANGED          = B_DEVICE_ERROR_BASE + 13;
+  B_DEV_MEDIA_CHANGE_REQUESTED = B_DEVICE_ERROR_BASE + 14;
+  B_DEV_RESOURCE_CONFLICT      = B_DEVICE_ERROR_BASE + 15;
+  B_DEV_CONFIGURATION_ERROR    = B_DEVICE_ERROR_BASE + 16;
+  B_DEV_DISABLED_BY_USER       = B_DEVICE_ERROR_BASE + 17;
+  B_DEV_DOOR_OPEN              = B_DEVICE_ERROR_BASE + 18;
+
+//-------------------------------------------------------------
+(*
+{----- Error baselines ---------------------------------------}
+
+    B_GENERAL_ERROR_BASE        =   -2147483647-1;
+    B_OS_ERROR_BASE             =   B_GENERAL_ERROR_BASE + $1000;
+    B_APP_ERROR_BASE            =   B_GENERAL_ERROR_BASE + $2000;
+    B_INTERFACE_ERROR_BASE      =   B_GENERAL_ERROR_BASE + $3000;
+    B_MEDIA_ERROR_BASE          =   B_GENERAL_ERROR_BASE + $4000; {* - $41ff *}
+    B_TRANSLATION_ERROR_BASE    =   B_GENERAL_ERROR_BASE + $4800; {* - $48ff *}
+    B_MIDI_ERROR_BASE           =   B_GENERAL_ERROR_BASE + $5000;
+    B_STORAGE_ERROR_BASE        =   B_GENERAL_ERROR_BASE + $6000;
+    B_POSIX_ERROR_BASE          =   B_GENERAL_ERROR_BASE + $7000;
+    B_MAIL_ERROR_BASE           =   B_GENERAL_ERROR_BASE + $8000;
+    B_PRINT_ERROR_BASE          =   B_GENERAL_ERROR_BASE + $9000;
+    B_DEVICE_ERROR_BASE         =   B_GENERAL_ERROR_BASE + $a000;
+
+{--- Developer-defined errors start at (B_ERRORS_END+1)----}
+
+    B_ERRORS_END        =       (B_GENERAL_ERROR_BASE + $ffff);
+
+type
+{----- General Errors ----------------------------------------}
+tgeneralerrors=  (
+	B_NO_MEMORY := B_GENERAL_ERROR_BASE,
+	B_IO_ERROR,
+	B_PERMISSION_DENIED,
+	B_BAD_INDEX,
+	B_BAD_TYPE,
+	B_BAD_VALUE,
+	B_MISMATCHED_VALUES,
+	B_NAME_NOT_FOUND,
+	B_NAME_IN_USE,
+	B_TIMED_OUT,
+    B_INTERRUPTED,
+	B_WOULD_BLOCK,
+    B_CANCELED,
+	B_NO_INIT,
+	B_BUSY,
+	B_NOT_ALLOWED,
+
+	B_ERROR := -1,
+	B_OK := 0,
+	B_NO_ERROR := 0
+);
+
+{----- Kernel Kit Errors -------------------------------------}
+tkernelerror  = (
+	B_BAD_SEM_ID := B_OS_ERROR_BASE,
+	B_NO_MORE_SEMS,
+
+	B_BAD_THREAD_ID := B_OS_ERROR_BASE + $100,
+	B_NO_MORE_THREADS,
+	B_BAD_THREAD_STATE,
+	B_BAD_TEAM_ID,
+	B_NO_MORE_TEAMS,
+
+	B_BAD_PORT_ID := B_OS_ERROR_BASE + $200,
+	B_NO_MORE_PORTS,
+
+	B_BAD_IMAGE_ID := B_OS_ERROR_BASE + $300,
+	B_BAD_ADDRESS,
+	B_NOT_AN_EXECUTABLE,
+	B_MISSING_LIBRARY,
+	B_MISSING_SYMBOL,
+
+	B_DEBUGGER_ALREADY_INSTALLED := B_OS_ERROR_BASE + $400
+);
+
+
+{----- Application Kit Errors --------------------------------}
+tapperrors =
+(
+	B_BAD_REPLY := B_APP_ERROR_BASE,
+	B_DUPLICATE_REPLY,
+	B_MESSAGE_TO_SELF,
+	B_BAD_HANDLER,
+	B_ALREADY_RUNNING,
+	B_LAUNCH_FAILED,
+	B_AMBIGUOUS_APP_LAUNCH,
+	B_UNKNOWN_MIME_TYPE,
+	B_BAD_SCRIPT_SYNTAX,
+	B_LAUNCH_FAILED_NO_RESOLVE_LINK,
+	B_LAUNCH_FAILED_EXECUTABLE,
+	B_LAUNCH_FAILED_APP_NOT_FOUND,
+	B_LAUNCH_FAILED_APP_IN_TRASH,
+	B_LAUNCH_FAILED_NO_PREFERRED_APP,
+	B_LAUNCH_FAILED_FILES_APP_NOT_FOUND
+);
+
+
+{----- Storage Kit/File System Errors ------------------------}
+tfserrors= (
+	B_FILE_ERROR :=B_STORAGE_ERROR_BASE,
+	B_FILE_NOT_FOUND,       { discouraged; use B_ENTRY_NOT_FOUND in new code }
+	B_FILE_EXISTS,
+	B_ENTRY_NOT_FOUND,
+	B_NAME_TOO_LONG,
+	B_NOT_A_DIRECTORY,
+	B_DIRECTORY_NOT_EMPTY,
+	B_DEVICE_FULL,
+	B_READ_ONLY_DEVICE,
+	B_IS_A_DIRECTORY,
+	B_NO_MORE_FDS,
+	B_CROSS_DEVICE_LINK,
+	B_LINK_LIMIT,
+	B_BUSTED_PIPE,
+	B_UNSUPPORTED,
+	B_PARTITION_TOO_SMALL
+);
+
+*)
+const
+
+{***********************************************************************}
+{                       POSIX ERROR DEFINITIONS                         }
+{***********************************************************************}
+
+    { The following constants are system dependent but must all exist }
+    ESysE2BIG       = (B_POSIX_ERROR_BASE + 1);
+    ESysEACCES      = ord(B_PERMISSION_DENIED);
+    ESysEAGAIN      = ord(B_WOULD_BLOCK);
+    ESysEBADF       = ord(B_FILE_ERROR);
+    ESysEBUSY       = ord(B_BUSY);
+    ESysECHILD      = (B_POSIX_ERROR_BASE + 2);
+    ESysEDEADLK     = (B_POSIX_ERROR_BASE + 3);
+    ESysEDOM        = (B_POSIX_ERROR_BASE + 16);
+    ESysEEXIST      = ord(B_FILE_EXISTS);
+    ESysEFAULT      = ord(B_BAD_ADDRESS);
+    ESysEFBIG       = (B_POSIX_ERROR_BASE + 4);
+    ESysEINTR       = ord(B_INTERRUPTED);
+    ESysEINVAL      = ord(B_BAD_VALUE);
+    ESysEIO         = ord(B_IO_ERROR);
+    ESysEISDIR      = ord(B_IS_A_DIRECTORY);
+    ESysEMFILE      = ord(B_NO_MORE_FDS);
+    ESysEMLINK      = (B_POSIX_ERROR_BASE + 5);
+    ESysENAMETOOLONG= ord(B_NAME_TOO_LONG);
+    ESysENFILE      = (B_POSIX_ERROR_BASE + 6);
+    ESysENODEV      = (B_POSIX_ERROR_BASE + 7);
+    ESysENOENT      = ord(B_ENTRY_NOT_FOUND);
+    ESysENOEXEC     = ord(B_NOT_AN_EXECUTABLE);
+    ESysENOLCK      = (B_POSIX_ERROR_BASE + 8);
+    ESysENOMEM      = ord(B_NO_MEMORY);
+    ESysENOSPC      = ord(B_DEVICE_FULL);
+    ESysENOSYS      = (B_POSIX_ERROR_BASE + 9);
+    ESysENOTDIR     = ord(B_NOT_A_DIRECTORY);
+    ESysENOTEMPTY   = ord(B_DIRECTORY_NOT_EMPTY);
+    ESysENOTTY      = (B_POSIX_ERROR_BASE + 10);
+    ESysENXIO       = (B_POSIX_ERROR_BASE + 11);
+    ESysEPERM       = ord(B_NOT_ALLOWED);
+    ESysEPIPE       = ord(B_BUSTED_PIPE);
+    ESysERANGE      = (B_POSIX_ERROR_BASE + 17);
+    ESysEROFS       = ord(B_READ_ONLY_DEVICE);
+    ESysESPIPE      = (B_POSIX_ERROR_BASE + 12);
+    ESysESRCH       = (B_POSIX_ERROR_BASE + 13);
+    ESysETIMEDOUT   = ord(B_TIMED_OUT);
+    ESysEXDEV       = ord(B_CROSS_DEVICE_LINK);
+
+    {ESysEBADMSG     =    realtime extension POSIX only   }
+    {ESysECANCELED   =    async. I/O extension POSIX only }
+    {ESysEMSGSIZE    =    realtime extension POSIX only   }
+    {ESysEINPROGRESS =    async. I/O extension POSIX only }
+
+{***********************************************************************}
+{                   NON POSIX ERROR DEFINITIONS                         }
+{***********************************************************************}
+     EsysEFPOS           = (B_POSIX_ERROR_BASE + 14);
+     EsysESIGPARM        = (B_POSIX_ERROR_BASE + 15);
+     EsysEPROTOTYPE      = (B_POSIX_ERROR_BASE + 18);
+     EsysEPROTONOSUPPORT = (B_POSIX_ERROR_BASE + 19);
+     EsysEPFNOSUPPORT    = (B_POSIX_ERROR_BASE + 20);
+     EsysEAFNOSUPPORT    = (B_POSIX_ERROR_BASE + 21);
+     EsysEADDRINUSE      = (B_POSIX_ERROR_BASE + 22);
+     EsysEADDRNOTAVAIL   = (B_POSIX_ERROR_BASE + 23);
+     EsysENETDOWN        = (B_POSIX_ERROR_BASE + 24);
+     EsysENETUNREACH     = (B_POSIX_ERROR_BASE + 25);
+     EsysENETRESET       = (B_POSIX_ERROR_BASE + 26);
+     EsysECONNABORTED    = (B_POSIX_ERROR_BASE + 27);
+     EsysECONNRESET       = (B_POSIX_ERROR_BASE + 28);
+
+     EsysEISCONN      = (B_POSIX_ERROR_BASE + 29);
+     EsysENOTCONN     = (B_POSIX_ERROR_BASE + 30);
+     EsysESHUTDOWN    = (B_POSIX_ERROR_BASE + 31);
+     EsysECONNREFUSED = (B_POSIX_ERROR_BASE + 32);
+     EsysEHOSTUNREACH = (B_POSIX_ERROR_BASE + 33);
+     EsysENOPROTOOPT  = (B_POSIX_ERROR_BASE + 34);
+     EsysENOBUFS      = (B_POSIX_ERROR_BASE + 35);
+     EsysEINPROGRESS  = (B_POSIX_ERROR_BASE + 36);
+     EsysEALREADY     = (B_POSIX_ERROR_BASE + 37);
+
+     EsysEWOULDBLOCK  = ord(B_WOULD_BLOCK);  {* BSD compatibility *}
+     EsysELOOP        = ord(B_LINK_LIMIT);
+

rtl/haiku/errnostr.inc

@@ -0,0 +1,150 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    Contains BeOS specific errors for error.pp in rtl/unix
+
+    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.
+
+ **********************************************************************}
+
+const
+  // TODO : check against BeOS real values...
+  sys_errn=125;
+  sys_errlist:array[0..sys_errn-1] of pchar = (
+        'Success',                              { 0 }
+        'Operation not permitted',              { EPERM }
+        'No such file or directory',            { ENOENT }
+        'No such process',                      { ESRCH }
+        'Interrupted system call',              { EINTR }
+        'I/O error',                            { EIO }
+        'No such device or address',            { ENXIO }
+        'Arg list too long',                    { E2BIG }
+        'Exec format error',                    { ENOEXEC }
+        'Bad file number',                      { EBADF }
+        'No child processes',                   { ECHILD }
+        'Try again',                            { EAGAIN }
+        'Out of memory',                        { ENOMEM }
+        'Permission denied',                    { EACCES }
+        'Bad address',                          { EFAULT }
+        'Block device required',                { ENOTBLK }
+        'Device or resource busy',              { EBUSY }
+        'File exists',                          { EEXIST }
+        'Cross-device link',                    { EXDEV }
+        'No such device',                       { ENODEV }
+        'Not a directory',                      { ENOTDIR }
+        'Is a directory',                       { EISDIR }
+        'Invalid argument',                     { EINVAL }
+        'File table overflow',                  { ENFILE }
+        'Too many open files',                  { EMFILE }
+        'Not a typewriter',                     { ENOTTY }
+        'Text (code segment) file busy',        { ETXTBSY  Text file busy.  The new process was
+                                                    a pure procedure (shared text) file which was
+                                                    open for writing by another process, or file
+                                                    which was open for writing by another process,
+                                                    or while the pure procedure file was being
+                                                    executed an open(2) call requested write access
+                                                    requested write access.}
+        'File too large',                       { EFBIG }
+        'No space left on device',              { ENOSPC }
+        'Illegal seek',                         { ESPIPE }
+        'Read-only file system',                { EROFS }
+        'Too many links',                       { EMLINK }
+        'Broken pipe',                          { EPIPE }
+        'Math argument out of domain of func',  { EDOM }
+        'Math result not representable',        { ERANGE }
+        'Resource deadlock would occur',        { EDEADLK }
+        'File name too long',                   { ENAMETOOLONG }
+        'No record locks available',            { ENOLCK }
+        'Function not implemented',             { ENOSYS }
+        'Directory not empty',                  { ENOTEMPTY }
+        'Too many symbolic links encountered',  { ELOOP }
+        'Operation would block',                { EWOULDBLOCK }
+        'No message of desired type',           { ENOMSG }
+        'Identifier removed',                   { EIDRM }
+        'Channel number out of range',          { ECHRNG }
+        'Level 2 not synchronized',             { EL2NSYNC }
+        'Level 3 halted',                       { EL3HLT }
+        'Level 3 reset',                        { EL3RST }
+        'Link number out of range',             { ELNRNG }
+        'Protocol driver not attached',         { EUNATCH }
+        'No CSI structure available',           { ENOCSI }
+        'Level 2 halted',                       { EL2HLT }
+        'Invalid exchange',                     { EBADE }
+        'Invalid request descriptor',           { EBADR }
+        'Exchange full',                        { EXFULL }
+        'No anode',                             { ENOANO }
+        'Invalid request code',                 { EBADRQC }
+        'Invalid slot',                         { EBADSLT }
+        'File locking deadlock error',          { EDEADLOCK }
+        'Bad font file format',                 { EBFONT }
+        'Device not a stream',                  { ENOSTR }
+        'No data available',                    { ENODATA }
+        'Timer expired',                        { ETIME }
+        'Out of streams resources',             { ENOSR }
+        'Machine is not on the network',        { ENONET }
+        'Package not installed',                { ENOPKG }
+        'Object is remote',                     { EREMOTE }
+        'Link has been severed',                { ENOLINK }
+        'Advertise error',                      { EADV }
+        'Srmount error',                        { ESRMNT }
+        'Communication error on send',          { ECOMM }
+        'Protocol error',                       { EPROTO }
+        'Multihop attempted',                   { EMULTIHOP }
+        'RFS specific error',                   { EDOTDOT }
+        'Not a data message',                   { EBADMSG }
+        'Value too large for defined data type',        { EOVERFLOW }
+        'Name not unique on network',           { ENOTUNIQ }
+        'File descriptor in bad state',         { EBADFD }
+        'Remote address changed',               { EREMCHG }
+        'Can not access a needed shared library',       { ELIBACC }
+        'Accessing a corrupted shared library',         { ELIBBAD }
+        '.lib section in a.out corrupted',      { ELIBSCN }
+        'Attempting to link in too many shared libraries',      { ELIBMAX }
+        'Cannot exec a shared library directly',        { ELIBEXEC }
+        'Illegal byte sequence',                { EILSEQ }
+        'Interrupted system call should be restarted',  { ERESTART }
+        'Streams pipe error',                   { ESTRPIPE }
+        'Too many users',                       { EUSERS }
+        'Socket operation on non-socket',       { ENOTSOCK }
+        'Destination address required',         { EDESTADDRREQ }
+        'Message too long',                     { EMSGSIZE }
+        'Protocol wrong type for socket',       { EPROTOTYPE }
+        'Protocol not available',               { ENOPROTOOPT }
+        'Protocol not supported',               { EPROTONOSUPPORT }
+        'Socket type not supported',            { ESOCKTNOSUPPORT }
+        'Operation not supported on transport endpoint',        { EOPNOTSUPP }
+        'Protocol family not supported',        { EPFNOSUPPORT }
+        'Address family not supported by protocol',     { EAFNOSUPPORT }
+        'Address already in use',               { EADDRINUSE }
+        'Cannot assign requested address',      { EADDRNOTAVAIL }
+        'Network is down',                      { ENETDOWN }
+        'Network is unreachable',               { ENETUNREACH }
+        'Network dropped connection because of reset',  { ENETRESET }
+        'Software caused connection abort',     { ECONNABORTED }
+        'Connection reset by peer',             { ECONNRESET }
+        'No buffer space available',            { ENOBUFS }
+        'Transport endpoint is already connected',      { EISCONN }
+        'Transport endpoint is not connected',  { ENOTCONN }
+        'Cannot send after transport endpoint shutdown',        { ESHUTDOWN }
+        'Too many references: cannot splice',   { ETOOMANYREFS }
+        'Connection timed out',                 { ETIMEDOUT }
+        'Connection refused',                   { ECONNREFUSED }
+        'Host is down',                         { EHOSTDOWN }
+        'No route to host',                     { EHOSTUNREACH }
+        'Operation already in progress',        { EALREADY }
+        'Operation now in progress',            { EINPROGRESS }
+        'Stale NFS file handle',                { ESTALE }
+        'Structure needs cleaning',             { EUCLEAN }
+        'Not a XENIX named type file',          { ENOTNAM }
+        'No XENIX semaphores available',        { ENAVAIL }
+        'Is a named type file',                 { EISNAM }
+        'Remote I/O error',                     { EREMOTEIO }
+        'Quota exceeded',                       { EDQUOT }
+        'No medium found',                      { ENOMEDIUM }
+        'Wrong medium type');                   { EMEDIUMTYPE }

rtl/haiku/i386/cprt0.as

@@ -0,0 +1,223 @@
+       .file   "cprt0.s"
+.data
+        .align 4
+default_environ:
+        .long 0
+.text
+.globl _start
+        .type    _start,@function
+_start:
+        pushl %ebp
+        movl %esp,%ebp
+        subl $4,%esp
+        pushl %ebx
+        call .L6
+.L6:
+        popl %ebx
+        addl $_GLOBAL_OFFSET_TABLE_+[.-.L6],%ebx
+        movl argv_save@GOT(%ebx),%eax
+        movl 12(%ebp),%edi
+        movl %edi,(%eax)
+        movl environ@GOT(%ebx),%eax
+        movl 16(%ebp),%esi
+        movl %esi,(%eax)
+        test %esi,%esi
+        jnz .L4
+        movl environ@GOT(%ebx),%eax
+        movl %ebx,%ecx
+        addl $default_environ@GOTOFF,%ecx
+        movl %ecx,%edx
+        movl %edx,(%eax)
+.L4:
+/*      movl %fs:0x4,%eax   this doesn't work on BeOS 4.0, let's use find_thread instead */
+        pushl $0x0
+        call find_thread
+        movl __main_thread_id@GOT(%ebx),%edx
+        movl %eax,(%edx)
+        pushl %esi
+        pushl %edi
+        movl 8(%ebp),%eax
+        pushl %eax
+        call _init_c_library_
+        call _call_init_routines_
+        movl 8(%ebp),%eax
+        movl %eax,operatingsystem_parameter_argc
+        movl %edi,operatingsystem_parameter_argv
+        movl %esi,operatingsystem_parameter_envp        
+        xorl %ebp,%ebp
+        call PASCALMAIN
+
+.globl  _haltproc
+.type   _haltproc,@function
+_haltproc:
+        call _thread_do_exit_notification
+        xorl %ebx,%ebx
+    movw operatingsystem_result,%bx
+        pushl %ebx
+        call exit
+
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret
+
+/* actual syscall */
+.globl sys_call
+.type sys_call,@function
+sys_call:
+int $0x25
+ret
+
+.bss
+        .comm operatingsystem_parameter_envp,4
+        .comm operatingsystem_parameter_argc,4
+        .comm operatingsystem_parameter_argv,4
+	

rtl/haiku/i386/dllprt.as

@@ -0,0 +1,170 @@
+       .file   "dllprt.cpp"
+.text
+        .p2align 2
+.globl _._7FPC_DLL
+        .type    _._7FPC_DLL,@function
+_._7FPC_DLL:
+.LFB1:
+        pushl %ebp
+.LCFI0:
+        movl %esp,%ebp
+.LCFI1:
+        pushl %esi
+.LCFI2:
+        pushl %ebx
+.LCFI3:
+        call .L7
+.L7:
+        popl %ebx
+        addl $_GLOBAL_OFFSET_TABLE_+[.-.L7],%ebx
+        movl 8(%ebp),%esi
+.L3:
+        movl 12(%ebp),%eax
+        andl $1,%eax
+        testl %eax,%eax
+        je .L5
+        pushl %esi
+.LCFI4:
+        call __builtin_delete@PLT
+        addl $4,%esp
+        jmp .L5
+        .p2align 4,,7
+.L4:
+.L5:
+.L2:
+        leal -8(%ebp),%esp
+        popl %ebx
+        popl %esi
+        movl %ebp,%esp
+        popl %ebp
+        ret
+.LFE1:
+.Lfe1:
+        .size    _._7FPC_DLL,.Lfe1-_._7FPC_DLL
+.section        .rodata
+.LC0:
+        .string "dll"
+.data
+        .align 4
+        .type    _argv,@object
+        .size    _argv,8
+_argv:
+        .long .LC0
+        .long 0
+        .align 4
+        .type    _envp,@object
+        .size    _envp,4
+_envp:
+        .long 0
+.text
+        .p2align 2
+.globl __7FPC_DLL
+        .type    __7FPC_DLL,@function
+__7FPC_DLL:
+.LFB2:
+        pushl %ebp
+.LCFI5:
+        movl %esp,%ebp
+.LCFI6:
+        pushl %ebx
+.LCFI7:
+        call .L11
+.L11:
+        popl %ebx
+        addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
+        movl operatingsystem_parameter_argc@GOT(%ebx),%eax
+        movl $0,(%eax)
+        movl operatingsystem_parameter_argv@GOT(%ebx),%eax
+        movl %ebx,%ecx
+        addl $_argv@GOTOFF,%ecx
+        movl %ecx,%edx
+        movl %edx,(%eax)
+        movl operatingsystem_parameter_envp@GOT(%ebx),%eax
+        movl %ebx,%ecx
+        addl $_envp@GOTOFF,%ecx
+        movl %ecx,%edx
+        movl %edx,(%eax)
+        call PASCALMAIN__Fv@PLT
+.L9:
+        movl 8(%ebp),%eax
+        jmp .L8
+.L8:
+        movl -4(%ebp),%ebx
+        movl %ebp,%esp
+        popl %ebp
+        ret
+.LFE2:
+.Lfe2:
+        .size    __7FPC_DLL,.Lfe2-__7FPC_DLL
+
+.section        .eh_frame,"aw",@progbits
+__FRAME_BEGIN__:
+        .4byte  .LLCIE1
+.LSCIE1:
+        .4byte  0x0
+        .byte   0x1
+        .byte   0x0
+        .byte   0x1
+        .byte   0x7c
+        .byte   0x8
+        .byte   0xc
+        .byte   0x4
+        .byte   0x4
+        .byte   0x88
+        .byte   0x1
+        .align 4
+.LECIE1:
+        .set    .LLCIE1,.LECIE1-.LSCIE1
+        .4byte  .LLFDE1
+.LSFDE1:
+        .4byte  .LSFDE1-__FRAME_BEGIN__
+        .4byte  .LFB1
+        .4byte  .LFE1-.LFB1
+        .byte   0x4
+        .4byte  .LCFI0-.LFB1
+        .byte   0xe
+        .byte   0x8
+        .byte   0x85
+        .byte   0x2
+        .byte   0x4
+        .4byte  .LCFI1-.LCFI0
+        .byte   0xd
+        .byte   0x5
+        .byte   0x4
+        .4byte  .LCFI2-.LCFI1
+        .byte   0x86
+        .byte   0x3
+        .byte   0x4
+        .4byte  .LCFI3-.LCFI2
+        .byte   0x83
+        .byte   0x4
+        .byte   0x4
+        .4byte  .LCFI4-.LCFI3
+        .byte   0x2e
+        .byte   0x4
+        .align 4
+.LEFDE1:
+        .set    .LLFDE1,.LEFDE1-.LSFDE1
+        .4byte  .LLFDE3
+.LSFDE3:
+        .4byte  .LSFDE3-__FRAME_BEGIN__
+        .4byte  .LFB2
+        .4byte  .LFE2-.LFB2
+        .byte   0x4
+        .4byte  .LCFI5-.LFB2
+        .byte   0xe
+        .byte   0x8
+        .byte   0x85
+        .byte   0x2
+        .byte   0x4
+        .4byte  .LCFI6-.LCFI5
+        .byte   0xd
+        .byte   0x5
+        .byte   0x4
+        .4byte  .LCFI7-.LCFI6
+        .byte   0x83
+        .byte   0x3
+        .align 4
+.LEFDE3:
+        .set    .LLFDE3,.LEFDE3-.LSFDE3
+        .ident  "GCC: (GNU) 2.9-beos-991026"

rtl/haiku/i386/dllprt.cpp

@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+class FPC_DLL
+{
+  public:
+    FPC_DLL();
+//    ~FPC_DLL();
+};
+
+static FPC_DLL fpc_dll();
+
+//FPC_DLL::~FPC_DLL()
+//{
+//      printf ("main thread ended.");
+//}
+
+
+extern "C" void PASCALMAIN(void);
+extern int operatingsystem_parameter_argc;
+extern void * operatingsystem_parameter_argv;
+extern void * operatingsystem_parameter_envp;
+
+static char * _argv[] = {"dll",0};
+static char * _envp[] = {0};
+
+extern "C" void BEGIN()
+{
+        printf ("init\n");
+        operatingsystem_parameter_argc=0;
+        operatingsystem_parameter_argv = (void *)_argv;
+        operatingsystem_parameter_envp = (void *)_envp;
+        PASCALMAIN();
+}
+
+FPC_DLL::FPC_DLL()
+{
+  BEGIN();
+}
+

rtl/haiku/i386/func.as

@@ -0,0 +1,161 @@
+       .file   "func.s"
+.text
+
+.globl  _haltproc
+.type   _haltproc,@function
+_haltproc:
+        xorl %ebx,%ebx
+    movw operatingsystem_result,%bx
+        pushl %ebx
+        call sys_exit
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret

rtl/haiku/i386/prt0.as

@@ -0,0 +1,186 @@
+       .file   "prt0.c"
+.text
+.globl start
+        .type    start,@function
+start:
+        pushl %ebp
+        movl %esp,%ebp
+        movl 16(%ebp),%ecx
+        movl 12(%ebp),%ebx
+        movl 8(%ebp),%eax
+        movl %eax,operatingsystem_parameter_argc
+        movl %ebx,operatingsystem_parameter_argv
+        movl %ecx,operatingsystem_parameter_envp
+        xorl %ebp,%ebp
+        call PASCALMAIN
+
+.globl  _haltproc
+.type   _haltproc,@function
+_haltproc:
+        xorl %ebx,%ebx
+        movw operatingsystem_result,%bx
+        pushl %ebx
+        call sys_exit
+
+/* int sys_open (int=0xFF000000, char * name, int mode, int=0, int close_on_exec=0); */
+.globl sys_open
+.type sys_open,@function
+sys_open:
+xorl %eax,%eax
+int $0x25
+ret
+
+/* int sys_close (int handle) */
+.globl sys_close
+.type sys_close,@function
+sys_close:
+mov $0x01,%eax
+int $0x25
+ret
+
+/* int sys_read (int handle, void * buffer, int length) */
+.globl sys_read
+.type sys_read,@function
+sys_read:
+movl $0x02,%eax
+int $0x25
+ret
+
+/* int sys_write (int handle, void * buffer, int length) */
+.globl sys_write
+.type sys_write,@function
+sys_write:
+movl $0x3,%eax
+int $0x25
+ret
+
+/* int sys_lseek (int handle, long long pos, int whence) */
+.globl sys_lseek
+.type sys_lseek,@function
+sys_lseek:
+movl $0x5,%eax
+int $0x25
+ret
+
+/* int sys_time(void) */
+.globl sys_time
+.type sys_time,@function
+sys_time:
+movl $0x7,%eax
+int $0x25
+ret
+
+/* int sys_resize_area */
+.globl sys_resize_area
+.type sys_resize_area,@function
+sys_resize_area:
+movl $0x8,%eax
+int $0x25
+ret
+
+/* int sys_opendir (0xFF000000, chra * name, 0) */
+.globl sys_opendir
+.type sys_opendir,@function
+sys_opendir:
+movl $0xC,%eax
+int $0x25
+ret
+
+/* int sys_create_area */
+.globl sys_create_area
+.type sys_create_area,@function
+sys_create_area:
+movl $0x14,%eax
+int $0x25
+ret
+
+/* int sys_readdir (int handle, void * dirent, 0x11C, 0x01000000) */
+.globl sys_readdir
+.type sys_readdir,@function
+sys_readdir:
+movl $0x1C,%eax
+int $0x25
+ret
+
+/* int sys_mkdir (char=0xFF, char * name, int mode) */
+.globl sys_mkdir
+.type sys_mkdir,@function
+sys_mkdir:
+movl $0x1E,%eax
+int $0x25
+ret
+
+/* int sys_wait_for_thread */
+.globl sys_wait_for_thread
+.type sys_wait_for_thread,@function
+sys_wait_for_thread:
+movl $0x22,%eax
+int $0x25
+ret
+
+/* int sys_rename (int=0xFF000000, char * name, int=0xFF000000, char * newname) */
+.globl sys_rename
+.type sys_rename,@function
+sys_rename:
+movl $0x26,%eax
+int $0x25
+ret
+
+/* int sys_unlink (int=0xFF000000, char * name) */
+.globl sys_unlink
+.type sys_unlink,@function
+sys_unlink:
+movl $0x27,%eax
+int $0x25
+ret
+
+/* int sys_stat (int=0xFF000000, char * name, struct stat * s, int=0) */
+.globl sys_stat
+.type sys_stat,@function
+sys_stat:
+movl $0x30,%eax
+int $0x25
+ret
+
+/* int sys_load_image */
+.globl sys_load_image
+.type sys_load_image,@function
+sys_load_image:
+movl $0x34,%eax
+int $0x25
+ret
+
+/* void sys_exit (int exitcode) */
+.globl sys_exit
+.type sys_exit,@function
+sys_exit:
+movl $0x3F,%eax
+int $0x25
+
+/* void sys_chdir (char 0xFF, char * name) */
+.globl sys_chdir
+.type sys_chdir,@function
+sys_chdir:
+movl $0x57,%eax
+int $0x25
+ret
+
+/* void sys_rmdir (char 0xFF, char * name) */
+.globl sys_rmdir
+.type sys_rmdir,@function
+sys_rmdir:
+movl $0x60,%eax
+int $0x25
+ret
+
+/* actual syscall */
+.globl sys_call
+.type sys_call,@function
+sys_call:
+int $0x25
+ret
+
+.bss
+        .comm operatingsystem_parameter_envp,4
+        .comm operatingsystem_parameter_argc,4
+        .comm operatingsystem_parameter_argv,4

rtl/haiku/i386/sighnd.inc

@@ -0,0 +1,85 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Signal handler is arch dependant due to processor to language
+    exception conversion.
+
+    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 SignalToRunerror(sig : longint; SigContext: PSigContextRec; uContext: Pvregs);cdecl;
+var
+  res,fpustate : word;
+begin
+  res:=0;
+  case sig of
+    SIGFPE :
+      begin
+        { this is not allways necessary but I don't know yet
+          how to tell if it is or not PM }
+        res:=200;
+        // fp_status always here under BeOS and x86 CPU
+        // (fp_status is not behind a pointer in the BeOS context record)
+        FpuState:=ucontext^.xregs.state.old_format.fp_status;
+            
+        if (FpuState and FPU_ExceptionMask) <> 0 then
+          begin
+            { first check the more precise options }
+            if (FpuState and FPU_DivisionByZero)<>0 then
+              res:=200
+            else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
+              res:=207
+            else if (FpuState and FPU_Overflow)<>0 then
+              res:=205
+            else if (FpuState and FPU_Underflow)<>0 then
+              res:=206
+            else if (FpuState and FPU_Denormal)<>0 then
+              res:=216
+            else
+              res:=207;  {'Coprocessor Error'}
+          end;
+        with ucontext^.xregs.state.old_format do
+        begin
+          fp_status := fp_status and not FPU_ExceptionMask;
+        end;
+        SysResetFPU;
+      end;
+(*    SIGBUS: {Same as SIGSEGV under BeOS}
+      begin
+        res:=214;
+      end; *)
+    SIGILL:
+      begin
+      if sse_check then
+        begin
+          os_supports_sse := false;
+          res := 0;
+          inc(ucontext^.eip, 3);
+        end
+      else
+        res:=216;
+      end;
+    SIGSEGV :
+      begin
+        res:=216;
+      end;
+  end;
+  reenable_signal(sig);
+{ give runtime error at the position where the signal was raised }
+  if res<>0 then
+  begin
+    HandleErrorAddrFrame(res, pointer(ucontext^.eip),
+                              pointer(ucontext^.ebp));    
+  end;
+end;
+
+

rtl/haiku/osmacro.inc

@@ -0,0 +1,92 @@
+{
+    Copyright (c) 2000-2002 by Marco van de Voort
+
+    The *BSD POSIX macro's that are used both in the Baseunix unit as the
+    system unit. Not aliased via public names because I want these to be
+    inlined as much as possible in the future.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+function FPS_ISDIR(m : TMode): boolean;
+
+begin
+ FPS_ISDIR:=((m and S_IFMT) = S_IFDIR);
+end;
+
+function FPS_ISCHR(m : TMode): boolean;
+begin
+ FPS_ISCHR:=((m and S_IFMT) = S_IFCHR);
+end;
+
+function FPS_ISBLK(m : TMode): boolean;
+begin
+ FPS_ISBLK:=((m and S_IFMT) = S_IFBLK);
+end;
+
+function FPS_ISREG(m : TMode): boolean;
+begin
+ FPS_ISREG:=((m and S_IFMT) = S_IFREG);
+end;
+
+function FPS_ISFIFO(m : TMode): boolean;
+begin
+ FPS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
+end;
+
+Function FPS_ISLNK(m:TMode):boolean;
+
+begin
+ FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
+end;
+
+Function FPS_ISSOCK(m:TMode):boolean;
+
+begin
+ FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
+end;
+
+function wifexited(status : cint): boolean;
+begin
+ wifexited:=(status AND (not $FF)) = 0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=status AND $FF;
+end;
+
+// const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled := ((status shr 8) AND $FF) <> 0;
+end;
+
+function wtermsig(status : cint):cint;
+begin
+ wtermsig:= ((status shr 8) AND $FF);
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=((status shr 16) AND $FF);
+end;
+
+
+
+
+

rtl/haiku/ossysc.inc

@@ -0,0 +1,1060 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    The base *BSD syscalls required to implement the system unit. These
+    are aliased for use in other units (to avoid poluting the system units
+    interface)
+
+    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.
+
+ ****************************************************************************
+}
+
+{$i ostypes.inc}
+
+{$ifdef FPC_USE_LIBC}
+  {$Linklib root}
+  // Out of date atm.
+const clib = 'root';
+const netlib = 'net';
+
+
+{$ifdef FPC_IS_SYSTEM}
+{$i oscdeclh.inc}
+{$endif}
+{$I osmacro.inc}
+
+{   var
+     Errno : cint; external name 'errno';
+
+    function Fptime(tloc:ptime_t): time_t; cdecl; external name 'time';
+    function Fpopen(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
+    function Fpclose(fd : cint): cint; cdecl; external name 'close';
+    function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
+    function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
+    function Fpwrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+    function Fpunlink(const path: pchar): cint; cdecl; external name 'unlink';
+    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function Fpstat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
+    function Fpchdir(const path : pchar): cint; cdecl; external name 'chdir';
+    function Fpmkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
+    function Fprmdir(const path : pchar): cint; cdecl; external name 'rmdir';
+    function Fpopendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
+    function Fpreaddir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
+    function Fpclosedir(var dirp : dir): cint; cdecl; external name 'closedir';
+    procedure Fpexit(status : cint); cdecl; external name '_exit';
+    function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
+    function Fpftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
+    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function Fpfstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
+    function Fpfork : pid_t; cdecl; external name 'fork';
+    function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
+    function Fpwaitpid(pid : pid_t; tat_loc : pcint; options: cint): pid_t; cdecl; external name 'waitpid';
+    function Fpaccess(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
+
+    function Fpuname(var name: utsname): cint; cdecl; external name 'uname';
+
+    function FpDup(oldd:cint):cint; cdecl; external name 'dup';
+    function FpDup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
+}
+{$else}
+
+{*****************************************************************************
+                     --- Main:The System Call Self ---
+*****************************************************************************}
+
+{ The system designed for Linux can't be used for *BSD so easily, since
+  *BSD pushes arguments, instead of loading them to registers.}
+
+// Var ErrNo : Longint;
+
+{$I syscallh.inc}
+{$I syscall.inc}
+{$I sysnr.inc}
+{$I osmacro.inc}
+
+// Should be moved to a FreeBSD specific unit in the future.
+
+function Fptime( tloc:ptime): time_t; [public, alias : 'FPC_SYSC_TIME'];
+
+{VAR tv     : timeval;
+    tz     : timezone;
+    retval : longint;
+}
+var
+  args : SysCallArgs;
+begin
+    { don't treat errno, since there is never any }
+    tloc^ := Do_Syscall(syscall_nr_time,args);
+    fptime := tloc^;
+{begin
+//  Retval:=do_syscall(syscall_nr_gettimeofday,TSysParam(@tv),TSysParam(@tz));
+  If retval=-1 then
+   Fptime:=-1
+  else
+   Begin
+   If Assigned(tloc) Then
+     TLoc^:=tv.tv_sec;
+    Fptime:=tv.tv_sec;
+   End;
+}
+End;
+
+{*****************************************************************************
+               --- File:File handling related calls ---
+*****************************************************************************}
+
+function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := flags;
+  args.param[4] := cint(mode);
+  args.param[5] := 0;               { close on execute flag }
+  fpopen:= SysCall(syscall_nr_open, args);   
+{Begin
+ Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
+}
+End;
+
+function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE'];
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := fd;
+  fpclose:=SysCall(syscall_nr_close,args);
+{begin
+ Fpclose:=do_syscall(syscall_nr_close,fd);
+}
+end;
+
+{$ifdef netbsd}
+  {$ifdef cpupowerpc}
+    {$define netbsdmacppc}
+  {$endif}
+{$endif}
+
+{$ifdef netbsdmacppc}
+{$i sysofft.inc}                        // odd ball calling convention.
+{$else}
+  // generic versions.
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK'];
+
+{
+this one is special for the return value being 64-bit..
+hi/lo offset not yet tested.
+
+NetBSD: ok, but implicit return value in edx:eax
+FreeBSD: same implementation as NetBSD.
+}
+var
+  args: SysCallArgs;
+
+begin
+  args.param[1] := fd;
+  args.param[2] := cint(offset and $FFFFFFFF);      
+  args.param[3] := cint((offset shr 32) and $FFFFFFFF);
+  args.param[4] := whence;
+  { we currently only support seeks upto 32-bit in length }
+  fplseek := off_t(SysCall(syscall_nr_lseek,args));
+(*begin
+  Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence);
+*)
+end;
+
+type
+  { _kwstat_ kernel call structure }
+  pwstat = ^twstat;
+  twstat = packed record
+{00}   filler : array[1..3] of longint;
+{12}   newmode : mode_t;     { chmod mode_t parameter }
+{16}   unknown1 : longint;  
+{20}   newuser : uid_t;      { chown uid_t parameter  } 
+{24}   newgroup : gid_t;     { chown gid_t parameter  }
+{28}   trunc_offset : off_t; { ftrucnate parameter    }
+{36}   unknown2 : array[1..2] of longint;
+{44}   utime_param: int64;  
+{52}   unknown3 : array[1..2] of longint;
+  end;
+  
+function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+var
+  args: SysCallArgs;
+  wstat : pwstat;
+begin
+  New(wstat);
+  FillChar(wstat^,sizeof(wstat),0);
+  wstat^.trunc_offset := flength;
+  args.param[1] := fd;
+  args.param[2] := $00000000;
+  args.param[3] := cint(wstat);
+  args.param[4] := $00000008;
+  args.param[5] := $00000001;
+  fpftruncate:=SysCall(syscall_nr_ftruncate, args);
+  Dispose(wstat);
+{begin
+ Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
+}
+end;
+
+const
+  B_OS_NAME_LENGTH = 32;
+  B_PAGE_SIZE = 4096;  
+
+const
+  B_NO_LOCK       = 0;
+  B_LAZY_LOCK     = 1;
+  B_FULL_LOCK     = 2;
+  B_CONTIGUOUS    = 3;
+  B_LOMEM         = 4;
+
+  B_ANY_ADDRESS        = 0;
+  B_EXACT_ADDRESS      = 1;
+  B_BASE_ADDRESS       = 2;
+  B_CLONE_ADDRESS      = 3;
+  B_ANY_KERNEL_ADDRESS = 4;
+
+  B_READ_AREA  = 1;
+  B_WRITE_AREA = 2;
+
+type
+  area_id   = Longint;
+  
+function create_area(name : pchar; var addr : longint;
+  addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
+var
+ args : SysCallArgs;
+begin
+ args.param[1] := cint(name);
+ args.param[2] := cint(@addr);
+ args.param[3] := cint(addr_typ);
+ args.param[4] := cint(size);
+ args.param[5] := cint(lock_type);
+ args.param[6] := cint(protection);
+ create_area := SysCall(syscall_nr_create_area, args);
+end;
+
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias:  'FPC_SYSC_MMAP'];
+var
+  heap_handle : area_id;
+const
+  zero=0;
+  myheapsize=$20000;
+  myheaprealsize=$20000;
+var
+  myheapstart:pointer;
+  s : string;
+begin
+  WriteLn('fpmmap');
+  Str(len, s);
+  WriteLn(s);
+  myheapstart:=start;
+{$IFDEF FPC_USE_LIBC}  
+  heap_handle := create_area('fpcheap',myheapstart,0,len,0,3);//!!
+{$ELSE}
+  heap_handle := create_area('fpcheap',longint(myheapstart),0,len,0,3);//!!
+{$ENDIF}
+  case heap_handle of
+    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+    B_ERROR : WriteLn('B_ERROR');
+  end;
+
+  fpmmap := myheapstart;
+// not available under BeOS
+//  Fpmmap:=pointer(longint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,{$ifdef cpupowerpc}0,{$endif}offst{$ifdef cpui386},0{$endif})));
+end;
+
+{$endif}
+
+
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
+var
+  args : SysCallArgs;
+  funcresult: ssize_t;
+  errorcode : cint;
+begin
+  args.param[1] := fd;
+  args.param[2] := cint(buf);
+  args.param[3] := cint(nbytes);
+  args.param[4] := cint(@errorcode);
+  funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
+  if funcresult >= 0 then
+   begin
+     fpread := funcresult;
+     errno := 0;
+   end
+  else
+   begin
+     fpread := -1;
+     errno := errorcode;
+   end;
+{begin
+  Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
+}
+end;
+
+//function Fpmywrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
+var
+  args : SysCallArgs;
+  funcresult : ssize_t;
+  errorcode : cint;
+begin
+  errorcode := 0;
+  // There is a bug in syscall in 1.9 under BeOS !!!
+  // Fixed ! 26/05/2004 ! See in syscall.inc
+  args.param[1] := fd;
+  args.param[2] := cint(buf);
+  args.param[3] := cint(nbytes);
+  args.param[4] := cint(@errorcode);
+  funcresult := Do_SysCall(syscall_nr_write,args);
+
+//  funcresult := Fpmywrite(fd, buf, nbytes);
+
+  if funcresult >= 0 then
+   begin
+     fpwrite := funcresult;
+     errno := 0;
+   end
+  else
+   begin
+     fpwrite := -1; 
+     errno := errorcode;
+   end;
+{begin
+ Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
+}
+end;
+
+function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
+var
+  args :SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fpunlink := SysCall(syscall_nr_unlink,args);
+{begin
+  Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
+}
+end;
+
+function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(old);
+  args.param[3] := $FFFFFFFF;
+  args.param[4] := cint(newpath);
+  fprename := SysCall(syscall_nr_rename,args);
+{begin
+  Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath));
+}
+end;
+
+function Fpstat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := cint(@buf);
+  args.param[4] := $01000000;
+  fpstat := SysCall(syscall_nr_stat, args);
+{begin
+ Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf));
+}
+end;
+
+
+{*****************************************************************************
+               --- Directory:Directory related calls ---
+*****************************************************************************}
+
+function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fpchdir := SysCall(syscall_nr_chdir, args);
+{begin
+ Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
+}
+end;
+
+function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
+var
+  args :SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := cint(mode);
+  fpmkdir := SysCall(syscall_nr_mkdir,args);
+(*begin {Mode is 16-bit on F-BSD 4!}
+  Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),mode);
+*)
+end;
+
+function Fprmdir(path : pchar): cint;  [public, alias : 'FPC_SYSC_RMDIR'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fprmdir := SysCall(syscall_nr_rmdir,args);
+{begin
+ Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path));
+}
+end;
+
+{$ifndef NewReaddir}
+
+const DIRBLKSIZ=1024;
+
+
+function Fpopendir(dirname : pchar): pdir;  [public, alias : 'FPC_SYSC_OPENDIR'];
+var
+  args : SysCallArgs;
+  dirp: pdir;
+  fd : cint;
+begin
+  New(dirp);
+  { just in case }
+  FillChar(dirp^,sizeof(dir),#0);
+  if assigned(dirp) then
+	 begin
+	   args.param[1] := $FFFFFFFF;
+     args.param[2] := cint(dirname);
+ 	   args.param[3] := 0;
+     fd:=SysCall(syscall_nr_opendir,args);
+	   if fd = -1 then
+	    begin
+	      Dispose(dirp);
+	      fpopendir := nil;
+	      exit;
+	    end;
+	   dirp^.fd := fd;
+	   fpopendir := dirp;
+	   exit;
+	 end;
+  Errno := ESysEMFILE;
+  fpopendir := nil;
+(*var
+  fd:longint;
+  st:stat;
+  ptr:pdir;
+begin
+  Fpopendir:=nil;
+  if Fpstat(dirname,st)<0 then
+   exit;
+{ Is it a dir ? }
+  if not((st.st_mode and $f000)=$4000)then
+   begin
+     errno:=ESysENOTDIR;
+     exit
+   end;
+{ Open it}
+  fd:=Fpopen(dirname,O_RDONLY,438);
+  if fd<0 then
+   Begin
+    Errno:=-1;
+    exit;
+   End;
+  new(ptr);
+  if ptr=nil then
+   Begin
+    Errno:=1;
+    exit;
+   End;
+  Getmem(ptr^.dd_buf,2*DIRBLKSIZ);
+  if ptr^.dd_buf=nil then
+   exit;
+  ptr^.dd_fd:=fd;
+  ptr^.dd_loc:=-1;
+  ptr^.dd_rewind:=longint(ptr^.dd_buf);
+  ptr^.dd_size:=0;
+//  ptr^.dd_max:=sizeof(ptr^.dd_buf^);
+  Fpopendir:=ptr;
+*)
+end;
+
+function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
+var
+  args : SysCallArgs;
+begin
+  if assigned(dirp) then
+   begin
+	   args.param[1] := dirp^.fd;
+	   fpclosedir := SysCall(syscall_nr_closedir,args);
+	   Dispose(dirp);
+	   dirp := nil;
+	   exit;
+    end;
+   Errno := ESysEBADF;
+   fpclosedir := -1;
+{begin
+  Fpclosedir:=Fpclose(dirp^.dd_fd);
+  Freemem(dirp^.dd_buf);
+  dispose(dirp);
+}
+end;
+
+function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR'];
+
+{Different from Linux, Readdir on BSD is based on Getdents, due to the
+missing of the readdir syscall.
+Getdents requires the buffer to be larger than the blocksize.
+This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks
+with blockmode have this higher?}
+
+(*function readbuffer:longint;
+
+var retval :longint;
+
+begin
+ Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
+   dirp^.dd_rewind:=TSysParam(dirp^.dd_buf);
+   if retval=0 then
+    begin
+     dirp^.dd_rewind:=0;
+     dirp^.dd_loc:=0;
+    end
+   else
+    dirP^.dd_loc:=retval;
+ readbuffer:=retval;
+end;*)
+var
+  args : SysCallArgs;
+  funcresult : cint;
+begin
+  args.param[1] := dirp^.fd;
+  args.param[2] := cint(@(dirp^.ent));
+  args.param[3] := $0000011C;
+  args.param[4] := $00000001;
+  { the error will be processed here }
+  funcresult := Do_SysCall(syscall_nr_readdir, args);
+  if funcresult <> 1 then
+   begin
+     if funcresult <> 0 then
+       errno := funcresult;
+     fpreaddir := nil;
+     exit;
+   end;
+  errno := 0;
+  fpreaddir := @dirp^.ent
+(*
+var
+    FinalEntry     : pdirent;
+    novalid        : boolean;
+    Reclen         : Longint;
+    CurEntry       : PDirent;
+
+begin
+ if (dirp^.dd_buf=nil) or (dirp^.dd_loc=0) THEN
+  exit(nil);
+ if (dirp^.dd_loc=-1)   OR     {First readdir on this pdir. Initial fill of buffer}
+   (dirp^.dd_rewind>=(longint(dirp^.dd_buf)+dirblksiz)) then  {no more entries left?}
+  Begin
+    if readbuffer=0 then        {succesful read?}
+     Exit(NIL);                 {No more data}
+  End;
+ FinalEntry:=NIL;
+ CurEntry:=nil;
+ repeat
+  novalid:=false;
+  CurEntry:=pdirent(dirp^.dd_rewind);
+  RecLen:=CurEntry^.d_reclen;
+  if RecLen<>0 Then
+   begin {valid direntry?}
+    if CurEntry^.d_fileno<>0 then
+     FinalEntry:=CurEntry;
+    inc(dirp^.dd_rewind,Reclen);
+   end
+  else
+   begin {block entirely searched or reclen=0}
+    Novalid:=True;
+    if dirp^.dd_loc<>0 THEN             {blocks left?}
+     if readbuffer()<>0 then        {succesful read?}
+      novalid:=false;
+   end;
+ until (FinalEntry<>nil) or novalid;
+ If novalid then
+  FinalEntry:=nil;
+ FpReadDir:=FinalEntry;*)
+end;
+{$endif}
+
+{*****************************************************************************
+        --- Process:Process & program handling - related calls ---
+*****************************************************************************}
+
+procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT'];
+var
+  args : SysCallArgs;
+begin
+//  sys_exit(status);
+  args.param[1] := status;
+  do_syscall(syscall_nr_exit, args);
+end;
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+
+function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := sig;
+  args.param[2] := cint(@act);
+  args.param[3] := cint(@oact);
+  fpsigaction := SysCall(syscall_nr_sigaction, args);
+//begin
+//  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+end;
+
+(*=================== MOVED from sysunix.inc ========================*)
+
+
+function Fpfstat(fd : cint; var sb : stat): cint;  [public, alias : 'FPC_SYSC_FSTAT'];
+
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := fd;
+  args.param[2] := $00;
+  args.param[3] := cint(@sb);
+  args.param[4] := $00000001;
+  fpfstat := SysCall(syscall_nr_fstat, args);
+
+{begin
+  fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb));
+}
+end;
+
+{$ifdef NewReaddir}
+{$I readdir.inc}
+{$endif}
+
+
+function fork : pid_t; external 'root' name 'fork';
+{ These routines are currently not required for BeOS }
+function Fpfork : pid_t;  [public, alias : 'FPC_SYSC_FORK'];
+{
+  This function issues the 'fork' System call. the program is duplicated in memory
+  and Execution continues in parent and child process.
+  In the parent process, fork returns the PID of the child. In the child process,
+  zero is returned.
+  A negative value indicates that an error has occurred, the error is returned in
+  LinuxError.
+}
+
+Begin
+  WriteLn('fpfork');
+  fpfork := fork;
+// Not required for BeOS
+// Fpfork:=Do_syscall(SysCall_nr_fork);
+End;
+
+{
+function Fpexecve(const path : pathstr; const argv : ppchar; const envp: ppchar): cint;
+}
+{
+  Replaces the current program by the program specified in path,
+  arguments in args are passed to Execve.
+  environment specified in ep is passed on.
+}
+
+{
+Begin
+  path:=path+#0;
+  do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp));
+End;
+}
+{
+function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;  [public, alias : 'FPC_SYSC_EXECVE'];
+}
+{
+  Replaces the current program by the program specified in path,
+  arguments in args are passed to Execve.
+  environment specified in ep is passed on.
+}
+{
+Begin
+  do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp));
+End;
+}
+function waitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; external 'root' name 'waitpid';
+function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID'];
+{
+  Waits until a child with PID Pid exits, or returns if it is exited already.
+  Any resources used by the child are freed.
+  The exit status is reported in the adress referred to by Status. It should
+  be a longint.
+}
+
+begin // actually a wait4() call with 4th arg 0.
+  FpWaitPID := waitpid(pid, stat_loc, options);
+// FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options,0);
+end;
+
+function Fpaccess(const pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
+{
+  Test users access rights on the specified file.
+  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+  R,W,X stand for read,write and Execute access, simultaneously.
+  F_OK checks whether the test would be allowed on the file.
+  i.e. It checks the search permissions in all directory components
+  of the path.
+  The test is done with the real user-ID, instead of the effective.
+  If access is denied, or an error occurred, false is returned.
+  If access is granted, true is returned.
+  Errors other than no access,are reported in unixerror.
+}
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(pathname);
+  args.param[3] := amode;
+  fpaccess := SysCall(syscall_nr_access,args);
+
+{begin
+ FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
+}
+end;
+(*
+function Fpaccess(const pathname : pathstr; amode : cint): cint;
+
+{
+  Test users access rights on the specified file.
+  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+  R,W,X stand for read,write and Execute access, simultaneously.
+  F_OK checks whether the test would be allowed on the file.
+  i.e. It checks the search permissions in all directory components
+  of the path.
+  The test is done with the real user-ID, instead of the effective.
+  If access is denied, or an error occurred, false is returned.
+  If access is granted, true is returned.
+  Errors other than no access,are reported in unixerror.
+}
+
+begin
+ pathname:=pathname+#0;
+ Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0;
+end;
+*)
+
+Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
+
+begin
+  {$warning TODO BeOS FpDup implementation}
+//  Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
+end;
+
+Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
+
+begin
+  {$warning TODO BeOS FpDup2 implementation}
+// Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
+end;
+
+
+
+Function Fpmunmap(start:pointer;len:size_t):cint;    [public, alias :'FPC_SYSC_MUNMAP'];
+begin
+  {$warning TODO BeOS Fpmunmap implementation}
+//  Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len);
+end;
+
+
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+
+Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL'];
+// This was missing here, instead hardcoded in Do_IsDevice
+begin
+  {$warning TODO BeOS FpIOCtl implementation}
+//  FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
+end;
+
+
+Function FpGetPid:LongInt;   [public, alias : 'FPC_SYSC_GETPID'];
+{
+  Get Process ID.
+}
+
+begin
+  {$warning TODO BeOS FpGetPid implementation}
+// FpGetPID:=do_syscall(syscall_nr_getpid);
+end;
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY'];
+
+begin
+  {$warning TODO BeOS fpgettimeofday implementation}
+// fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
+end;
+
+function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK'];
+
+{
+  Change the list of currently blocked signals.
+  How determines which signals will be blocked :
+   SigBlock   : Add SSet to the current list of blocked signals
+   SigUnBlock : Remove the signals in SSet from the list of blocked signals.
+   SigSetMask : Set the list of blocked signals to SSet
+  if OldSSet is non-null, the old set will be saved there.
+}
+
+begin
+  {$warning TODO BeOS FPSigProcMask implementation}
+//  FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
+end;
+{$user BLA!}
+Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
+begin
+  {$warning TODO BeOS FpNanoSleep implementation}
+{$ifndef darwin}
+//  FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
+{$else not darwin}
+{$warning: TODO: nanosleep!!!}
+{$endif not darwin}
+end;
+
+function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
+{$ifndef darwin}
+const intpathmax = 1024-4;      // didn't use POSIX data in libc
+                                // implementation.
+var ept,bpt : pchar;
+    c       : char;
+    ret     : cint;
+
+begin
+  {$warning TODO BeOS Fpgetcwd implementation}
+(*   if pt=NIL Then
+    begin
+      // POSIX: undefined. (exit(nil) ?)
+      // BSD  : allocate mem for path.
+      getmem(pt,intpathmax);
+      if pt=nil Then
+        exit(nil);
+      ept:=pt+intpathmax;
+    end
+   else
+    Begin
+      if (_size=0) Then
+        Begin
+          seterrno(ESysEINVAL);
+          exit(nil);
+        End;
+      if (_size=1) Then
+        Begin
+          seterrno(ESysERANGE);
+          exit(nil);
+        End;
+      ept:=pt+_size;
+    end;
+
+    ret := do_syscall(syscall_nr___getcwd,TSysParam(pt),TSysParam( ept - pt));
+    If (ret = 0) Then
+        If (pt[0] <> '/') Then
+           Begin
+             bpt := pt;
+             ept := pt + strlen(pt) - 1;
+             While (bpt < ept) Do
+               Begin
+                 c := bpt^;
+                 bpt^:=ept^;
+                 inc(bpt);
+                 ept^:=c;
+                 dec(ept);
+               End;
+           End;
+ Fpgetcwd:=pt;*)
+end;
+{$else not darwin}
+{$i getcwd.inc}
+{$endif darwin}
+
+{$endif}
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+begin
+  do_isdevice:= (handle=StdInputHandle) or
+                (handle=StdOutputHandle) or
+                (handle=StdErrorHandle);
+end;
+
+{
+extern _IMPEXP_ROOT status_t  get_image_symbol(image_id imid,
+                  const char *name, int32 sclass,  void **ptr);
+extern _IMPEXP_ROOT status_t  get_nth_image_symbol(image_id imid, int32 index,
+                  char *buf, int32 *bufsize, int32 *sclass,
+                  void **ptr);
+}
+
+// 
+{$ifdef FPC_USE_LIBC}
+
+// private; use the macros, below
+function _get_image_info(image : image_id; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_image_info';
+
+function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_image_info';
+
+function get_image_info(image : image_id; var info : image_info) : status_t;
+begin
+  Result := _get_image_info(image, info, SizeOf(info));
+end;
+
+function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
+begin
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
+end;
+
+{$else}
+
+    function wait_for_thread(thread: thread_id; var status : status_t): status_t;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(thread);
+       args.param[2] := cint(@status);
+       wait_for_thread := SysCall(syscall_nr_wait_thread, args);
+     end;
+
+    function get_team_info(team: team_id; var info : team_info): status_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(team);
+       args.param[2] := cint(@info);
+       get_team_info := SysCall(syscall_nr_get_team_info, args);
+     end;
+
+
+    function kill_team(team: team_id): status_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(team);
+       kill_team := SysCall(syscall_nr_kill_team, args);
+     end;
+
+  function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
+     var
+      args: SysCallArgs;
+   begin
+       args.param[1] := cint(team);
+       args.param[2] := cint(@cookie);
+       args.param[3] := cint(@info);
+       args.param[4] := cint(sizeof(image_info));
+       get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
+   end;       
+
+    function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(argc);
+       args.param[2] := cint(argv);
+       args.param[3] := cint(envp);
+       load_image := SysCall(syscall_nr_load_image, args);
+     end;
+    
+    function get_system_info(var info: system_info): status_t;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(@info);
+       i := SysCall(syscall_nr_get_system_info, args);
+       get_system_info := i;
+     end;
+
+    function dev_for_path(const pathname : pchar): dev_t;
+     var
+      args: SysCallArgs;
+      buffer: array[1..15] of longint;
+      i: cint;
+     begin
+       args.param[1] := $FFFFFFFF;
+       args.param[2] := cint(pathname);
+       args.param[3] := cint(@buffer);
+       args.param[4] := $01000000;
+       if SysCall(syscall_nr_rstat, args)=0 then
+          i:=buffer[1]
+       else
+          i:=-1;
+       dev_for_path := i;
+     end;
+
+
+    function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(device);
+       args.param[2] := 0;
+       args.param[3] := $FFFFFFFF;
+       args.param[4] := 0;
+       args.param[5] := cint(@info);
+       fs_stat_dev := SysCall(syscall_nr_statfs, args);
+     end;
+     
+{$endif}
+
+
+(* Implemented in sytem under BeOS
+CONST
+ { Constansts for MMAP }
+  MAP_PRIVATE   =2;
+  MAP_ANONYMOUS =$1000;
+
+Function sbrk(size : cint) : pointer;
+begin
+  sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  if sbrk=pointer(-1) then
+    sbrk:=nil
+  else
+    seterrno(0);
+end;
+*)
+

rtl/haiku/ostypes.inc

@@ -0,0 +1,366 @@
+{
+    Copyright (c) 2000-2002 by Marco van de Voort
+
+    Some non POSIX BSD types used internally in the system unit.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{***********************************************************************}
+{                         POSIX STRUCTURES                              }
+{***********************************************************************}
+
+{$ifdef FPC_IS_SYSTEM}
+  {$i ptypes.inc}
+{$ENDIF}
+
+Type
+  timezone = packed record
+    tz_minuteswest,tz_dsttime:cint;
+  end;
+  ptimezone =^timezone;
+  TTimeZone = timezone;
+  
+  rusage = packed record
+        ru_utime    : timeval;          { user time used }
+        ru_stime    : timeval;          { system time used }
+        ru_maxrss   : clong;            { max resident set size }
+        ru_ixrss    : clong;            { integral shared memory size }
+        ru_idrss    : clong;            { integral unshared data " }
+        ru_isrss    : clong;            { integral unshared stack " }
+        ru_minflt   : clong;            { page reclaims }
+        ru_majflt   : clong;            { page faults }
+        ru_nswap    : clong;            { swaps }
+        ru_inblock  : clong;            { block input operations }
+        ru_oublock  : clong;            { block output operations }
+        ru_msgsnd   : clong;            { messages sent }
+        ru_msgrcv   : clong;            { messages received }
+        ru_nsignals : clong;            { signals received }
+        ru_nvcsw    : clong;            { voluntary context switches }
+        ru_nivcsw   : clong;            { involuntary " }
+        end;
+// #define      ru_last         ru_nivcsw
+// #define      ru_first        ru_ixrss
+
+{ auto generated by a c prog, statmacr.c}
+
+Const
+  S_IFMT  = &0000170000;
+  S_IFLNK = &0000120000;
+  S_IFREG = &0000100000;
+  S_IFBLK = &0000060000;
+  S_IFDIR = &0000040000;
+  S_IFCHR = &0000020000;
+  S_IFIFO = &0000010000;
+
+  S_IFSOCK= &0000000000; // not defined under BeOS
+  S_IFWHT = &0000000000; // not defined under BeOS
+  S_ISVTX = &1000;
+
+//      CONST SYS_NMLN=32;
+
+// Can't find these two in Posix and in BeOS
+//CONST
+//    _UTSNAME_LENGTH = ;
+//    _UTSNAME_NODENAME_LENGTH = ;
+
+CONST                		// OS specific parameters for general<fd,sig>set behaviour
+   BITSINWORD      = 8*sizeof(longint);
+//   SIG_MAXSIG      = 32;    //128;	// highest signal version
+   FD_MAXFDSET	   = 1024;
+//   wordsinsigset   = 4;		// words in sigset_t
+   ln2bitsinword   = 5;         { 32bit : ln(32)/ln(2)=5 } 
+   ln2bitmask	   = 2 shl ln2bitsinword - 1;
+   wordsinfdset    = FD_MAXFDSET DIV BITSINWORD;        // words in fdset_t   
+   wordsinsigset   = SIG_MAXSIG  DIV BITSINWORD;      
+
+TYPE
+   { system information services }
+   utsname = record
+              sysname : Array[0..SYS_NMLN-1] OF Char;   // Name of this OS
+              nodename: Array[0..SYS_NMLN-1] OF Char;   // Name of this network node.
+              release : Array[0..SYS_NMLN-1] OF Char;   // Release level.
+              version : Array[0..SYS_NMLN-1] OF Char;   // Version level.
+              machine : Array[0..SYS_NMLN-1] OF Char;   // Hardware type.
+             end;
+  TUtsName= utsname;
+  pUtsName= ^utsname;
+
+  { file characteristics services }
+(*   stat    = record { the types are real}
+        st_dev        : dev_t;             // inode's device
+        st_ino        : ino_t;             // inode's number
+        st_mode       : mode_t;            // inode protection mode
+        st_nlink      : nlink_t;           // number of hard links
+        st_uid        : uid_t;             // user ID of the file's owner
+        st_gid        : gid_t;             // group ID of the file's group
+        st_rdev       : dev_t;             // device type
+        st_atime      : time_t;            // time of last access
+        st_atimensec  : clong;             // nsec of last access
+        st_mtime      : time_t;            // time of last data modification
+        st_mtimensec  : clong;             // nsec of last data modification
+        st_ctime      : time_t;            // time of last file status change
+        st_ctimensec  : clong;             // nsec of last file status change
+{$ifdef netbsdPowerpc}
+	st_padd1	      : cint;
+{$endif}
+        st_size       : off_t;             // file size, in bytes
+        st_blocks     : cint64;            // blocks allocated for file
+        st_blksize    : cuint32;           // optimal blocksize for I/O
+        st_flags      : cuint32;           // user defined flags for file
+        st_gen        : cuint32;           // file generation number
+{$ifdef netbsdPowerpc}
+	st_padd2	      : cint;
+{$endif}
+{$ifndef NetBSD}
+        st_lspare     : cint32;
+{$endif}
+        st_qspare     : array[0..1] Of cint64;
+   end;*)
+   stat = packed record
+      dev:longint;     {"device" that this file resides on}
+      ino:int64;       {this file's inode #, unique per device}
+      st_mode:dword;      {mode bits (rwx for user, group, etc)}      
+      nlink:longint;   {number of hard links to this file}
+      uid:dword;       {user id of the owner of this file}
+      gid:dword;       {group id of the owner of this file}
+      st_size:int64;      {size of this file (in bytes)}
+      rdev:longint;    {device type (not used)}
+      blksize:longint; {preferref block size for i/o}
+      atime:longint;   {last access time}
+      st_mtime:longint;   {last modification time}
+      ctime:longint;   {last change time, not creation time}
+      crtime:longint;  {creation time}
+   end;
+   
+   TStat = stat;
+   pStat = ^stat;
+
+  { directory services }
+   dirent = packed record
+        d_dev:longint;
+        d_pdev:longint;
+        d_ino:int64;
+        d_pino:int64;
+        d_reclen:word;
+        d_name:array[0..255] of char;
+   end;
+(*   dirent  = record
+     d_dev : dev_t;
+     d_pdev : dev_t;
+     d_ino : ino_t;
+     d_pino : ino_t;
+     d_reclen : word;
+     d_name : Char;
+//        d_fileno      : cuint32;                        // file number of entry
+//        d_reclen      : cuint16;                        // length of this record
+//        d_type        : cuint8;                         // file type, see below
+//        d_namlen      : cuint8;                         // length of string in d_name
+//        d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
+   end;*)
+   TDirent = dirent;
+   pDirent = ^dirent;
+
+   dir     = packed record
+        fd     : cint;         // file descriptor associated with directory
+        ent : dirent;
+//        dd_loc    : clong;        // offset in current buffer
+//        dd_size   : clong;        // amount of data returned by getdirentries
+//        dd_buf    : pchar;        // data buffer
+//        dd_len    : cint;         // size of data buffer
+{$ifdef netbsdpowerpc}
+//	dd_pad1   : cint;
+//        dd_seek   : cint64;        // magic cookie returned by getdirentries
+{$else}
+//        dd_seek   : clong;        // magic cookie returned by getdirentries
+{$endif}
+//        dd_rewind : clong;        // magic cookie for rewinding
+//        dd_flags  : cint;         // flags for readdir
+   end;
+   TDir    = dir;
+   pDir    = ^dir;
+
+   utimbuf  = record
+	        actime  : time_t;
+	        modtime : time_t;
+	        end;
+   TUtimBuf = utimbuf;
+   putimbuf = ^utimbuf;
+
+   flock    = record
+		l_start : off_t;	{ starting offset }
+		l_len	: off_t;	{ len = 0 means until end of file }
+		l_pid 	: pid_t;	{ lock owner }
+		l_type	: cshort;	{ lock type: read/write, etc. }
+		l_whence: cshort;	{ type of l_start }
+                end;
+   TFlock   = flock;
+   pFlock   = ^flock;
+
+ tms = packed record
+	 tms_utime  : clock_t;	{ User CPU time }
+	 tms_stime  : clock_t;	{ System CPU time }
+	 tms_cutime : clock_t;	{ User CPU time of terminated child procs }
+	 tms_cstime : clock_t;	{ System CPU time of terminated child procs }
+	 end;
+ TTms= tms;
+ pTms= ^tms;
+
+ TFDSet    = ARRAY[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ pFDSet    = ^TFDSet;
+
+{***********************************************************************}
+{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
+{***********************************************************************}
+CONST
+    { access routine - these maybe OR'ed together }
+    F_OK        =     0;        { test for existence of file }
+    R_OK        =     4;        { test for read permission on file }
+    W_OK        =     2;        { test for write permission on file }
+    X_OK        =     1;        { test for execute or search permission }
+    { seek routine }
+    SEEK_SET    =     0;        { seek from beginning of file }
+    SEEK_CUR    =     1;        { seek from current position  }
+    SEEK_END    =     2;        { seek from end of file       }
+    { open routine                                 }
+    { File access modes for `open' and `fcntl'.    }
+    O_RDONLY    =     0;        { Open read-only.  }
+    O_WRONLY    =     1;        { Open write-only. }
+    O_RDWR      =     2;        { Open read/write. }
+    { Bits OR'd into the second argument to open.  }
+    O_CREAT     =  $200;        { Create file if it doesn't exist.  }
+    O_EXCL      =  $100;        { Fail if file already exists.      }
+    O_TRUNC     =  $400;        { Truncate file to zero length.     }
+    O_NOCTTY    = $1000;        { Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    O_APPEND    =  $800;        { Writes append to the file.        }
+    O_NONBLOCK  = $0080;        { Non-blocking I/O.                 }
+
+    { mode_t possible values                                 }
+    S_IRUSR =  %0100000000;     { Read permission for owner   }
+    S_IWUSR =  %0010000000;     { Write permission for owner  }
+    S_IXUSR =  %0001000000;     { Exec  permission for owner  }
+    S_IRGRP =  %0000100000;     { Read permission for group   }
+    S_IWGRP =  %0000010000;     { Write permission for group  }
+    S_IXGRP =  %0000001000;     { Exec permission for group   }
+    S_IROTH =  %0000000100;     { Read permission for world   }
+    S_IWOTH =  %0000000010;     { Write permission for world  }
+    S_IXOTH =  %0000000001;     { Exec permission for world   }
+
+    { Used for waitpid }
+    WNOHANG   =          1;     { don't block waiting               }
+    WUNTRACED =          2;     { report status of stopped children }
+
+Type 
+        TRLimit  = record
+                     rlim_cur,               { current (soft) limit }
+          	     rlim_max : TRLim;     { maximum value for rlim_cur }
+		    end;	
+        PRLimit  = ^TRLimit;
+
+ iovec = record
+            iov_base : pointer;
+	    iov_len  : size_t;
+	   end;
+  tiovec=iovec;
+  piovec=^tiovec;		
+
+
+    {*************************************************************************}
+    {                               SIGNALS                                   }
+    {*************************************************************************}
+
+{$i signal.inc}
+
+// BeOS types
+{ ------------------------- Images --------------------------- }
+
+type
+  // Descriptive formats
+  status_t = Longint;
+  area_id   = Longint;
+  port_id   = Longint;
+  sem_id    = Longint;
+  thread_id = Longint;
+  team_id   = Longint;
+  bigtime_t = int64;
+  image_id = longint;
+
+
+{/* commands that can be passed to fcntl */
+#define	F_DUPFD			0x0001
+#define	F_GETFD			0x0002
+#define	F_SETFD			0x0004
+#define	F_GETFL			0x0008
+#define	F_SETFL			0x0010
+#define F_GETLK         0x0020
+#define F_RDLCK         0x0040
+#define F_SETLK         0x0080
+#define F_SETLKW        0x0100
+#define F_UNLCK         0x0200
+#define F_WRLCK         0x0400
+}
+const
+  F_DUPFD	=		$0001;
+  F_GETFD	=		$0002;
+  F_SETFD	=		$0004;
+  F_GETFL	=		$0008;
+  F_SETFL	=		$0010;
+  F_GETLK   =     	$0020;
+  F_RDLCK   =     	$0040;
+  F_SETLK   =      	$0080;
+  F_SETLKW  =      	$0100;
+  F_UNLCK   =      	$0200;
+  F_WRLCK   =      	$0400;
+
+    { image types }
+const
+   B_APP_IMAGE     = 1;
+   B_LIBRARY_IMAGE = 2;
+   B_ADD_ON_IMAGE  = 3;
+   B_SYSTEM_IMAGE  = 4;
+type
+    image_info = packed record
+     id      : image_id;   
+     _type   : longint;
+     sequence: longint;
+     init_order: longint;
+     init_routine: pointer;
+     term_routine: pointer;
+     device: dev_t;
+     node: ino_t;
+     name: array[0..1024{MAXPATHLEN}-1] of char;
+{     name: string[255];
+     name2: string[255];
+     name3: string[255];
+     name4: string[255];
+     name5: string[5];
+}
+     text: pointer;
+     data: pointer;
+     text_size: longint;
+     data_size: longint;
+    end;
+    
+(*----- symbol types and functions ------------------------*)
+
+const B_SYMBOL_TYPE_DATA = $1;
+const B_SYMBOL_TYPE_TEXT = $2;
+const B_SYMBOL_TYPE_ANY  = $5;
+
+{ Constansts for MMAP }
+const
+  MAP_ANONYMOUS =$1000;

rtl/haiku/pthread.inc

@@ -0,0 +1,87 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Peter Vreman
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This file contains a pthread.h headerconversion,
+    and should contain an interface to the threading library to be
+    used by systhrd, preferably in a somewhat compatible notation
+    (compared to the other OSes).
+
+    As a start, I simply used libc_r
+
+    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.
+
+ **********************************************************************}
+
+CONST PTHREAD_EXPLICIT_SCHED       = 0;
+      PTHREAD_CREATE_DETACHED      = 1;
+      PTHREAD_SCOPE_PROCESS        = 0;
+
+ TYPE
+    ppthread_t      = ^pthread_t;
+    ppthread_key_t  = ^pthread_key_t;
+    ppthread_mutex_t= ^pthread_mutex_t;
+    ppthread_attr_t = ^pthread_attr_t;
+    ppthread_cond_t            = ^pthread_cond_t;
+    ppthread_condattr_t        = ^pthread_condattr_t;
+
+    __destr_func_t  = procedure (p :pointer);cdecl;
+    __startroutine_t= function (p :pointer):pointer;cdecl;
+    ppthread_mutexattr_t = ^pthread_mutexattr_t;
+    ppthread_mutex_attr_t = ^pthread_mutexattr_t;
+
+    sem_t           = cint;
+    psem_t          = ^sem_t;
+    TSemaphore         = sem_t;
+    PSemaphore         = ^TSemaphore;
+
+function  pthread_getspecific      (t : pthread_key_t):pointer; cdecl; external;
+function  pthread_setspecific      (t : pthread_key_t;p:pointer):cint; cdecl; external;
+function  pthread_key_create       (p : ppthread_key_t;f: __destr_func_t):cint; cdecl;external;
+function  pthread_attr_init           (p : ppthread_attr_t):cint; cdecl; external;
+{$ifndef haiku}
+function  pthread_attr_setinheritsched(p : ppthread_attr_t;i:cint):cint; cdecl; external;
+function  pthread_attr_setscope      (p : ppthread_attr_t;i:cint):cint;cdecl;external;
+function  pthread_attr_setdetachstate (p : ppthread_attr_t;i:cint):cint;cdecl;external;
+{$endif}
+function  pthread_create ( p: ppthread_t;attr : ppthread_attr_t;f:__startroutine_t;arg:pointer):cint;cdecl;external;
+procedure pthread_exit  ( p: pointer); cdecl;external;
+function  pthread_self:pthread_t; cdecl;external;
+function  pthread_mutex_init (p:ppthread_mutex_t;o:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_mutex_destroy (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_mutex_lock    (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_mutex_unlock  (p:ppthread_mutex_attr_t):cint; cdecl;external;
+function  pthread_cancel(_para1:pthread_t):cint;cdecl;external;
+function  pthread_detach(_para1:pthread_t):cint;cdecl;external;
+function  pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external;
+function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external;
+function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external;
+function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external;
+function pthread_kill(__thread:pthread_t; __signo:cint):cint;cdecl;external;
+function pthread_sigmask(how: cint; nset: psigset; oset: psigset): cint; cdecl; external;
+
+{$ifndef haiku}
+function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
+function sem_destroy(__sem:Psem_t):cint;cdecl;external ;
+function sem_close(__sem:Psem_t):cint;cdecl;external ;
+function sem_unlink(__name:Pchar):cint;cdecl;external ;
+function sem_wait(__sem:Psem_t):cint;cdecl;external ;
+function sem_trywait(__sem:Psem_t):cint;cdecl;external ;
+function sem_post(__sem:Psem_t):cint;cdecl;external ;
+function sem_getvalue(__sem:Psem_t; __sval:Pcint):cint;cdecl;external;
+{$endif}
+function pthread_mutexattr_init(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
+function pthread_mutexattr_destroy(_para1:Ppthread_mutexattr_t):cint;cdecl;external;
+function pthread_mutexattr_gettype(_para1:Ppthread_mutexattr_t; _para2:Pcint):cint;cdecl;external;
+function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cint;cdecl;external;
+function pthread_cond_timedwait(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl;external;
+
+
+

rtl/haiku/ptypes.inc

@@ -0,0 +1,214 @@
+{
+    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.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{                       POSIX TYPE DEFINITIONS                          }
+{***********************************************************************}
+
+{$i ctypes.inc}
+
+type
+  fsblkcnt_t = clonglong;
+  TStatfs = packed record
+    bsize 			: Cardinal;
+    frsize			: Cardinal;
+    blocks			: fsblkcnt_t;
+    bfree			: fsblkcnt_t;
+    bavail			: fsblkcnt_t;
+    files			: fsblkcnt_t;
+    ffree			: fsblkcnt_t;
+    favail			: fsblkcnt_t;
+    fsid			: Cardinal;
+    flag			: Cardinal;
+    namemax			: Cardinal;
+  end;
+  PStatFS=^TStatFS;
+
+    dev_t    = cuint32;         { used for device numbers      }
+    TDev     = dev_t;
+    pDev     = ^dev_t;
+
+    gid_t    = cuint32;         { used for group IDs           }
+    TGid     = gid_t;
+    pGid     = ^gid_t;
+    TIOCtlRequest = cuLong;
+
+    ino_t    = clonglong;           { used for file serial numbers }
+    TIno     = ino_t;
+    pIno     = ^ino_t;
+
+    mode_t   = cuint16;         { used for file attributes     }
+    TMode    = mode_t;
+    pMode    = ^mode_t;
+
+    nlink_t  = cuint16;         { used for link counts         }
+    TnLink   = nlink_t;
+    pnLink   = ^nlink_t;
+
+    off_t    = cint64;          { used for file sizes          }
+    TOff     = off_t;
+    pOff     = ^off_t;
+
+    pid_t    = cint32;          { used as process identifier   }
+    TPid     = pid_t;
+    pPid     = ^pid_t;
+
+    wint_t	 = cint32;
+    size_t   = cuint32;         { as definied in the C standard}
+    TSize    = size_t;
+    pSize    = ^size_t;
+    psize_t   = pSize;		
+
+    ssize_t  = cint32;          { used by function for returning number of bytes }
+    TsSize   = ssize_t;
+    psSize   = ^ssize_t;		
+
+    uid_t    = cuint32;         { used for user ID type        }
+    TUid     = Uid_t;
+    pUid     = ^Uid_t;
+
+    clock_t  = culong;
+    TClock   = clock_t;
+    pClock   = ^clock_t;
+
+    time_t   = clong;           { used for returning the time  }
+    TTime    = time_t; 
+    pTime    = ^time_t;
+    ptime_t =  ^time_t;
+    
+    wchar_t   = cint32;
+    pwchar_t  = ^wchar_t;
+
+    socklen_t= cuint32;
+    TSocklen = socklen_t;
+    pSocklen = ^socklen_t;
+
+  timeval  = packed record
+    tv_sec,tv_usec:clong;
+  end;
+  ptimeval = ^timeval;
+  TTimeVal = timeval;
+
+  timespec = packed record
+    tv_sec   : time_t;
+    tv_nsec  : clong;
+  end;
+  ptimespec= ^timespec;
+  Ttimespec= timespec;
+  
+  pthread_t = culong;
+  
+  sched_param = record
+    __sched_priority: cint;
+  end;
+
+  pthread_attr_t = record
+    __detachstate: cint;
+    __schedpolicy: cint;
+    __schedparam: sched_param;
+    __inheritsched: cint;
+    __scope: cint;
+    __guardsize: size_t;
+    __stackaddr_set: cint;
+    __stackaddr: pointer;
+    __stacksize: size_t;
+  end;
+
+  _pthread_fastlock = record
+    __status: clong;
+    __spinlock: cint;
+  end;
+
+  pthread_mutex_t = record
+    __m_reserved: cint;
+    __m_count: cint;
+    __m_owner: pointer;
+    __m_kind:  cint;
+    __m_lock: _pthread_fastlock;
+  end;
+
+  pthread_mutexattr_t = record
+    __mutexkind: cint;
+  end;
+
+  pthread_cond_t = record
+    __c_lock: _pthread_fastlock;
+    __c_waiting: pointer;
+    __padding: array[0..48-1-sizeof(_pthread_fastlock)-sizeof(pointer)-sizeof(clonglong)] of byte;
+    __align: clonglong;
+  end;
+    
+  pthread_condattr_t = record
+    __dummy: cint;
+  end;
+
+  pthread_key_t = cuint;
+
+  pthread_rwlock_t = record
+    __rw_readers: cint;
+    __rw_writer: pointer;
+    __rw_read_waiting: pointer;
+    __rw_write_waiting: pointer;
+    __rw_kind: cint;
+    __rw_pshared: cint;
+  end;
+
+  pthread_rwlockattr_t = record
+    __lockkind: cint;
+    __pshared: cint;
+  end;
+  
+  sem_t = record
+     __sem_lock: _pthread_fastlock;
+     __sem_value: cint;
+     __sem_waiting: pointer;
+  end;
+
+   rlim_t		= int64;
+   TRlim		= rlim_t;
+
+
+CONST
+    _PTHREAD_MUTEX_TIMED_NP      = 0;
+    _PTHREAD_MUTEX_RECURSIVE_NP  = 1;
+    _PTHREAD_MUTEX_ERRORCHECK_NP = 2;
+    _PTHREAD_MUTEX_ADAPTIVE_NP   = 3;
+  
+    _PTHREAD_MUTEX_NORMAL     = _PTHREAD_MUTEX_TIMED_NP;
+    _PTHREAD_MUTEX_RECURSIVE  = _PTHREAD_MUTEX_RECURSIVE_NP;
+    _PTHREAD_MUTEX_ERRORCHECK = _PTHREAD_MUTEX_ERRORCHECK_NP;
+    _PTHREAD_MUTEX_DEFAULT    = _PTHREAD_MUTEX_NORMAL;
+    _PTHREAD_MUTEX_FAST_NP    = _PTHREAD_MUTEX_ADAPTIVE_NP;
+
+     _PTHREAD_KEYS_MAX              = 256;
+     _PTHREAD_STACK_MIN             = 1024;
+
+CONST
+   { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+    ARG_MAX  = 65536;   {4096}  { Maximum number of argument size     }
+    NAME_MAX = 255;     {14}    { Maximum number of bytes in filename }
+    PATH_MAX = 1024;    {255}   { Maximum number of bytes in pathname }
+
+    SYS_NMLN = 32;              {BSD utsname struct limit}
+    
+    SIG_MAXSIG = 32; //128;	// highest signal version  // BeOS  
+
+const
+  { For getting/setting priority }
+  Prio_Process = 0;
+  Prio_PGrp    = 1;
+  Prio_User    = 2;

rtl/haiku/settimeo.inc

@@ -0,0 +1,49 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2004 by Michael Van Canneyt,
+   member of 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.
+
+**********************************************************************}
+{$ifdef beos}
+{$ifdef i386}
+  {$define usestime}
+{$endif}
+{$endif}
+
+{$ifdef usestime}
+
+{$ifdef FPC_USE_LIBC}
+function stime (t:ptime_t):cint; cdecl; external name 'stime';
+{$else}
+function stime (t:ptime_t):cint; 
+begin
+ stime:=do_SysCall(Syscall_nr_stime,TSysParam(t));
+end;
+{$endif}
+
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
+
+begin
+  settimeofday:=stime(@tp^.tv_sec);
+end;
+
+{$else}
+
+{$ifdef FPC_USE_LIBC}
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
+{$else}
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
+
+begin
+  settimeofday:=do_SysCall(Syscall_nr_settimeofday,TSysParam(@tp),TSysParam(tzp));
+end;
+{$endif}
+{$endif}
+

rtl/haiku/signal.inc

@@ -0,0 +1,299 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of 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.
+
+ **********************************************************************}
+
+
+Const   { For sending a signal }
+
+  SA_NOCLDSTOP = 1;
+  
+  // does not exist under BeOS i think !
+  SA_ONSTACK   = $001; { take signal on signal stack }
+  SA_RESTART   = $002; { restart system call on signal return }
+  SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+  SA_NODEFER   = $010; { don't mask the signal we're delivering }
+  SA_NOCLDWAIT = $020; { don't keep zombies around }
+  SA_SIGINFO   = $040; { signal handler with SA_SIGINFO args }
+  SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+  SIG_BLOCK   = 1;
+  SIG_UNBLOCK = 2;
+  SIG_SETMASK = 3;
+
+{BeOS Checked}
+{
+   The numbering of signals for BeOS attempts to maintain 
+   some consistency with UN*X conventions so that things 
+   like "kill -9" do what you expect.
+}   
+
+  SIG_DFL = 0 ;
+  SIG_IGN = 1 ;
+  SIG_ERR = -1 ;
+
+  SIGHUP     = 1;
+  SIGINT     = 2;
+  SIGQUIT    = 3;
+  SIGILL     = 4;
+  SIGCHLD    = 5;
+  SIGABRT    = 6;
+  SIGPIPE    = 7;
+  SIGFPE     = 8;
+  SIGKILL    = 9;
+  SIGSTOP    = 10;
+  SIGSEGV    = 11;
+  SIGCONT    = 12;
+  SIGTSTP    = 13;
+  SIGALRM    = 14;
+  SIGTERM    = 15;
+  SIGTTIN    = 16;
+  SIGTTOU    = 17;
+  SIGUSR1    = 18;
+  SIGUSR2    = 19;
+  SIGWINCH   = 20;
+  SIGKILLTHR = 21;
+  SIGTRAP    = 22;
+  SIGBUS     = SIGSEGV;
+  
+{
+   Signal numbers 23-32 are currently free but may be used in future
+   releases.  Use them at your own peril (if you do use them, at least
+   be smart and use them backwards from signal 32).
+}
+
+{$packrecords C}
+const
+  SI_PAD_SIZE   = ((128/sizeof(longint)) - 3);
+
+{
+ * The sequence of the fields/registers in struct sigcontext should match
+ * those in mcontext_t.
+ }
+
+type 
+  packed_fp_stack = packed record
+    st0 : array[0..9] of byte;
+    st1 : array[0..9] of byte;
+    st2 : array[0..9] of byte;
+    st3 : array[0..9] of byte;
+    st4 : array[0..9] of byte;
+    st5 : array[0..9] of byte;
+    st6 : array[0..9] of byte;    
+    st7 : array[0..9] of byte;    
+  end;
+  
+  packed_mmx_regs = packed record
+    mm0 : array[0..9] of byte;
+    mm1 : array[0..9] of byte;
+    mm2 : array[0..9] of byte;
+    mm3 : array[0..9] of byte;
+    mm4 : array[0..9] of byte;
+    mm5 : array[0..9] of byte;
+    mm6 : array[0..9] of byte;    
+    mm7 : array[0..9] of byte;    
+  end;
+  
+  old_extended_regs = packed record
+    fp_control 	: word;
+    _reserved1 	: word;
+    fp_status 	: word;
+    _reserved2 	: word;
+    fp_tag 		: word;
+    _reserved3 	: word;
+    fp_eip 		: cardinal;
+    fp_cs 		: word;
+    fp_opcode	: word;
+    fp_datap	: word;
+    fp_ds		: word;
+    _reserved4	: word;
+    fp_mmx : record
+      case fp_mmx : byte of
+        0 : (fp	: packed_fp_stack);
+        1 : (mmx	: packed_mmx_regs);
+    end;
+  end;
+  
+  fp_stack = record
+    st0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    st1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    st2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    st3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    st4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    st5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    st6 : array[0..9] of byte;    
+    _reserved_138_143 : array[0..5] of byte;
+    st7 : array[0..9] of byte;        
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+  
+  mmx_regs = record
+    mm0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    mm1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    mm2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    mm3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    mm4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    mm5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    mm6 : array[0..9] of byte;    
+    _reserved_138_143 : array[0..5] of byte;
+    mm7 : array[0..9] of byte;    
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+  
+  xmmx_regs = record
+    xmm0 : array [0..15] of byte;
+    xmm1 : array [0..15] of byte;
+    xmm2 : array [0..15] of byte;
+    xmm3 : array [0..15] of byte;
+    xmm4 : array [0..15] of byte;
+    xmm5 : array [0..15] of byte;
+    xmm6 : array [0..15] of byte;
+    xmm7 : array [0..15] of byte;
+  end;
+  
+  new_extended_regs = record
+    fp_control 	: word;
+    fp_status 	: word;
+    fp_tag		: word;
+    fp_opcode	: word;
+    fp_eip		: Cardinal;
+    fp_cs		: word;
+    res_14_15	: word;
+    fp_datap	: Cardinal;
+    fp_ds		: word;
+    _reserved_22_23 : word;
+    mxcsr		: Cardinal;
+    _reserved_28_31 : Cardinal;
+    fp_mmx : record
+      case byte of
+        0 : (fp : fp_stack);
+        1 : (mmx : mmx_regs);
+    end;
+    xmmx : xmmx_regs;
+    _reserved_288_511 : array[0..223] of byte;
+  end;
+  
+  extended_regs = record
+    state : record
+      case byte of
+  	    0 : (old_format : old_extended_regs);
+  	    1 : (new_format : new_extended_regs);  	  
+  	end;
+  	format	: Cardinal;
+  end;
+  
+  vregs = record
+    eip 	: Cardinal;
+    eflags 	: cardinal;
+    eax		: Cardinal;
+    ecx		: Cardinal;
+    edx		: Cardinal;
+    esp		: Cardinal;
+    ebp		: Cardinal;
+    _reserved_1 : Cardinal;
+    xregs	: extended_regs;
+    _reserved_2 : array[0..2] of Cardinal;
+  end;
+  
+  Pvregs = ^vregs;
+
+  sigset_t = array[0..3] of Longint;
+
+    PSigContextRec = ^SigContextRec;
+    SigContextRec = record
+       sc_mask      : sigset_t;          { signal mask to restore }
+       sc_onstack   : longint;              { sigstack state to restore }
+
+       sc_gs        : longint;              { machine state (struct trapframe): }
+       sc_fs        : longint;
+       sc_es        : longint;
+       sc_ds        : longint;
+       sc_edi       : longint;
+       sc_esi       : longint;
+       sc_ebp       : longint;
+       sc_isp       : longint;
+       sc_ebx       : longint;
+       sc_edx       : longint;
+       sc_ecx       : longint;
+       sc_eax       : longint;
+       sc_trapno    : longint;
+       sc_err       : longint;
+       sc_eip       : longint;
+       sc_cs        : longint;
+       sc_efl       : longint;
+       sc_esp       : longint;
+       sc_ss        : longint;
+        {
+         * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
+         * needed here), or that + 16 * 4 bytes for emulators (probably all
+         * needed here).  The "spare" bytes are mostly not spare.
+         }
+       en_cw        : cardinal;     { control word (16bits used) }
+       en_sw        : cardinal;     { status word (16bits) }
+       en_tw        : cardinal;     { tag word (16bits) }
+       en_fip       : cardinal;     { floating point instruction pointer }
+       en_fcs       : word;         { floating code segment selector }
+       en_opcode    : word;         { opcode last executed (11 bits ) }
+       en_foo       : cardinal;     { floating operand offset }
+       en_fos       : cardinal;     { floating operand segment selector }
+       fpr_acc      : array[0..79] of char;
+       fpr_ex_sw    : cardinal;
+       fpr_pad      : array[0..63] of char;
+       end;
+       
+  SignalHandler   = Procedure(Sig : Longint);cdecl;
+  PSignalHandler  = ^SignalHandler;
+  SignalRestorer  = Procedure;cdecl;
+  PSignalRestorer = ^SignalRestorer;
+  {$WARNING TODO : check with signal.h}
+  sigActionHandler = procedure(Sig: Longint; SigContext: PSigContextRec; uContext : Pvregs);cdecl;
+
+  Sigset=sigset_t;
+  TSigset=sigset_t;
+  PSigSet = ^SigSet;
+  psigset_t=psigset;
+
+  SigActionRec = packed record
+//    Handler  : record
+    sa_handler : sigActionHandler;
+//      case byte of
+//        0: (Sh: SignalHandler);
+//        1: (Sa: TSigAction);
+//      end;
+    sa_Mask     : SigSet;
+    sa_Flags    : Longint;
+    sa_userdaa  : pointer
+  end;
+
+  PSigActionRec = ^SigActionRec;
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+
+
+

rtl/haiku/suuid.inc

@@ -0,0 +1,38 @@
+Const 
+  RandomDevice  = '/dev/urandom';
+
+
+Function GetURandomBytes(Var Buf; NBytes : Integer) : Boolean;
+
+Var
+  fd,I : Integer;
+  P : PByte;
+  
+begin
+  P:=@Buf;
+  fd:=FileOpen(RandomDevice,fmOpenRead);
+  Result:=(fd>=0);
+  if Result then
+    Try
+      While (NBytes>0) do
+        begin
+        I:=FileRead(fd,P^,nbytes);
+        If I>0 then
+          begin
+          Inc(P,I);
+          Dec(NBytes,I);
+          end;
+        end;  
+    Finally
+      FileClose(Fd);
+    end;
+end;
+
+
+Function SysCreateGUID(out GUID : TGUID) : Integer;
+
+begin
+  if not GetUrandomBytes(Guid,SizeOf(GUID)) then
+    GetRandomBytes(GUID,SizeOf(Guid));  
+  Result:=0;    
+end;

rtl/haiku/syscall.inc

@@ -0,0 +1,78 @@
+{
+    $Id: syscall.inc,v 1.1 2003/01/08 22:32:28 marco Exp $
+    Copyright (c) 1998-2000 by Florian Klaempfl
+
+    This include implements the actual system call for the
+    intel BeOS 80x86 platform.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
+// is register instead of stdcall. But assembler is already written, so i used the stdcall
+// calling convention !
+function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; stdcall; assembler; [public, alias : 'FPC_SYSCALL'];
+{
+  This routine sets up the parameters on the stack, all the parameters 
+  are in reverse order on the stack (like C parameter passing).
+}
+asm
+  { load the parameters... }
+  movl  regs,%eax
+  movl  24(%eax),%ebx
+  pushl %ebx
+  movl  20(%eax),%ebx
+  pushl %ebx 
+  movl  16(%eax),%ebx
+  pushl %ebx
+  movl  12(%eax),%ebx
+  pushl %ebx
+  movl  8(%eax),%ebx
+  pushl %ebx
+  movl  4(%eax),%ebx
+  pushl %ebx
+  movl  0(%eax),%ebx
+  pushl %ebx
+  { set the call number }
+  movl  callnr,%eax
+  call  sys_call
+  addl  $28,%esp
+end;
+
+// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
+// is register instead of stdcall. But assembler is already written, so i used the stdcall
+// calling convention ! Maybe don't needed here. But to be sure...
+Function SysCall( callnr:longint;var args : SysCallArgs ):longint; stdcall;
+{
+  This function serves as an interface to do_SysCall.
+  If the SysCall returned a negative number, it returns -1, and puts the
+  SysCall result in errno. Otherwise, it returns the SysCall return value
+}
+var
+ funcresult : longint;
+begin
+  funcresult := do_SysCall(callnr, args);
+  if funcresult < 0 then
+   begin
+     errno := funcresult;
+     SysCall := - 1;
+   end
+  else
+   begin
+     SysCall := funcresult;
+     errno := 0;
+   end;
+end;

rtl/haiku/syscallh.inc

@@ -0,0 +1,55 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for i386 *BSD.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+  TSysResult = longint; // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = longint;
+  
+type
+     SysCallArgs = packed record
+       param: array[1..8] of longint; // cint but not defined in unix.pp
+     End;
+
+{$IFDEF FPC_USE_LIBC}
+//var
+//  Errno : cint;
+  
+{$else}
+//var
+//  Errno : cint;
+
+{$ENDIF}
+procedure sys_call; external name 'sys_call'; // BeOS
+//begin
+//end;
+
+  
+//function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; external name 'FPC_SYSCALL';//forward;
+//Function SysCall( callnr:longint;var args : SysCallArgs ):longint; external name 'sys_call';//forward;

rtl/haiku/sysconst.inc

@@ -0,0 +1,91 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    Constants for Unix unit.
+
+    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.
+
+ **********************************************************************}
+
+
+const
+  { Things for LSEEK call}
+  Seek_set = 0;
+  Seek_Cur = 1;
+  Seek_End = 2;
+
+  { The waitpid uses the following options:}
+  Wait_NoHang   = 1;
+  Wait_UnTraced = 2;
+  Wait_Any      = -1;
+  Wait_MyPGRP   = 0;
+
+
+  { Constants to check stat.mode -  checked all STAT constants with BSD}
+  STAT_IFMT   = $f000; {00170000 }
+  STAT_IFSOCK = $c000; {0140000 }
+  STAT_IFLNK  = $a000; {0120000 }
+  STAT_IFREG  = $8000; {0100000 }
+  STAT_IFBLK  = $6000; {0060000 }
+  STAT_IFDIR  = $4000; {0040000 }
+  STAT_IFCHR  = $2000; {0020000 }
+  STAT_IFIFO  = $1000; {0010000 }
+  STAT_ISUID  = $0800; {0004000 }
+  STAT_ISGID  = $0400; {0002000 }
+  STAT_ISVTX  = $0200; {0001000}
+  { Constants to check permissions all }
+  STAT_IRWXO = $7;
+  STAT_IROTH = $4;
+  STAT_IWOTH = $2;
+  STAT_IXOTH = $1;
+
+  STAT_IRWXG = STAT_IRWXO shl 3;
+  STAT_IRGRP = STAT_IROTH shl 3;
+  STAT_IWGRP = STAT_IWOTH shl 3;
+  STAT_IXGRP = STAT_IXOTH shl 3;
+
+  STAT_IRWXU = STAT_IRWXO shl 6;
+  STAT_IRUSR = STAT_IROTH shl 6;
+  STAT_IWUSR = STAT_IWOTH shl 6;
+  STAT_IXUSR = STAT_IXOTH shl 6;
+
+  { Constants to test the type of filesystem }
+  fs_old_ext2 = $ef51;
+  fs_ext2     = $ef53;
+  fs_ext      = $137d;
+  fs_iso      = $9660;
+  fs_minix    = $137f;
+  fs_minix_30 = $138f;
+  fs_minux_V2 = $2468;
+  fs_msdos    = $4d44;
+  fs_nfs      = $6969;
+  fs_proc     = $9fa0;
+  fs_xia      = $012FD16D;
+
+  {Constansts Termios/Ioctl (used in Do_IsDevice) }
+  IOCtl_TCGETS= $40000000+$2C7400+ 19; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+  ITimer_Real    =0;
+  ITimer_Virtual =1;
+  ITimer_Prof    =2;
+
+{
+  {Checked for BSD using Linuxthreads port}
+  { cloning flags }
+  CSIGNAL       = $000000ff; // signal mask to be sent at exit
+  CLONE_VM      = $00000100; // set if VM shared between processes
+  CLONE_FS      = $00000200; // set if fs info shared between processes
+  CLONE_FILES   = $00000400; // set if open files shared between processes
+  CLONE_SIGHAND = $00000800; // set if signal handlers shared
+  CLONE_PID     = $00001000; // set if pid shared
+
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+}

rtl/haiku/sysheap.inc

@@ -0,0 +1,36 @@
+{
+    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.
+
+ **********************************************************************}
+function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+{  result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);}
+  result := sbrk2(size);
+  if result=pointer(-1) then
+    result:=nil
+  else
+    seterrno(0);
+end;
+
+{ $ define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+  //  fpmunmap(p, size);
+end;
+
+

rtl/haiku/sysnr.inc

@@ -0,0 +1,47 @@
+const
+      { BeOS specific calls }
+      syscall_nr_create_area = $14;
+      syscall_nr_resize_area = $08;
+      syscall_nr_delete_area = $15;
+      syscall_nr_load_image  = $34;
+      syscall_nr_wait_thread = $22;
+      syscall_nr_rstat       = $30;
+      syscall_nr_statfs      = $5F;
+      syscall_nr_get_team_info = $3b;
+      syscall_nr_kill_team   = $3a;
+      syscall_nr_get_system_info = $56;
+      syscall_nr_kget_tzfilename = $AF;
+      syscall_nr_get_next_image_info = $3C;
+
+const           
+      syscall_nr_exit   		= $3F;
+      syscall_nr_chdir  		= $57; 
+      syscall_nr_mkdir  		= $1E; 
+      syscall_nr_unlink 		= $27;
+      syscall_nr_rmdir  		= $60;
+      syscall_nr_close  		= $01;
+      syscall_nr_read   		= $02;
+      syscall_nr_write  		= $03;
+      syscall_nr_stat   		= $30;
+      syscall_nr_fstat  		= $30;
+      syscall_nr_rename 		= $26;
+      syscall_nr_access 		= $58;
+      syscall_nr_opendir		= $0C;
+      syscall_nr_closedir		= $0F;
+      syscall_nr_sigaction		= $70;
+      syscall_nr_time     		= $07;
+      syscall_nr_open     		= $00;
+      syscall_nr_readdir  		= $1C;
+      syscall_nr_lseek    		= $05;
+      syscall_nr_ftruncate 		= $4B;
+      syscall_nr_ioctl    		= $04;
+      syscall_nr_gettimeofday 	= $A6;
+      syscall_nr_fork           = $A1;
+      syscall_nr_waitpid        = $A3;
+      syscall_nr_fcntl          = $0B;
+      syscall_nr_dup            = syscall_nr_fcntl;
+      syscall_nr_dup2           = $4A;
+      syscall_nr_sbrk           = syscall_nr_resize_area;
+      syscall_nr_getpid         = $00; // not a syscall under BeOS
+      syscall_nr_sigprocmask    = $73;
+      syscall_nr_getcwd         = $00; // not a syscall under BeOS

rtl/haiku/sysos.inc

@@ -0,0 +1,148 @@
+{
+    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.
+
+ **********************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+
+const clib = 'c';
+
+type libcint=longint;
+     plibcint=^libcint;
+
+function geterrnolocation: Plibcint; cdecl;external 'root' name '_errnop';
+
+function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ geterrno:=geterrnolocation^;
+end;
+
+procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
+begin
+  geterrnolocation^:=err;
+end;
+
+{$else}
+{$ifdef ver1_0}
+Var
+{$else}
+threadvar
+{$endif}
+      Errno : longint;
+
+function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ GetErrno:=Errno;
+end;
+
+procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
+
+begin
+ Errno:=err;
+end;
+{$endif}
+
+{ OS dependant parts  }
+
+{$I errno.inc}                          // error numbers
+{$I ostypes.inc}                        // c-types, unix base types, unix base structures
+{$I osmacro.inc}
+
+{$ifdef FPC_USE_LIBC}
+  {$Linklib c}
+  {$i oscdeclh.inc}
+  {$i oscdecl.inc}
+{$else}
+  {$I syscallh.inc}
+  {$I syscall.inc}
+  {$I sysnr.inc}
+  {$I ossysc.inc}
+{$endif}
+
+
+{*****************************************************************************
+                            Error conversion
+*****************************************************************************}
+
+{
+  The lowlevel file functions should take care of setting the InOutRes to the
+  correct value if an error has occured, else leave it untouched
+}
+
+Function PosixToRunError  (PosixErrno : longint) : longint;
+{
+  Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+  if PosixErrNo=0 then { Else it will go through all the cases }
+   exit(0);
+  case PosixErrNo of
+   ESysENFILE,
+   ESysEMFILE : Inoutres:=4;
+   ESysENOENT : Inoutres:=2;
+    ESysEBADF : Inoutres:=6;
+   ESysENOMEM,
+   ESysEFAULT : Inoutres:=217;
+   ESysEINVAL : Inoutres:=218;
+    ESysEPIPE,
+    ESysEINTR,
+      ESysEIO,
+   ESysEAGAIN,
+   ESysENOSPC : Inoutres:=101;
+ ESysENAMETOOLONG : Inoutres := 3;
+    ESysEROFS,
+   ESysEEXIST,
+   ESysENOTEMPTY,
+   ESysEACCES : Inoutres:=5;
+   ESysEISDIR : InOutRes:=5;
+   ESysEPERM  : InOutRes:=5;
+  else
+    begin
+       InOutRes := Integer(PosixErrno);
+    end;
+  end;
+ PosixToRunError:=InOutRes;
+end;
+
+Function Errno2InoutRes : longint;
+
+begin
+  Errno2InoutRes:=PosixToRunError(getErrno);
+  InoutRes:=Errno2InoutRes;
+end;
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+CONST
+  IOCtl_TCGETS=$5401;
+var
+  Data : array[0..255] of byte; {Large enough for termios info}
+begin
+  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;

rtl/haiku/sysosh.inc

@@ -0,0 +1,35 @@
+{
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+  { fd are int in C also for 64bit targets (x86_64) }
+  THandle = Longint;
+  TThreadID = THandle;
+  
+  { pthread_mutex_t }
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+    __m_reserved: longint;
+    __m_count: longint;
+    __m_owner: pointer;
+    __m_kind:  longint;
+    __m_lock:  record
+       __status: sizeint;
+      __spinlock: longint;
+    end;
+  end;

rtl/haiku/system.pp

@@ -0,0 +1,421 @@
+Unit system;
+
+interface
+
+// Was needed to bootstrap with our old 2.1 fpc for BeOS
+// to define real
+{ $define VER2_0}
+
+{$define FPC_IS_SYSTEM}
+
+{$I sysunixh.inc}
+
+  
+type
+  THeapPointer = ^pointer;
+var
+  heapstartpointer : THeapPointer;
+  heapstart : pointer;//external;//external name 'HEAP';
+  myheapsize : longint; //external;//external name 'HEAPSIZE';
+  myheaprealsize : longint;
+  heap_handle : longint;
+implementation
+
+procedure debugger(s : PChar); cdecl; external 'root' name 'debugger';
+
+function disable_debugger(state : integer): integer; external 'root' name 'disable_debugger';
+//begin
+//end;
+
+{ OS independant parts}
+
+{$I system.inc}
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+procedure prthaltproc;external name '_haltproc';
+
+procedure system_exit;
+begin
+  asm
+    jmp prthaltproc
+  end;
+End;
+
+
+{ OS dependant parts  }
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+(*var myheapstart:pointer;
+    myheapsize:longint;
+    myheaprealsize:longint;
+    heap_handle:longint;
+    zero:longint;
+
+
+{ first address of heap }
+function getheapstart:pointer;
+begin
+   getheapstart:=myheapstart;
+end;
+
+{ current length of heap }
+function getheapsize:longint;
+begin
+   getheapsize:=myheapsize;
+end;
+*)
+
+
+(*function getheapstart:pointer;
+assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;
+assembler;
+asm
+        movl    intern_HEAPSIZE,%eax
+end ['EAX'];*)
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+(*function Sbrk(size : longint):pointer;
+var newsize,newrealsize:longint;
+  s : string;
+begin
+  WriteLn('SBRK');
+  Str(size, s);
+  WriteLn('size : ' + s);
+  if (myheapsize+size)<=myheaprealsize then 
+  begin
+    Sbrk:=pointer(heapstart+myheapsize);
+    myheapsize:=myheapsize+size;
+    exit;
+  end;
+  newsize:=myheapsize+size;
+  newrealsize:=(newsize and $FFFFF000)+$1000;
+  case resize_area(heap_handle,newrealsize) of
+    B_OK : 
+      begin
+        WriteLn('B_OK');
+        Sbrk:=pointer(heapstart+myheapsize);
+        myheapsize:=newsize;
+        myheaprealsize:=newrealsize;
+        exit;
+      end;
+    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+    B_ERROR : WriteLn('B_ERROR');
+    else
+      begin
+        Sbrk:=pointer(heapstart+myheapsize);
+        myheapsize:=newsize;
+        myheaprealsize:=newrealsize;
+        exit;
+      end;
+  end;
+
+//  Sbrk:=nil;
+end;*)
+
+function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
+
+//function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
+
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+//function Sbrk(size : longint):pointer;
+//var newsize,newrealsize:longint;
+//  s : string;
+//begin
+//  sbrk := sbrk2(size);
+(*  sbrk := nil;
+  WriteLn('sbrk');
+  Str(size, s);
+  WriteLn('size : ' + s);
+  if (myheapsize+size)<=myheaprealsize then 
+  begin
+    Sbrk:=heapstart+myheapsize;
+    myheapsize:=myheapsize+size;
+    exit;
+  end;
+  newsize:=myheapsize+size;
+  newrealsize:=(newsize and $FFFFF000)+$1000;
+  if sys_resize_area(heap_handle,newrealsize+$1000)=0 then 
+  begin
+    WriteLn('sys_resize_area OK');
+    Str(longint(newrealsize), s);
+    WriteLn('newrealsize : $' + Hexstr(longint(newrealsize), 8));
+    Str(longint(heapstartpointer), s);
+    WriteLn('heapstart : $' + Hexstr(longint(heapstart), 8));
+    Str(myheapsize, s);
+    WriteLn('myheapsize : ' + s);
+    Str(myheapsize, s);
+    WriteLn('Total : ' + s);
+    WriteLn('Before fillchar');
+    WriteLn('sbrk : $' + Hexstr(longint(heapstart+myheapsize), 8));        
+    Sbrk:=heapstart+myheapsize;
+    FillChar(sbrk^, size, #0);    
+    WriteLn('EndFillChar');
+    WriteLn('sbrk : $' + Hexstr(longint(sbrk), 8));
+//    ReadLn(s);
+    myheapsize:=newsize;
+    Str({longint(heapstartpointer) +} myheapsize, s);
+    WriteLn('Total : ' + s);    
+    myheaprealsize:=newrealsize;
+    exit;
+  end
+  else
+  begin
+    debugger('Bad resize_area');
+    WriteLn('Bad resize_area');
+  end;
+  Sbrk:=nil;
+*)
+//end;
+
+{ $I text.inc}
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+
+{ $i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{ $i typefile.inc}
+
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
+
+Function ParamCount: Longint;
+var
+  s : string;
+Begin
+  ParamCount := 0;
+  Paramcount:=argc - 1;
+End;
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit.                    }
+var
+ execpathstr : shortstring;
+
+{$ifdef FPC_USE_LIBC}
+
+// private; use the macros, below
+function _get_image_info(image : image_id; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_image_info';
+
+function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_image_info';
+
+function get_image_info(image : image_id; var info : image_info) : status_t;
+begin
+  Result := _get_image_info(image, info, SizeOf(info));
+end;
+
+function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
+begin
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
+end;
+
+{$endif}
+
+{ this routine sets up the paramstr(0) string at startup }
+procedure setupexecname;
+var
+ cookie: longint;
+ image : image_info;
+ index : byte;
+ s : string;
+begin
+  cookie:=0;
+  fillchar(image, sizeof(image_info), 0);
+  if get_next_image_info(0, cookie, image) = B_OK then
+  begin
+    execpathstr := strpas(@image.name);
+  end
+  else
+    execpathstr := '';
+  { problem with Be 4.5 noted... path contains . character }
+  { if file is directly executed in CWD                    }
+  index:=pos('/./',execpathstr);
+  if index <> 0 then
+    begin
+      { remove the /. characters }
+      Delete(execpathstr,index, 2);
+    end;
+end;
+
+function paramstr(l: longint) : string;
+var
+  s: string;
+  s1: string;
+begin
+   
+  { stricly conforming POSIX applications  }
+  { have the executing filename as argv[0] }
+  if l = 0 then
+  begin
+    paramstr := execpathstr;
+  end
+  else if (l < argc) then
+  begin
+    paramstr:=strpas(argv[l]);
+  end
+  else
+    paramstr := '';
+end;
+
+Procedure Randomize;
+Begin
+  randseed:=longint(Fptime(nil));
+End;
+
+function GetProcessID: SizeUInt;
+begin
+  GetProcessID := SizeUInt (fpGetPID);
+end;
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+function  reenable_signal(sig : longint) : boolean;
+var
+  e : TSigSet;
+  i,j : byte;
+begin
+  fillchar(e,sizeof(e),#0);
+  { set is 1 based PM }
+  dec(sig);
+  i:=sig mod (sizeof(cuLong) * 8);
+  j:=sig div (sizeof(cuLong) * 8);
+  e[j]:=1 shl i;
+  fpsigprocmask(SIG_UNBLOCK,@e,nil);
+  reenable_signal:=geterrno=0;
+end;
+
+// signal handler is arch dependant due to processorexception to language
+// exception translation
+
+{$i sighnd.inc}
+
+var
+  act: SigActionRec;
+
+Procedure InstallSignals;
+begin
+  { Initialize the sigaction structure }
+  { all flags and information set to zero }
+  FillChar(act, sizeof(SigActionRec),0);
+  { initialize handler                    }
+  act.sa_handler := SigActionHandler(@SignalToRunError);
+  act.sa_flags:=SA_SIGINFO;
+  FpSigAction(SIGFPE,@act,nil);
+  FpSigAction(SIGSEGV,@act,nil);
+  FpSigAction(SIGBUS,@act,nil);
+  FpSigAction(SIGILL,@act,nil);
+end;
+
+procedure SysInitStdIO;
+begin
+  { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+    displayed in and messagebox }
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+end;
+
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
+var
+  s : string;
+begin
+  IsConsole := TRUE;
+  IsLibrary := FALSE;
+  StackLength := CheckInitialStkLen(InitialStkLen);
+  StackBottom := Sptr - StackLength;
+
+  SysResetFPU;
+  if not(IsLibrary) then
+    SysInitFPU;
+
+  { Set up signals handlers }
+  InstallSignals;
+
+  SysInitStdIO;
+{ Setup heap }
+  myheapsize:=4096*1;// $ 20000;
+  myheaprealsize:=4096*1;// $ 20000;
+  heapstart:=nil;
+  heapstartpointer := nil;
+  heapstartpointer := Sbrk2(4096*1);
+{$IFDEF FPC_USE_LIBC}  
+//  heap_handle := create_area('fpcheap',heapstart,0,myheaprealsize,0,3);//!!
+{$ELSE}
+//  debugger('tata'#0);
+//  heap_handle := create_area('fpcheap',longint(heapstartpointer),0,myheaprealsize,0,3);//!!
+//  case heap_handle of
+//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+//    B_ERROR : WriteLn('B_ERROR');
+//  end;
+
+  FillChar(heapstartpointer^, myheaprealsize, #0);
+//  WriteLn('EndFillChar');
+//    WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
+//    WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));        
+  heapstart := heapstartpointer;
+{$ENDIF}
+//  WriteLn('before InitHeap');
+//  case heap_handle of
+//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+//    B_ERROR : WriteLn('B_ERROR');
+//  else
+//    begin
+//      WriteLn('ok');  
+//      WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
+//      WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));       
+//      if heap_handle>0 then 
+//      begin
+        InitHeap;
+//      end;
+//    end;
+//  end;
+//  WriteLn('after InitHeap');
+//  end else system_exit;
+  SysInitExceptions;
+//  WriteLn('after SysInitException');
+
+{ Setup IO }
+  SysInitStdIO;
+{ Reset IO Error }
+  InOutRes:=0;
+  InitSystemThreads;
+{$ifdef HASVARIANT}
+  initvariantmanager;
+{$endif HASVARIANT}
+  initwidestringmanager;
+  setupexecname;
+end.

rtl/haiku/termio.pp

@@ -0,0 +1,41 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Peter Vreman
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This file contains the termios interface.
+
+    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 termio;
+
+interface
+
+Uses BaseUnix;          // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.

rtl/haiku/termios.inc

@@ -0,0 +1,417 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 by Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   Termios header for FreeBSD
+
+   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.
+}
+
+CONST
+
+{
+ * Special Control Characters
+ *
+ * Index into c_cc[] character array.
+ *
+ *      Name         Subscript  Enabled by
+ }
+ { control characters }
+VINTR	= 0;
+VQUIT	= 1;
+VERASE	= 2;
+VKILL	= 3;
+VEOF	= 4;
+VEOL	= 5;
+VMIN	= 4;
+VTIME	= 5;
+VEOL2	= 6;
+VSWTCH	= 7;
+VSTART  = 8;
+VSTOP   = 9;
+VSUSP   = 10;
+
+{ number of control characters }
+ NCC	= 11;
+ NCCS           =NCC;
+
+Type
+  winsize = packed record
+    ws_row,
+    ws_col,
+    ws_xpixel,
+    ws_ypixel : word;
+  end;
+  TWinSize=winsize;
+
+// typedef unsigned long tcflag_t;
+// typedef unsigned char speed_t;
+// typedef unsigned char cc_t;
+ tcflag_t = Cardinal;
+ speed_t = byte;
+ cc_t = char;
+
+type
+  Termios = packed record
+    c_iflag,
+    c_oflag,
+    c_cflag,
+    c_lflag  : tcflag_t;
+    c_line   : char;
+    c_ixxxxx : speed_t;
+    c_oxxxxx : speed_t;
+    c_cc     : array[0..NCCS-1] of speed_t;
+  end;
+  TTermios=Termios;
+
+CONST
+
+
+ POSIX_VDISABLE=Chr($ff);
+{
+
+#define CCEQ(val, c)    ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+
+{ * Input flags - software input processing}
+
+        IGNBRK          =       $1;     { ignore BREAK condition }
+        BRKINT          =       $2;     { map BREAK to SIGINTR }
+        IGNPAR          =       $4;     { ignore (discard) parity errors }
+        PARMRK          =       $8;     { mark parity and framing errors }
+        INPCK           =      $10;     { enable checking of parity errors }
+        ISTRIP          =      $20;     { strip 8th bit off chars }
+        INLCR           =      $40;     { map NL into CR }
+        IGNCR           =      $80;     { ignore CR }
+        ICRNL           =     $100;     { map CR to NL (ala CRMOD) }
+        IUCLC			=	  $200;		{ maps all upper case to lower }
+        IXON            =     $400;     { enable output flow control }
+        IXANY           =     $800;     { enable input flow control }
+        IXOFF           =    $1000;	    { any char will restart after stop }
+
+{
+ * Output flags - software output processing
+}
+
+OPOST		= $01;		{ enable postprocessing of output }
+OLCUC		= $02;		{ maps lowercase to uppercase }
+ONLCR		= $04;		{ maps NL to CR-NL on output }
+OCRNL		= $08;		{ maps CR to NL on output }
+ONOCR		= $10;		{ no CR output when at column 0 }
+ONLRET		= $20;		{ newline performs CR function }
+OFILL		= $40;		{ uses fill characters for delays }
+OFDEL		= $80;		{ Fills are DEL, otherwise NUL }
+NLDLY		= $100;		{ Newline delays: }
+NL0			= $000;
+NL1			= $100;
+CRDLY		= $600;		{ Carriage return delays: }
+CR0			= $000;
+CR1			= $200;
+CR2			= $400;
+CR3			= $600;
+TABDLY		= $1800;		{ Tab delays: }
+TAB0		= $0000;
+TAB1		= $0800;
+TAB2		= $1000;
+TAB3		= $1800;
+BSDLY		= $2000;		{ Backspace delays: }
+BS0			= $0000;
+BS1			= $2000;
+VTDLY		= $4000;		{ Vertical tab delays: }
+VT0			= $0000;
+VT1			= $4000;
+FFDLY		= $8000;		{ Form feed delays: }
+FF0			= $0000;
+FF1			= $8000;
+
+{
+  c_cflag - control modes
+}
+
+CBAUD		= $1F;			{ line speed definitions }
+
+B0			= $00;
+B50			= $01;
+B75			= $02;
+B110		= $03;
+B134		= $04;
+B150		= $05;
+B200		= $06;
+B300		= $07;
+B600		= $08;
+B1200		= $09;
+B1800		= $0A;
+B2400		= $0B;
+B4800		= $0C;
+B9600		= $0D;
+B19200		= $0E;
+B38400		= $0F;
+B57600		= $10;
+B115200		= $11;
+B230400		= $12;
+B31250		= $13;			{ for MIDI }
+
+CSIZE		= $20;			{ character size }
+CS5			= $00;			{ only 7 and 8 bits supported }
+CS6			= $00;
+CS7			= $00;
+CS8			= $20;
+CSTOPB		= $40;			{ send 2 stop bits, not 1 }
+CREAD		= $80;			{ enables receiver }
+PARENB		= $100;			{ xmit parity enable }
+PARODD		= $200;			{ odd parity, else even }
+HUPCL		= $400;			{ hangs up on last close }
+CLOCAL		= $800;			{ indicates local line }
+XLOBLK		= $1000;			{ block layer output ?}
+CTSFLOW		= $2000;			{ enable CTS flow }
+RTSFLOW		= $4000;			{ enable RTS flow }
+CRTSCTS		= RTSFLOW or CTSFLOW;
+
+
+
+{
+ * "Local" flags - dumping ground for other state
+ *
+ * Warning: some flags in this structure begin with
+ * the letter "I" and look like they belong in the
+ * input flag.
+ }
+ 
+{
+  c_lflag - local modes
+}
+
+ISIG		= $01;			{ enable signals }
+ICANON		= $02;			{ Canonical input }
+XCASE		= $04;			{ Canonical u/l case }
+ECHO		= $08;			{ Enable echo }
+ECHOE		= $10;			{ Echo erase as bs-sp-bs }
+ECHOK		= $20;			{ Echo nl after kill }
+ECHONL		= $40;			{ Echo nl }
+NOFLSH		= $80;			{ Disable flush after int or quit }
+TOSTOP      = $100;         { stop bg processes that write to tty }
+IEXTEN      = $200;         { implementation defined extensions }
+
+{
+  Event codes.  Returned from TCWAITEVENT
+}
+EV_RING			= $0001;
+EV_BREAK		= $0002;
+EV_CARRIER		= $0004;
+EV_CARRIERLOST	= $0008;
+ 
+{
+ * Commands passed to tcsetattr() for setting the termios structure.
+}
+
+CONST
+
+        TCSANOW         = $01;             { make change immediate }
+        TCSADRAIN       = $02;             { drain output, then change }
+        TCSAFLUSH       = $04;             { drain output, flush input }
+        
+        // TCASOFT undefined under BeOS
+        TCSASOFT        = $10;           { flag - don't alter h.w. state }
+
+
+        TCIFLUSH        = $01;
+        TCOFLUSH        = $02;
+        TCIOFLUSH       = (TCIFLUSH or TCOFLUSH);
+        TCOOFF          = $01;
+        TCOON           = $02;
+        TCIOFF          = $04;
+        TCION           = $08;
+
+{
+#include <sys/cdefs.h>
+
+__BEGIN_DECLS
+speed_t cfgetispeed __P((const struct termios *));
+speed_t cfgetospeed __P((const struct termios *));
+int     cfsetispeed __P((struct termios *, speed_t));
+int     cfsetospeed __P((struct termios *, speed_t));
+int     tcgetattr __P((int, struct termios *));
+int     tcsetattr __P((int, int, const struct termios *));
+int     tcdrain __P((int));
+int     tcflow __P((int, int));
+int     tcflush __P((int, int));
+int     tcsendbreak __P((int, int));
+
+#ifndef _POSIX_SOURCE
+void    cfmakeraw __P((struct termios *));
+int     cfsetspeed __P((struct termios *, speed_t));
+#endif { !_POSIX_SOURCE }
+__END_DECLS
+
+#endif { !_KERNEL }
+
+
+
+struct winsize {
+        unsigned short  ws_row;         { rows, in characters }
+        unsigned short  ws_col;         { columns, in characters }
+        unsigned short  ws_xpixel;      { horizontal size, pixels }
+        unsigned short  ws_ypixel;      { vertical size, pixels }
+};
+
+}
+(*       IOCTLREAD        = $40000000;
+       IOCTLWRITE       = $80000000;
+       IOCTLVOID        = $20000000;
+
+        TIOCMODG        = IOCTLREAD+$47400+ 3;  { get modem control state }
+        TIOCMODS        = IOCTLWRITE+$47400+ 4; { set modem control state }
+                TIOCM_LE        =$0001;         { line enable }
+                TIOCM_DTR       =$0002;         { data terminal ready }
+                TIOCM_RTS       =$0004;         { request to send }
+                TIOCM_ST        =$0010;         { secondary transmit }
+                TIOCM_SR        =$0020;         { secondary receive }
+                TIOCM_CTS       =$0040;         { clear to send }
+                TIOCM_CAR       =$0100;         { carrier detect }
+                TIOCM_CD        =TIOCM_CAR;
+                TIOCM_RNG       =$0200;         { ring }
+                TIOCM_RI        =TIOCM_RNG;
+                TIOCM_DSR       =$0400;         { data set ready }
+                                                { 8-10 compat }
+        TIOCEXCL         =IOCTLVOID+$7400+ 13;          { set exclusive use of tty }
+        TIOCNXCL         =IOCTLVOID+$7400+ 14;          { reset exclusive use of tty }
+*)                                                { 15 unused }
+//        TIOCFLUSH        =IOCTLWRITE+$47400+ 16;        { flush buffers }
+                                                { 17-18 compat }
+//        TIOCGETA         =IOCTLREAD+$2C7400+ 19; { get termios struct }
+//        TIOCSETA         =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+//        TIOCSETAW        =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+//        TIOCSETAF        =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+//        TIOCGETD         =IOCTLREAD+$47400+ 26; { get line discipline }
+//        TIOCSETD         =IOCTLWRITE+$47400+ 27;        { set line discipline }
+	                                                { 127-124 compat }
+
+// BeOS values
+		TIOCGETA		= $8000;		
+		TIOCSETA		= TIOCGETA + 1;
+		TIOCSETAF		= TIOCGETA + 2;
+		TIOCSETAW		= TIOCGETA + 3;
+		TCWAITEVENT		= TIOCGETA + 4;
+		TIOCSBRK		= TIOCGETA + 5;
+		TIOCFLUSH		= TIOCGETA + 6;
+		TCXONC			= TIOCGETA + 7;
+		TCQUERYCONNECTED= TIOCGETA + 8;
+		TCGETBITS		= TIOCGETA + 9;
+		TIOCSDTR		= TIOCGETA + 10;
+		TCSETRTS		= TIOCGETA + 11;
+		TIOCGWINSZ		= TIOCGETA + 12;
+		TIOCSWINSZ		= TIOCGETA + 13;
+		TCVTIME			= TIOCGETA + 14;
+		
+		
+//		TIOCTIMESTAMP 	= TCVTIME;
+// end BeOS values
+(*		      
+//        TIOCSBRK         =IOCTLVOID+$7400+ 123;         { set break bit }
+        TIOCCBRK         =IOCTLVOID+$7400+ 122;         { clear break bit }
+//        TIOCSDTR         =IOCTLVOID+$7400+ 121;         { set data terminal ready }
+        TIOCCDTR         =IOCTLVOID+$7400+ 120;         { clear data terminal ready }
+        TIOCGPGRP        =IOCTLREAD+$47400+ 119;        { get pgrp of tty }
+        TIOCSPGRP        =IOCTLWRITE+$47400+ 118;       { set pgrp of tty }
+                                                { 117-116 compat }
+        TIOCOUTQ         =IOCTLREAD+$47400+ 115;        { output queue size }
+        TIOCSTI          =IOCTLWRITE+$17400+ 114;       { simulate terminal input }
+        TIOCNOTTY        =IOCTLVOID+$7400+ 113;         { void tty association }
+        TIOCPKT          =IOCTLWRITE+$47400+ 112;       { pty: set/clear packet mode }
+                TIOCPKT_DATA            =$00;   { data packet }
+                TIOCPKT_FLUSHREAD       =$01;   { flush packet }
+                TIOCPKT_FLUSHWRITE      =$02;   { flush packet }
+                TIOCPKT_STOP            =$04;   { stop output }
+                TIOCPKT_START           =$08;   { start output }
+                TIOCPKT_NOSTOP          =$10;   { no more ^S, ^Q }
+                TIOCPKT_DOSTOP          =$20;   { now do ^S ^Q }
+                TIOCPKT_IOCTL           =$40;   { state change of pty driver }
+        TIOCSTOP         =IOCTLVOID+$7400+ 111;         { stop output, like ^S }
+        TIOCSTART        =IOCTLVOID+$7400+ 110;         { start output, like ^Q }
+        TIOCMSET         =IOCTLWRITE+$47400+ 109;       { set all modem bits }
+        TIOCMBIS         =IOCTLWRITE+$47400+ 108;       { bis modem bits }
+        TIOCMBIC         =IOCTLWRITE+$47400+ 107;       { bic modem bits }
+        TIOCMGET         =IOCTLREAD+$47400+ 106;        { get all modem bits }
+        TIOCREMOTE       =IOCTLWRITE+$47400+ 105;       { remote input editing }
+//        TIOCGWINSZ       =IOCTLREAD+$87400+ 104;        { get window size }
+//        TIOCSWINSZ       =IOCTLWRITE+$87400+ 103;       { set window size }
+        TIOCUCNTL        =IOCTLWRITE+$47400+ 102;       { pty: set/clr usr cntl mode }
+        TIOCSTAT         =IOCTLVOID+$7400+ 101;         { simulate ^T status message }
+  //                       UIOCCMD(n)   _IO('u', n)     { usr cntl op "n" }
+        TIOCCONS         =IOCTLWRITE+$47400+ 98;        { become virtual console }
+        TIOCSCTTY        =IOCTLVOID+$7400+ 97;          { become controlling tty }
+        TIOCEXT          =IOCTLWRITE+$47400+ 96;        { pty: external processing }
+        TIOCSIG          =IOCTLVOID+$7400+ 95;          { pty: generate signal }
+        TIOCDRAIN        =IOCTLVOID+$7400+ 94;          { wait till output drained }
+        TIOCMSDTRWAIT    =IOCTLWRITE+$47400+ 91;        { modem: set wait on close }
+        TIOCMGDTRWAIT    =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+//        TIOCTIMESTAMP    =IOCTLREAD+$87400+ 89;         { enable/get timestamp
+//                                                 * of last input event }
+        TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+                                                 * of last DCd rise }
+        TIOCSDRAINWAIT   =IOCTLWRITE+$47400+ 87;        { set ttywait timeout }
+        TIOCGDRAINWAIT   =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+
+        TTYDISC          =0;            { termios tty line discipline }
+        SLIPDISC         =4;            { serial IP discipline }
+        PPPDISC          =5;            { PPP discipline }
+        NETGRAPHDISC     =6;            { Netgraph tty node discipline }
+
+		// OCO 31/10/2005 For compatiblity (defined to compile ShiftState function
+		// in keyboard.pp)
+		// Maybe, it should not work but it compile at least...
+		TIOCLINUX        = $541C;
+
+*)
+{
+ * Defaults on "first" open.
+ }
+        TTYDEF_IFLAG     =(BRKINT       or ICRNL        or IXON or IXANY);
+       TTYDEF_OFLAG      =(OPOST or ONLCR);
+       TTYDEF_LFLAG      =(ECHO or ICANON or ISIG or IEXTEN or ECHOE );
+        TTYDEF_CFLAG     =(CREAD or CS8 or HUPCL);
+       TTYDEF_SPEED      =(B9600);
+
+
+
+{
+ * Control Character Defaults
+ }
+(*        CtrlMask        = $1f;  {\037}
+        CEOF            =chr( ORD('d') and CtrlMask);
+        CEOL            =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+        CERASE          =chr( $7F and CtrlMask);
+        CINTR           =chr(ORD('c') and CtrlMask);
+        CSTATUS         =chr(ORD('t') and CtrlMask);
+        CKILL           =chr(ORD('u') and CtrlMask);
+        CMIN            =chr(1);
+        CQUIT           =chr(034  and CtrlMask);        { FS, ^\ }
+        CSUSP           =chr(ORD('z') and CtrlMask);
+        CTIME           =chr(0);
+        CDSUSP          =chr(ORD('y') and CtrlMask);
+        CSTART          =chr(ORD('q') and CtrlMask);
+        CSTOP           =chr(ORD('s') and CtrlMask);
+        CLNEXT          =chr(ORD('v') and CtrlMask);
+        CDISCARD        =chr(ORD('o') and CtrlMask);
+        CWERASE         =chr(ORD('w') and CtrlMask);
+        CREPRINT        =chr(ORD('r') and CtrlMask);
+        CEOT            =CEOF;
+{ compat }
+        CBRK            =CEOL;
+        CRPRNT          =CREPRINT;
+        CFLUSH          =CDISCARD;
+*)
+
+{
+ *        TTYDEFCHARS to include an array of default control characters.
+}
+    ttydefchars : array[0..NCCS-1] OF char =(
+        Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
+        Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));
+

rtl/haiku/termiosproc.inc

@@ -0,0 +1,134 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 by Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   Termios implementation for FreeBSD
+
+   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.
+}
+
+
+{******************************************************************************
+                         IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+  TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+  nr:cint;
+begin
+  case OptAct of
+   TCSANOW   : nr:=TIOCSETA;
+   TCSADRAIN : nr:=TIOCSETAW;
+   TCSAFLUSH : nr:=TIOCSETAF;
+  else
+   begin
+     fpsetErrNo(ESysEINVAL);
+     TCSetAttr:=-1;
+     exit;
+   end;
+  end;
+  TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+  // field unused under BeOS
+  tios.c_ixxxxx:=speed; 
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+  // field unused under BeOS
+  tios.c_oxxxxx:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+  with tios do
+   begin
+     c_iflag:=c_iflag and (not (IXOFF or INPCK or BRKINT or
+                PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+                IGNPAR));
+     c_iflag:=c_iflag OR IGNBRK;
+     c_oflag:=c_oflag and (not OPOST);
+     c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+                                ISIG or IEXTEN or NOFLSH or TOSTOP));
+     c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+     c_cc[VMIN]:= 1;
+     c_cc[VTIME]:= 0;
+   end;
+end;
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+  TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+Function be_tcsetpgrp(fd, pgrpid : pid_t) : cint; cdecl; external 'root' name 'tcsetpgrp';
+Function be_tcgetpgrp(fd : cint) : pid_t; cdecl; external 'root' name 'tcgetpgrp';
+Function be_tcdrain(fd : cint) : cint; cdecl; external 'root' name 'tcdrain';
+Function be_tcflow(fd, action : cint) : cint; cdecl; external 'root' name 'tcflow';
+Function be_tcflush(fd, queue_selector : cint) : cint; cdecl; external 'root' name 'tcflush';
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+  TCSetPGrp := be_tcsetpgrp(fd, id);
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+  id := be_tcgetpgrp(fd);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+  TCDrain := be_tcdrain(fd);
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+  TCFlow := be_tcflow(fd, act);
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+  TCFlush := be_tcflush(fd, qsel);
+end;
+
+Function BeOSIsATTY (Handle:cint):cint; cdecl; external 'root' name 'isatty';
+
+Function IsATTY (Handle:cint):cint;
+{
+  Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+begin
+ IsAtty:= BeOSIsATTY(Handle);
+end;
+
+Function IsATTY(var f: text):cint;
+{
+  Idem as previous, only now for text variables.
+}
+begin
+  IsATTY:=IsaTTY(textrec(f).handle);
+end;
+

rtl/haiku/tthread.inc

@@ -0,0 +1,613 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Peter Vreman
+
+    BeOS TThread implementation
+
+    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.
+
+ **********************************************************************}
+
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
+type
+  PThreadRec=^TThreadRec;
+  TThreadRec=record
+    thread : TThread;
+    next   : PThreadRec;
+  end;
+
+var
+  ThreadRoot : PThreadRec;
+  ThreadsInited : boolean;
+//  MainThreadID: longint;
+
+Const
+  ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+  hp : PThreadRec;
+  sp : Pointer;
+begin
+  sp:=SPtr;
+  hp:=ThreadRoot;
+  while assigned(hp) do
+   begin
+     if (sp<=hp^.Thread.FStackPointer) and
+        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+      begin
+        Result:=hp^.Thread;
+        exit;
+      end;
+     hp:=hp^.next;
+   end;
+  Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+
+begin
+  fpwaitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+  Act, OldAct: Baseunix.PSigActionRec;
+begin
+  ThreadRoot:=nil;
+  ThreadsInited:=true;
+
+
+// This will install SIGCHLD signal handler
+// signal() installs "one-shot" handler,
+// so it is better to install and set up handler with sigaction()
+
+  GetMem(Act, SizeOf(SigActionRec));
+  GetMem(OldAct, SizeOf(SigActionRec));
+
+  Act^.sa_handler := TSigAction(@SIGCHLDHandler);
+  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+  Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
+  FpSigAction(SIGCHLD, Act, OldAct);
+
+  FreeMem(Act, SizeOf(SigActionRec));
+  FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+  hp : PThreadRec;
+begin
+  while assigned(ThreadRoot) do
+   begin
+     ThreadRoot^.Thread.Destroy;
+     hp:=ThreadRoot;
+     ThreadRoot:=ThreadRoot^.Next;
+     dispose(hp);
+   end;
+  ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+  hp : PThreadRec;
+begin
+  { Need to initialize threads ? }
+  if not ThreadsInited then
+   InitThreads;
+
+  { Put thread in the linked list }
+  new(hp);
+  hp^.Thread:=t;
+  hp^.next:=ThreadRoot;
+  ThreadRoot:=hp;
+
+  inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+  lasthp,hp : PThreadRec;
+begin
+  hp:=ThreadRoot;
+  lasthp:=nil;
+  while assigned(hp) do
+   begin
+     if hp^.Thread=t then
+      begin
+        if assigned(lasthp) then
+         lasthp^.next:=hp^.next
+        else
+         ThreadRoot:=hp^.next;
+        dispose(hp);
+        exit;
+      end;
+     lasthp:=hp;
+     hp:=hp^.next;
+   end;
+
+  Dec(ThreadCount, 1);
+  if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;//cdecl;
+var
+  FreeThread: Boolean;
+  Thread : TThread absolute args;
+begin
+  while Thread.FHandle = 0 do fpsleep(1);
+  if Thread.FSuspended then Thread.suspend();
+  try
+    Thread.Execute;
+  except
+    Thread.FFatalException := TObject(AcquireExceptionObject);
+  end;
+  FreeThread := Thread.FFreeOnTerminate;
+  Result := Thread.FReturnValue;
+  Thread.FFinished := True;
+  Thread.DoTerminate;
+  if FreeThread then
+    Thread.Free;
+  fpexit(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+  Flags: Integer;
+begin
+  inherited Create;
+  AddThread(self);
+  FSuspended := CreateSuspended;
+  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+  { Setup 16k of stack }
+  FStackSize:=16384;
+  Getmem(FStackPointer,FStackSize);
+  inc(FStackPointer,FStackSize);
+  FCallExitProcess:=false;
+  { Clone }
+  FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
+//  if FSuspended then Suspend;
+  FThreadID := FHandle;
+  IsMultiThread := TRUE;
+  FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if not FFinished and not Suspended then
+   begin
+     Terminate;
+     WaitFor;
+   end;
+  if FHandle <> -1 then
+    fpkill(FHandle, SIGKILL);
+  dec(FStackPointer,FStackSize);
+  Freemem(FStackPointer);
+  FFatalException.Free;
+  FFatalException := nil;
+  inherited Destroy;
+  RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+  FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+  possibility is 19 (PFV) }
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := fpGetPriority(Prio_Process,FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
+end;
+
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+  FSynchronizeException := nil;
+  FMethod := Method;
+{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
+  if Assigned(FSynchronizeException) then
+    raise FSynchronizeException;
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+  FSuspended := true;
+  fpKill(FHandle, SIGSTOP);
+end;
+
+
+procedure TThread.Resume;
+begin
+  fpKill(FHandle, SIGCONT);
+  FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+  status : longint;
+begin
+  if FThreadID = MainThreadID then
+    fpwaitpid(0,@status,0)
+  else
+    fpwaitpid(FHandle,@status,0);
+  Result:=status;
+end;
+{$ELSE}
+
+{
+  What follows, is a short description on my implementation of TThread.
+  Most information can also be found by reading the source and accompanying
+  comments.
+  
+  A thread is created using BeginThread, which in turn calls
+  pthread_create. So the threads here are always posix threads.
+  Posix doesn't define anything for suspending threads as this is
+  inherintly unsafe. Just don't suspend threads at points they cannot
+  control. Therefore, I didn't implement .Suspend() if its called from
+  outside the threads execution flow (except on Linux _without_ NPTL).
+  
+  The implementation for .suspend uses a semaphore, which is initialized
+  at thread creation. If the thread tries to suspend itself, we simply
+  let it wait on the semaphore until it is unblocked by someone else
+  who calls .Resume.
+
+  If a thread is supposed to be suspended (from outside its own path of
+  execution) on a system where the symbol LINUX is defined, two things
+  are possible.
+  1) the system has the LinuxThreads pthread implementation
+  2) the system has NPTL as the pthread implementation.
+  
+  In the first case, each thread is a process on its own, which as far as
+  know actually violates posix with respect to signal handling.
+  But we can detect this case, because getpid(2) will
+  return a different PID for each thread. In that case, sending SIGSTOP
+  to the PID associated with a thread will actually stop that thread
+  only.
+  In the second case, this is not possible. But getpid(2) returns the same
+  PID across all threads, which is detected, and TThread.Suspend() does
+  nothing in that case. This should probably be changed, but I know of
+  no way to suspend a thread when using NPTL.
+  
+  If the symbol LINUX is not defined, then the unimplemented
+  function SuspendThread is called.
+  
+  Johannes Berg <[email protected]>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+  I don't like this. It eats up 2 filedescriptors for each thread,
+  and those are a limited resource. If you have a server programm
+  handling client connections (one per thread) it will not be able
+  to handle many if we use 2 fds already for internal structures.
+  However, right now I don't see a better option unless some sem_*
+  functions are added to systhrds.
+  I encapsulated all used functions here to make it easier to
+  change them completely.
+}
+
+{BeOS implementation}
+
+function SemaphoreInit: Pointer;
+begin
+  SemaphoreInit := GetMem(SizeOf(TFilDes));
+  fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+  b: byte;
+begin
+  fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+var
+  b : byte;
+begin
+  b := 0;
+  fpwrite(PFilDes(FSem)^[1], b, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+  fpclose(PFilDes(FSem)^[0]);
+  fpclose(PFilDes(FSem)^[1]);
+  FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+  ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+  GMainPID: LongInt = 0;
+{$ENDIF}
+const
+  // stupid, considering its not even implemented...
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+  if not ThreadsInited then begin
+    ThreadsInited := true;
+    {$IFDEF LINUX}
+    GMainPid := fpgetpid();
+    {$ENDIF}
+  end;
+end;
+
+procedure DoneThreads;
+begin
+  ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt; // cdecl;
+var
+  LThread: TThread;
+  c: char;
+begin
+  WRITE_DEBUG('ThreadFunc is here...');
+  LThread := TThread(parameter);
+  {$IFDEF LINUX}
+  // save the PID of the "thread"
+  // this is different from the PID of the main thread if
+  // the LinuxThreads implementation is used
+  LThread.FPid := fpgetpid();
+  {$ENDIF}
+  WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+  try
+    if LThread.FInitialSuspended then begin
+      SemaphoreWait(LThread.FSem);
+      if not LThread.FInitialSuspended then begin
+        WRITE_DEBUG('going into LThread.Execute');
+        LThread.Execute;
+      end;
+    end else begin
+      WRITE_DEBUG('going into LThread.Execute');
+      LThread.Execute;
+    end;
+  except
+    on e: exception do begin
+      WRITE_DEBUG('got exception: ',e.message);
+      LThread.FFatalException :=  TObject(AcquireExceptionObject);
+      // not sure if we should really do this...
+      // but .Destroy was called, so why not try FreeOnTerminate?
+      if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+    end;
+  end;
+  WRITE_DEBUG('thread done running');
+  Result := LThread.FReturnValue;
+  WRITE_DEBUG('Result is ',Result);
+  LThread.FFinished := True;
+  LThread.DoTerminate;
+  if LThread.FreeOnTerminate then begin
+    WRITE_DEBUG('Thread should be freed');
+    LThread.Free;
+    WRITE_DEBUG('Thread freed');
+  end;
+  WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
+var
+  data : pointer;
+begin
+  // lets just hope that the user doesn't create a thread
+  // via BeginThread and creates the first TThread Object in there!
+  InitThreads;
+  inherited Create;
+  FSem := SemaphoreInit;
+  FSuspended := CreateSuspended;
+  FSuspendedExternal := false;
+  FInitialSuspended := CreateSuspended;
+  FFatalException := nil;
+  WRITE_DEBUG('creating thread, self = ',longint(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if FThreadID = GetCurrentThreadID then begin
+    raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+  end;
+  // if someone calls .Free on a thread with
+  // FreeOnTerminate, then don't crash!
+  FFreeOnTerminate := false;
+  if not FFinished and not FSuspended then begin
+    Terminate;
+    WaitFor;
+  end;
+  if (FInitialSuspended) then begin
+    // thread was created suspended but never woken up.
+    SemaphorePost(FSem);
+    WaitFor;
+  end;
+  FFatalException.Free;
+  FFatalException := nil;
+  SemaphoreDestroy(FSem);
+  inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+  if not FSuspended then begin
+    if FThreadID = GetCurrentThreadID then begin
+      FSuspended := true;
+      SemaphoreWait(FSem);
+    end else begin
+      FSuspendedExternal := true;
+{$IFDEF LINUX}
+      // naughty hack if the user doesn't have Linux with NPTL...
+      // in that case, the PID of threads will not be identical
+      // to the other threads, which means that our thread is a normal
+      // process that we can suspend via SIGSTOP...
+      // this violates POSIX, but is the way it works on the
+      // LinuxThreads pthread implementation. Not with NPTL, but in that case
+      // getpid(2) also behaves properly and returns the same PID for
+      // all threads. Thats actually (FINALLY!) native thread support :-)
+      if FPid <> GMainPID then begin
+        FSuspended := true;
+        fpkill(FPid, SIGSTOP);
+      end;
+{$ELSE}
+      SuspendThread(FHandle);
+{$ENDIF}
+    end;
+  end;
+end;
+
+
+procedure TThread.Resume;
+begin
+  if (not FSuspendedExternal) then begin
+    if FSuspended then begin
+      SemaphorePost(FSem);
+      FInitialSuspended := false;
+      FSuspended := False;
+    end;
+  end else begin
+{$IFDEF LINUX}
+    // see .Suspend
+    if FPid <> GMainPID then begin
+      fpkill(FPid, SIGCONT);
+      FSuspended := False;
+    end;
+{$ELSE}
+    ResumeThread(FHandle);
+{$ENDIF}
+    FSuspendedExternal := false;
+  end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+  WRITE_DEBUG('waiting for thread ',FHandle);
+  WaitFor := WaitForThreadTerminate(FHandle, 0);
+  WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+  // no need to check if FOnTerminate <> nil, because
+  // thats already done in DoTerminate
+  FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := ThreadGetPriority(FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+(*
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+{$TODO someone with more clue of the GUI stuff will have to do this}
+end;
+*)
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
+

rtl/haiku/unixsock.inc

@@ -0,0 +1,110 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 by Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   socket call implementations for FreeBSD
+
+   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.
+}
+
+{******************************************************************************
+                          Basic Socket Functions
+******************************************************************************}
+
+function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+Begin
+  fpSocket:=Do_Syscall(syscall_nr_socket,Domain,xtype,Protocol);
+  internal_socketerror:=fpgeterrno;
+End;
+
+function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+  fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,0,0);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+  fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+  fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags,0,0);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+  fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+  fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fplisten (s:cint; backlog : cint):cint;
+begin
+  fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+  fpAccept:=do_syscall(syscall_nr_accept,S,TSysParam(addrx),TSysParam(addrlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
+begin
+  fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpshutdown (s:cint; how:cint):cint;
+begin
+  fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+begin
+  fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+  fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+
+begin
+  fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
+  internal_socketerror:=fpgeterrno;
+end;
+

rtl/haiku/unxconst.inc

@@ -0,0 +1,77 @@
+const
+  { Things for OPEN call - after include/sys/fcntl.h,
+   BSD specifies these constants in hex }
+  Open_Accmode  = 3;
+//  Open_RdOnly   = 0;
+//  Open_WrOnly   = 1;
+//  Open_RdWr     = 2;
+//  Open_NonBlock = 4;
+//  Open_Append   = 8;
+  Open_ShLock   = $10;
+  Open_ExLock   = $20;
+  Open_ASync    = $40;
+  Open_FSync    = $80;
+  Open_NoFollow = $100;
+  Open_Create   = $200;       {BSD convention}
+//  Open_Creat    = $200;       {Linux convention}
+//  Open_Trunc    = $400;
+//  Open_Excl     = $800;
+//  Open_NoCTTY   = $8000;
+
+
+{***********************************************************************}
+{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
+{***********************************************************************}
+CONST
+    { access routine - these maybe OR'ed together }
+    F_OK        =     0;        { test for existence of file }
+    R_OK        =     4;        { test for read permission on file }
+    W_OK        =     2;        { test for write permission on file }
+    X_OK        =     1;        { test for execute or search permission }
+    { seek routine }
+    SEEK_SET    =     0;        { seek from beginning of file }
+    SEEK_CUR    =     1;        { seek from current position  }
+    SEEK_END    =     2;        { seek from end of file       }
+    { open routine                                 }
+    { File access modes for `open' and `fcntl'.    }
+    OPEN_RDONLY    =     0;        { Open read-only.  }
+    OPEN_WRONLY    =     1;        { Open write-only. }
+    OPEN_RDWR      =     2;        { Open read/write. }
+    { Bits OR'd into the second argument to open.  }
+    OPEN_CREAT     =  $200;        { Create file if it doesn't exist.  }
+    OPEN_EXCL      =  $800;        { Fail if file already exists.      }
+    OPEN_TRUNC     =  $400;        { Truncate file to zero length.     }
+    OPEN_NOCTTY    = $8000;        { Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    OPEN_APPEND    =     8;        { Writes append to the file.        }
+    OPEN_NONBLOCK  =     4;        { Non-blocking I/O.                 }
+
+    { mode_t possible values                                 }
+  { Constants to check stat.mode -  checked all STAT constants with BeOS}
+  STAT_IFMT   = $f000; {00170000 }
+//  STAT_IFSOCK = $c000; {0140000 } // unavailable under BeOS
+  STAT_IFLNK  = $a000; {0120000 }
+  STAT_IFREG  = $8000; {0100000 }
+  STAT_IFBLK  = $6000; {0060000 }
+  STAT_IFDIR  = $4000; {0040000 }
+  STAT_IFCHR  = $2000; {0020000 }
+  STAT_IFIFO  = $1000; {0010000 }
+
+  STAT_ISUID  = $0800; {0004000 }
+  STAT_ISGID  = $0400; {0002000 }
+  STAT_ISVTX  = $0200; {0001000}
+    
+    
+    STAT_IRUSR =  %0100000000;     { Read permission for owner   }
+    STAT_IWUSR =  %0010000000;     { Write permission for owner  }
+    STAT_IXUSR =  %0001000000;     { Exec  permission for owner  }
+    STAT_IRGRP =  %0000100000;     { Read permission for group   }
+    STAT_IWGRP =  %0000010000;     { Write permission for group  }
+    STAT_IXGRP =  %0000001000;     { Exec permission for group   }
+    STAT_IROTH =  %0000000100;     { Read permission for world   }
+    STAT_IWOTH =  %0000000010;     { Write permission for world  }
+    STAT_IXOTH =  %0000000001;     { Exec permission for world   }
+
+    { Used for waitpid }
+    WAIT_NOHANG   =          1;     { don't block waiting               }
+    WAIT_UNTRACED =          2;     { report status of stopped children }

rtl/haiku/unxfunc.inc

@@ -0,0 +1,88 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Peter Vreman
+
+    Darwin temporary pclose/assignpipe implementation
+
+    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.
+
+ **********************************************************************}
+
+
+
+Function PClose(Var F:file) : cint;
+var
+  pl : ^cint;
+  res : cint;
+
+begin
+  fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+  pl:=@(filerec(f).userdata[2]);
+  fpwaitpid(pl^,@res,0);
+  pclose:=res shr 8;
+end;
+
+Function PClose(Var F:text) :cint;
+var
+  pl  : ^longint;
+  res : longint;
+
+begin
+  fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+  pl:=@(textrec(f).userdata[2]);
+  fpwaitpid(pl^,@res,0);
+  pclose:=res shr 8;
+end;
+
+// type filedesarray=array[0..1] of cint;
+
+// function pipe (var fildes: filedesarray):cint;  cdecl; external 'root' name 'pipe';
+
+// can't have oldfpccall here, linux doesn't need it.
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{ 
+  Sets up a pair of file variables, which act as a pipe. The first one can
+  be read from, the second one can be written to.
+  If the operation was unsuccesful, linuxerror is set.
+}
+var
+  ret  : longint;
+  errn : cint;
+  fdis : array[0..1] of cint;
+begin
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+ AssignPipe:=ret;
+end;
+
+(*function intGetDomainName(Name:PChar; NameLen:Cint):cint;
+{$ifndef FPC_USE_LIBC}
+ external name 'FPC_SYSC_GETDOMAINNAME';
+{$else FPC_USE_LIBC}
+ cdecl; external clib name 'getdomainname';
+{$endif FPC_USE_LIBC}
+*)
+Function GetDomainName:String;  { linux only!}
+// domainname is a glibc extension.
+
+{
+  Get machines domain name. Returns empty string if not set.
+}
+
+begin
+{$WARNING TODO GetDomainName implementation}
+//  if intGetDomainName(@getdomainname[1],255)=-1 then
+//   getdomainname:=''
+//  else
+//   getdomainname[0]:=chr(strlen(@getdomainname[1]));
+end;

rtl/haiku/unxsockh.inc

@@ -0,0 +1,351 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 by Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   OS dependant part of the header.
+
+   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.
+}
+
+Const
+{*
+ * Address families.
+ *}
+  AF_UNSPEC        = 0;		{ unspecified }
+  AF_UNIX          = 1;		{ standardized name for AF_LOCAL }
+  AF_LOCAL         = AF_UNIX;	{ local to host (pipes, portals) }
+  AF_INET          = 2;		{ internetwork: UDP, TCP, etc. }
+  AF_IMPLINK       = 3;		{ arpanet imp addresses }
+  AF_PUP           = 4;		{ pup protocols: e.g. BSP }
+  AF_CHAOS         = 5;		{ mit CHAOS protocols }
+  AF_NETBIOS       = 6;		{ SMB protocols }
+  AF_ISO           = 7;		{ ISO protocols }
+  AF_OSI           = AF_ISO;
+  AF_ECMA          = 8;		{ European computer manufacturers }
+  AF_DATAKIT       = 9;		{ datakit protocols }
+  AF_CCITT         = 10;	{ CCITT protocols, X.25 etc }
+  AF_SNA           = 11;	{ IBM SNA }
+  AF_DECnet        = 12;	{ DECnet }
+  AF_DLI           = 13;	{ DEC Direct data link interface }
+  AF_LAT           = 14;	{ LAT }
+  AF_HYLINK        = 15;	{ NSC Hyperchannel }
+  AF_APPLETALK     = 16;	{ Apple Talk }
+  AF_ROUTE         = 17;	{ Internal Routing Protocol }
+  AF_LINK          = 18;	{ Link layer interface }
+  pseudo_AF_XTP    = 19;	{ eXpress Transfer Protocol (no AF) }
+  AF_COIP          = 20;	{ connection-oriented IP, aka ST II }
+  AF_CNT           = 21;	{ Computer Network Technology }
+  pseudo_AF_RTIP   = 22;	{ Help Identify RTIP packets }
+  AF_IPX           = 23;	{ Novell Internet Protocol }
+  AF_SIP           = 24;	{ Simple Internet Protocol }
+  pseudo_AF_PIP    = 25;	{ Help Identify PIP packets }
+  AF_ISDN          = 26;	{ Integrated Services Digital Network}
+  AF_E164          = AF_ISDN;	{ CCITT E.164 recommendation }
+  pseudo_AF_KEY    = 27;	{ Internal key-management function }
+  AF_INET6         = 28;	{ IPv6 }
+  AF_NATM          = 29;	{ native ATM access }
+  AF_ATM           = 30;	{ ATM }
+  pseudo_AF_HDRCMPLT = 31;	{ Used by BPF to not rewrite headers
+					 * in interface output routine
+                                         }
+  AF_NETGRAPH      = 32;	{ Netgraph sockets }
+  AF_SLOW          = 33;	{ 802.3ad slow protocol }
+  AF_SCLUSTER      = 34;	{ Sitara cluster protocol }
+  AF_ARP           = 35;
+  AF_BLUETOOTH     = 36;	{ Bluetooth sockets }
+  AF_IEEE80211     = 37;	{ IEEE 802.11 protocol }
+  AF_MAX           = 38;
+  
+  {
+   * Protocol families, same as address families for now.
+    }
+
+  const
+     PF_UNSPEC = AF_UNSPEC;
+     PF_LOCAL = AF_LOCAL;
+  { backward compatibility  }
+     PF_UNIX = PF_LOCAL;
+     PF_INET = AF_INET;
+     PF_IMPLINK = AF_IMPLINK;
+     PF_PUP = AF_PUP;
+     PF_CHAOS = AF_CHAOS;
+     PF_NETBIOS = AF_NETBIOS;
+     PF_ISO = AF_ISO;
+     PF_OSI = AF_ISO;
+     PF_ECMA = AF_ECMA;
+     PF_DATAKIT = AF_DATAKIT;
+     PF_CCITT = AF_CCITT;
+     PF_SNA = AF_SNA;
+     PF_DECnet = AF_DECnet;
+     PF_DLI = AF_DLI;
+     PF_LAT = AF_LAT;
+     PF_HYLINK = AF_HYLINK;
+     PF_APPLETALK = AF_APPLETALK;
+     PF_ROUTE = AF_ROUTE;
+     PF_LINK = AF_LINK;
+  { really just proto family, no AF  }
+     PF_XTP = pseudo_AF_XTP;
+     PF_COIP = AF_COIP;
+     PF_CNT = AF_CNT;
+     PF_SIP = AF_SIP;
+     PF_IPX = AF_IPX;
+  { same format as AF_INET  }
+     PF_RTIP = pseudo_AF_RTIP;
+     PF_PIP = pseudo_AF_PIP;
+     PF_ISDN = AF_ISDN;
+     PF_KEY = pseudo_AF_KEY;
+     PF_INET6 = AF_INET6;
+     PF_NATM = AF_NATM;
+     PF_ATM = AF_ATM;
+     PF_NETGRAPH = AF_NETGRAPH;
+     PF_SLOW = AF_SLOW;
+     PF_SCLUSTER = AF_SCLUSTER;
+     PF_ARP = AF_ARP;
+     PF_BLUETOOTH = AF_BLUETOOTH;
+     PF_MAX = AF_MAX;
+
+
+  SOCK_PACKET     = 10;
+
+
+{ Maximum queue length specifiable by listen.  }
+  SOMAXCONN     = 128;
+
+        SOL_SOCKET 	 = $FFFF;
+        SO_DEBUG         = $0001;        { turn on debugging info recording }
+        SO_ACCEPTCONN    = $0002;        { socket has had listen() }
+        SO_REUSEADDR     = $0004;        { allow local address reuse }
+        SO_KEEPALIVE     = $0008;        { keep connections alive }
+        SO_DONTROUTE     = $0010;        { just use interface addresses }
+        SO_BROADCAST     = $0020;        { permit sending of broadcast msgs }
+        SO_USELOOPBACK   = $0040;        { bypass hardware when possible }
+        SO_LINGER        = $0080;        { linger on close if data present }
+        SO_OOBINLINE     = $0100;        { leave received OOB data in line }
+        SO_REUSEPORT     = $0200;        { allow local address & port reuse }
+        SO_TIMESTAMP     = $0400;        { timestamp received dgram traffic }
+
+{
+ * Additional options, not kept in so_options.
+ }
+        SO_SNDBUF        =$1001;        { send buffer size }
+        SO_RCVBUF        =$1002;        { receive buffer size }
+        SO_SNDLOWAT      =$1003;        { send low-water mark }
+        SO_RCVLOWAT      =$1004;        { receive low-water mark }
+        SO_SNDTIMEO      =$1005;        { send timeout }
+        SO_RCVTIMEO      =$1006;        { receive timeout }
+        SO_ERROR         =$1007;        { get error status and clear }
+        SO_TYPE          =$1008;        { get socket type }
+
+
+        SHUT_RD         =0;             { shut down the reading side }
+        SHUT_WR         =1;             { shut down the writing side }
+        SHUT_RDWR       =2;             { shut down both sides }
+
+	IPPROTO_IP              = 0;               { dummy for IP }
+	IPPROTO_ICMP            = 1;               { control message protocol }
+	IPPROTO_TCP             = 6;               { tcp }
+	IPPROTO_UDP             = 17;              { user datagram protocol }
+
+
+	IPPROTO_HOPOPTS		= 0 ; 		{ IP6 hop-by-hop options }
+	IPPROTO_IGMP		= 2 ; 		{ group mgmt protocol }
+	IPPROTO_GGP		= 3 ; 		{ gateway^2 (deprecated) }
+	IPPROTO_IPV4		= 4 ; 		{ IPv4 encapsulation }
+	IPPROTO_IPIP		= IPPROTO_IPV4;	{ for compatibility }
+	IPPROTO_ST		= 7 ; 		{ Stream protocol II }
+	IPPROTO_EGP		= 8 ; 		{ exterior gateway protocol }
+	IPPROTO_PIGP		= 9 ; 		{ private interior gateway }
+	IPPROTO_RCCMON		= 10; 		{ BBN RCC Monitoring }
+	IPPROTO_NVPII		= 11; 		{ network voice protocol}
+	IPPROTO_PUP		= 12; 		{ pup }
+	IPPROTO_ARGUS		= 13; 		{ Argus }
+	IPPROTO_EMCON		= 14; 		{ EMCON }
+	IPPROTO_XNET		= 15; 		{ Cross Net Debugger }
+	IPPROTO_CHAOS		= 16; 		{ Chaos}
+	IPPROTO_MUX		= 18; 		{ Multiplexing }
+	IPPROTO_MEAS		= 19; 		{ DCN Measurement Subsystems }
+	IPPROTO_HMP		= 20; 		{ Host Monitoring }
+	IPPROTO_PRM		= 21; 		{ Packet Radio Measurement }
+	IPPROTO_IDP		= 22; 		{ xns idp }
+	IPPROTO_TRUNK1		= 23; 		{ Trunk-1 }
+	IPPROTO_TRUNK2		= 24; 		{ Trunk-2 }
+	IPPROTO_LEAF1		= 25; 		{ Leaf-1 }
+	IPPROTO_LEAF2		= 26; 		{ Leaf-2 }
+	IPPROTO_RDP		= 27; 		{ Reliable Data }
+	IPPROTO_IRTP		= 28; 		{ Reliable Transaction }
+	IPPROTO_TP		= 29; 		{ tp-4 w/ class negotiation }
+	IPPROTO_BLT		= 30; 		{ Bulk Data Transfer }
+	IPPROTO_NSP		= 31; 		{ Network Services }
+	IPPROTO_INP		= 32; 		{ Merit Internodal }
+	IPPROTO_SEP		= 33; 		{ Sequential Exchange }
+	IPPROTO_3PC		= 34; 		{ Third Party Connect }
+	IPPROTO_IDPR		= 35; 		{ InterDomain Policy Routing }
+	IPPROTO_XTP		= 36; 		{ XTP }
+	IPPROTO_DDP		= 37; 		{ Datagram Delivery }
+	IPPROTO_CMTP		= 38; 		{ Control Message Transport }
+	IPPROTO_TPXX		= 39; 		{ TP++ Transport }
+	IPPROTO_IL		= 40; 		{ IL transport protocol }
+	IPPROTO_IPV6		= 41; 		{ IP6 header }
+	IPPROTO_SDRP		= 42; 		{ Source Demand Routing }
+	IPPROTO_ROUTING		= 43; 		{ IP6 routing header }
+	IPPROTO_FRAGMENT	= 44; 		{ IP6 fragmentation header }
+	IPPROTO_IDRP		= 45; 		{ InterDomain Routing}
+	IPPROTO_RSVP		= 46; 		{ resource reservation }
+	IPPROTO_GRE		= 47; 		{ General Routing Encap. }
+	IPPROTO_MHRP		= 48; 		{ Mobile Host Routing }
+	IPPROTO_BHA		= 49; 		{ BHA }
+	IPPROTO_ESP		= 50; 		{ IP6 Encap Sec. Payload }
+	IPPROTO_AH		= 51; 		{ IP6 Auth Header }
+	IPPROTO_INLSP		= 52; 		{ Integ. Net Layer Security }
+	IPPROTO_SWIPE		= 53; 		{ IP with encryption }
+	IPPROTO_NHRP		= 54; 		{ Next Hop Resolution }
+	IPPROTO_MOBILE		= 55; 		{ IP Mobility }
+	IPPROTO_TLSP		= 56; 		{ Transport Layer Security }
+	IPPROTO_SKIP		= 57; 		{ SKIP }
+	IPPROTO_ICMPV6		= 58; 		{ ICMP6 }
+	IPPROTO_NONE		= 59; 		{ IP6 no next header }
+	IPPROTO_DSTOPTS		= 60; 		{ IP6 destination option }
+	IPPROTO_AHIP		= 61; 		{ any host internal protocol }
+	IPPROTO_CFTP		= 62; 		{ CFTP }
+	IPPROTO_HELLO		= 63; 		{ "hello" routing protocol }
+	IPPROTO_SATEXPAK	= 64; 		{ SATNET/Backroom EXPAK }
+	IPPROTO_KRYPTOLAN	= 65; 		{ Kryptolan }
+	IPPROTO_RVD		= 66; 		{ Remote Virtual Disk }
+	IPPROTO_IPPC		= 67; 		{ Pluribus Packet Core }
+	IPPROTO_ADFS		= 68; 		{ Any distributed FS }
+	IPPROTO_SATMON		= 69; 		{ Satnet Monitoring }
+	IPPROTO_VISA		= 70; 		{ VISA Protocol }
+	IPPROTO_IPCV		= 71; 		{ Packet Core Utility }
+	IPPROTO_CPNX		= 72; 		{ Comp. Prot. Net. Executive }
+	IPPROTO_CPHB		= 73; 		{ Comp. Prot. HeartBeat }
+	IPPROTO_WSN		= 74; 		{ Wang Span Network }
+	IPPROTO_PVP		= 75; 		{ Packet Video Protocol }
+	IPPROTO_BRSATMON	= 76; 		{ BackRoom SATNET Monitoring }
+	IPPROTO_ND		= 77; 		{ Sun net disk proto (temp.) }
+	IPPROTO_WBMON		= 78; 		{ WIDEBAND Monitoring }
+	IPPROTO_WBEXPAK		= 79; 		{ WIDEBAND EXPAK }
+	IPPROTO_EON		= 80; 		{ ISO cnlp }
+	IPPROTO_VMTP		= 81; 		{ VMTP }
+	IPPROTO_SVMTP		= 82; 		{ Secure VMTP }
+	IPPROTO_VINES		= 83; 		{ Banyon VINES }
+	IPPROTO_TTP		= 84; 		{ TTP }
+	IPPROTO_IGP		= 85; 		{ NSFNET-IGP }
+	IPPROTO_DGP		= 86; 		{ dissimilar gateway prot. }
+	IPPROTO_TCF		= 87; 		{ TCF }
+	IPPROTO_IGRP		= 88; 		{ Cisco/GXS IGRP }
+	IPPROTO_OSPFIGP		= 89; 		{ OSPFIGP }
+	IPPROTO_SRPC		= 90; 		{ Strite RPC protocol }
+	IPPROTO_LARP		= 91; 		{ Locus Address Resoloution }
+	IPPROTO_MTP		= 92; 		{ Multicast Transport }
+	IPPROTO_AX25		= 93; 		{ AX.25 Frames }
+	IPPROTO_IPEIP		= 94; 		{ IP encapsulated in IP }
+	IPPROTO_MICP		= 95; 		{ Mobile Int.ing control }
+	IPPROTO_SCCSP		= 96; 		{ Semaphore Comm. security }
+	IPPROTO_ETHERIP		= 97; 		{ Ethernet IP encapsulation }
+	IPPROTO_ENCAP		= 98; 		{ encapsulation header }
+	IPPROTO_APES		= 99; 		{ any private encr. scheme }
+	IPPROTO_GMTP		= 100;		{ GMTP}
+	IPPROTO_IPCOMP		= 108;		{ payload compression (IPComp) }
+{ 101-254: Partly Unassigned }
+	IPPROTO_PIM		= 103;		{ Protocol Independent Mcast }
+	IPPROTO_CARP		= 112;		{ CARP }
+	IPPROTO_PGM		= 113;		{ PGM }
+	IPPROTO_PFSYNC		= 240;		{ PFSYNC }
+
+{ last return value of *_input(), meaning "all job for this pkt is done".  }
+	IPPROTO_RAW             = 255;
+	IPPROTO_MAX		= 256;
+	IPPROTO_DONE		= 257;
+
+{
+ * Options for use with [gs]etsockopt at the IP level.
+ * First word of comment is data type; bool is stored in int.
+ }
+	IP_OPTIONS		= 1 ;   { buf/ip_opts; set/get IP options }
+	IP_HDRINCL		= 2 ;   { int; header is included with data }
+	IP_TOS			= 3 ;   { int; IP type of service and preced. }
+	IP_TTL			= 4 ;   { int; IP time to live }
+	IP_RECVOPTS		= 5 ;   { bool; receive all IP opts w/dgram }
+	IP_RECVRETOPTS		= 6 ;   { bool; receive IP opts for response }
+	IP_RECVDSTADDR		= 7 ;   { bool; receive IP dst addr w/dgram }
+	IP_SENDSRCADDR		= IP_RECVDSTADDR; { cmsg_type to set src addr }
+	IP_RETOPTS		= 8 ;   { ip_opts; set/get IP options }
+	IP_MULTICAST_IF		= 9 ;   { u_char; set/get IP multicast i/f  }
+	IP_MULTICAST_TTL	= 10;   { u_char; set/get IP multicast ttl }
+	IP_MULTICAST_LOOP	= 11;   { u_char; set/get IP multicast loopback }
+	IP_ADD_MEMBERSHIP	= 12;   { ip_mreq; add an IP group membership }
+	IP_DROP_MEMBERSHIP	= 13;   { ip_mreq; drop an IP group membership }
+	IP_MULTICAST_VIF	= 14;   { set/get IP mcast virt. iface }
+	IP_RSVP_ON		= 15;   { enable RSVP in kernel }
+	IP_RSVP_OFF		= 16;   { disable RSVP in kernel }
+	IP_RSVP_VIF_ON		= 17;   { set RSVP per-vif socket }
+	IP_RSVP_VIF_OFF		= 18;   { unset RSVP per-vif socket }
+	IP_PORTRANGE		= 19;   { int; range to choose for unspec port }
+	IP_RECVIF		= 20;   { bool; receive reception if w/dgram }
+
+{ for IPSEC }
+	IP_IPSEC_POLICY		= 21;   { int; set/get security policy }
+	IP_FAITH		= 22;   { bool; accept FAITH'ed connections }
+
+	IP_ONESBCAST		= 23;   { bool: send all-ones broadcast }
+                                
+	IP_FW_TABLE_ADD		= 40;   { add entry }
+	IP_FW_TABLE_DEL		= 41;   { delete entry }
+	IP_FW_TABLE_FLUSH	= 42;   { flush table }
+	IP_FW_TABLE_GETSIZE	= 43;   { get table size }
+	IP_FW_TABLE_LIST	= 44;   { list table contents }
+
+	IP_FW_ADD		= 50;   { add a firewall rule to chain }
+	IP_FW_DEL		= 51;   { delete a firewall rule from chain }
+	IP_FW_FLUSH		= 52;   { flush firewall rule chain }
+	IP_FW_ZERO		= 53;   { clear single/all firewall counter(s) }
+	IP_FW_GET		= 54;   { get entire firewall rule chain }
+	IP_FW_RESETLOG		= 55;   { reset logging counters }
+
+	IP_DUMMYNET_CONFIGURE	= 60;   { add/configure a dummynet pipe }
+	IP_DUMMYNET_DEL		= 61;   { delete a dummynet pipe from chain }
+	IP_DUMMYNET_FLUSH	= 62;   { flush dummynet }
+	IP_DUMMYNET_GET		= 64;   { get entire dummynet pipes }
+
+	IP_RECVTTL		= 65;   { bool; receive IP TTL w/dgram }
+
+	IPV6_SOCKOPT_RESERVED1	= 3 ; { reserved for future use }
+	IPV6_UNICAST_HOPS	= 4 ; { int; IP6 hops }
+	IPV6_MULTICAST_IF	= 9 ; { u_int; setget IP6 multicast if  }
+	IPV6_MULTICAST_HOPS	= 10; { int; setget IP6 multicast hops }
+	IPV6_MULTICAST_LOOP	= 11; { u_int; setget IP6 multicast loopback }
+	IPV6_JOIN_GROUP		= 12; { ip6_mreq; join a group membership }
+	IPV6_LEAVE_GROUP	= 13; { ip6_mreq; leave a group membership }
+	IPV6_PORTRANGE		= 14; { int; range to choose for unspec port }
+
+	IPV6_PKTINFO            = 46; { in6_pktinfo; send if, src addr }	
+ 	IPV6_HOPLIMIT           = 47; { int; send hop limit }
+ 	IPV6_NEXTHOP            = 48; { sockaddr; next hop addr }
+ 	IPV6_HOPOPTS            = 49; { ip6_hbh; send hop-by-hop option }
+ 	IPV6_DSTOPTS            = 50; { ip6_dest; send dst option befor rthdr }
+ 	IPV6_RTHDR              = 51; { ip6_rthdr; send routing header }
+ 	IPV6_PKTOPTIONS         = 52; { buf/cmsghdr; set/get IPv6 options }
+  
+  { Flags for send, recv etc. }
+  MSG_OOB       = $0001;              { Process out-of-band data}
+  MSG_PEEK      = $0002;              { Peek at incoming messages }
+  MSG_DONTROUTE = $0004;              { Don't use local routing }
+  MSG_EOR       = $0008;              { End of record }
+  MSG_TRUNC     = $0010;
+  MSG_CTRUNC    = $0020;              { Control data lost before delivery }
+  MSG_WAITALL   = $0040;              { Wait for a full request }
+  MSG_DONTWAIT  = $0080;              { Non-blocking I/O }
+  MSG_EOF       = $0100;
+  MSG_NBIO      = $4000;
+  MSG_COMPAT    = $8000;
+  MSG_SOCALLBCK = $10000;
+  MSG_NOSIGNAL  = $20000;              { Do not generate SIGPIPE }
+  
+  INVALID_SOCKET = -1;
+  SOCKET_ERROR = -1;

rtl/unix/cwstring.pp

@@ -26,7 +26,7 @@ implementation
 
 {$linklib c}
 
-{$if not defined(linux) and not defined(solaris)}  // Linux (and maybe glibc platforms in general), have iconv in glibc.
+{$if not defined(linux) and not defined(solaris) and not defined(haiku)}  // Linux (and maybe glibc platforms in general), have iconv in glibc.
  {$linklib iconv}
  {$define useiconv}
 {$endif linux}
@@ -124,7 +124,7 @@ type
 function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
 {$endif}
 
-{$if (not defined(bsd) and not defined(beos)) or defined(darwin)}
+{$if (not defined(bsd) and not defined(beos)) or defined(darwin) or defined(haiku)}
 function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
 function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
 function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'iconv_close';

utils/fpcm/fpcmake.ini

@@ -880,6 +880,13 @@ EXEEXT=
 SHORTSUFFIX=be
 endif
 
+# Haiku
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+
 # Solaris
 ifeq ($(OS_TARGET),solaris)
 BATCHEXT=.sh

utils/fpcm/fpcmmain.pp

@@ -67,7 +67,7 @@ interface
       );
 
       TOS=(
-        o_linux,o_go32v2,o_win32,o_os2,o_freebsd,o_beos,o_netbsd,
+        o_linux,o_go32v2,o_win32,o_os2,o_freebsd,o_beos,o_haiku,o_netbsd,
         o_amiga,o_atari, o_solaris, o_qnx, o_netware, o_openbsd,o_wdosx,
         o_palmos,o_macos,o_darwin,o_emx,o_watcom,o_morphos,o_netwlibc,
         o_win64,o_wince,o_gba,o_nds,o_embedded,o_symbian
@@ -89,14 +89,14 @@ interface
       );
 
       OSStr : array[TOS] of string=(
-        'linux','go32v2','win32','os2','freebsd','beos','netbsd',
+        'linux','go32v2','win32','os2','freebsd','beos','haiku','netbsd',
         'amiga','atari','solaris', 'qnx', 'netware','openbsd','wdosx',
         'palmos','macos','darwin','emx','watcom','morphos','netwlibc',
         'win64','wince','gba','nds','embedded','symbian'
       );
 
       OSSuffix : array[TOS] of string=(
-        '_linux','_go32v2','_win32','_os2','_freebsd','_beos','_netbsd',
+        '_linux','_go32v2','_win32','_os2','_freebsd','_beos','_haiku','_netbsd',
         '_amiga','_atari','_solaris', '_qnx', '_netware','_openbsd','_wdosx',
         '_palmos','_macos','_darwin','_emx','_watcom','_morphos','_netwlibc',
         '_win64','_wince','_gba','_nds','_embedded','_symbian'
@@ -111,6 +111,7 @@ interface
         { os2 }     ( true,  false, false, false, false, false, false, false, false),
         { freebsd } ( true,  true,  false, false, true,  false, false, false, false),
         { beos }    ( true,  false, false, false, false, false, false, false, false),
+        { haiku }    ( true,  false, false, false, false, false, false, false, false),
         { netbsd }  ( true,  true,  true,  true,  false, false, false, false, false),
         { amiga }   ( false, true,  true,  false, false, false, false, false, false),
         { atari }   ( false, true,  false, false, false, false, false, false, false),

utils/fppkg/Makefile.fpc

@@ -11,6 +11,7 @@ programs=fppkg
 implicitunits=fprepos fpxmlrep pkgoptions pkgglobals pkgmessages pkghandler pkgmkconv pkgdownload pkgfpmake pkgcommands pkgrepos
 implicitunits_linux=pkgwget  pkglnet
 implicitunits_beos=pkgwget pkglnet
+implicitunits_haiku=pkgwget pkglnet
 implicitunits_freebsd=pkgwget pkglnet
 implicitunits_netbsd=pkgwget pkglnet
 implicitunits_openbsd=pkgwget pkglnet