From efba70f82b8c5d3c94d4cb2de89fac6bcf7b9f33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A1roly=20Balogh?= <karoly@freepascal.org>
Date: Fri, 4 Jan 2019 02:44:39 +0000
Subject: [PATCH] haiku: pascal sysinit code for haiku, will be needed for
 x86_64, nice to have for i386

git-svn-id: trunk@40754 -
---
 .gitattributes       |  2 ++
 rtl/haiku/si_c.pp    | 68 ++++++++++++++++++++++++++++++++++++++++++++
 rtl/haiku/si_dllc.pp | 59 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 129 insertions(+)
 create mode 100644 rtl/haiku/si_c.pp
 create mode 100644 rtl/haiku/si_dllc.pp

diff --git a/.gitattributes b/.gitattributes
index 01f5cb6512..d4eca08718 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -9411,6 +9411,8 @@ rtl/haiku/pthread.inc svneol=native#text/plain
 rtl/haiku/ptypes.inc svneol=native#text/plain
 rtl/haiku/rtldefs.inc svneol=native#text/plain
 rtl/haiku/settimeo.inc svneol=native#text/plain
+rtl/haiku/si_c.pp svneol=native#text/plain
+rtl/haiku/si_dllc.pp 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
diff --git a/rtl/haiku/si_c.pp b/rtl/haiku/si_c.pp
new file mode 100644
index 0000000000..330a1c8a2b
--- /dev/null
+++ b/rtl/haiku/si_c.pp
@@ -0,0 +1,68 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    System Entry point for Haiku, linked-against-libc version
+
+    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 si_c;
+
+interface
+
+implementation
+
+{ Bindings to RTL }
+var
+  argc: longint; public name 'operatingsystem_parameter_argc';
+  argv: pointer; public name 'operatingsystem_parameter_argv';
+  envp: pointer; public name 'operatingsystem_parameter_envp';
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+{ Bindings to libroot/libc }
+const
+  libc = 'root';
+
+var
+  argv_save: pointer; external name 'argv_save';
+  main_thread_id: ptruint; external name '__main_thread_id';
+
+function find_thread(name: pchar): ptruint; cdecl; external libc name 'find_thread';
+procedure _init_c_library_(argc: longint; argv: ppchar; env: ppchar); cdecl; external libc name '_init_c_library_';
+procedure _call_init_routines_; cdecl; external libc name '_call_init_routines_';
+procedure __exit(status: longint); cdecl; external libc name 'exit';
+
+
+function _FPC_proc_start(_argc: longint; _argv: pointer; _envp: pointer): longint; cdecl; public name '_start';
+begin
+  argc:=_argc;
+  argv:=_argv;
+  envp:=_envp;
+
+  argv_save:=_argv;
+  main_thread_id:=find_thread(nil);
+
+  { This is actually only needed for BeOS R5 compatibility,
+    they're empty stubs in Haiku, according to the C code (KB) }
+  _init_c_library_(_argc,_argv,_envp);
+  _call_init_routines_;
+
+  PascalMain;
+end;
+
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  { call C exit code }
+  __exit(_ExitCode);
+end;
+
+
+end.
diff --git a/rtl/haiku/si_dllc.pp b/rtl/haiku/si_dllc.pp
new file mode 100644
index 0000000000..6f7f7bdafe
--- /dev/null
+++ b/rtl/haiku/si_dllc.pp
@@ -0,0 +1,59 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    System Entry point for Haiku shared libraries,
+    linked-against-libc version
+
+    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 si_dllc;
+
+interface
+
+implementation
+
+{ Bindings to RTL }
+var
+  argc: longint; public name 'operatingsystem_parameter_argc';
+  argv: pointer; public name 'operatingsystem_parameter_argv';
+  envp: pointer; public name 'operatingsystem_parameter_envp';
+
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+{ Bindings to libroot/libc }
+const
+  libc = 'root';
+
+var
+  __libc_argc: longint; external libc name '__libc_argc';
+  __libc_argv: pointer; external libc name '__libc_argv';
+  environ: pointer; external libc name 'environ';
+
+procedure __exit(status: longint); cdecl; external libc name 'exit';
+
+procedure _FPC_shared_lib_start; cdecl; public name 'initialize_after';
+begin
+  argc:=__libc_argc;
+  argv:=__libc_argv;
+  envp:=environ;
+
+  PascalMain;
+end;
+
+procedure _FPC_shared_lib_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  { call C exit code }
+  __exit(_ExitCode);
+end;
+
+
+end.