Index: compiler/systems/i_haiku.pas =================================================================== --- compiler/systems/i_haiku.pas (revision 40720) +++ compiler/systems/i_haiku.pas (working copy) @@ -36,7 +36,8 @@ name : 'Haiku for i386'; shortname : 'Haiku'; flags : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive, - tf_smartlink_sections, tf_has_winlike_resources]; + tf_pic_default,tf_pic_uses_got, + tf_smartlink_sections,tf_has_winlike_resources]; cpu : cpu_i386; unit_env : 'HAIKUUNITS'; extradefines : 'BEOS;UNIX;HASUNIX'; @@ -99,7 +100,7 @@ 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. + so i use this new value. } stacksize : 16 * 1024 * 1024; stackalign : 4; Index: compiler/systems/t_haiku.pas =================================================================== --- compiler/systems/t_haiku.pas (revision 40720) +++ compiler/systems/t_haiku.pas (working copy) @@ -49,6 +49,7 @@ public constructor Create;override; procedure SetDefaultInfo;override; + procedure InitSysInitUnitName;override; function MakeExecutable:boolean;override; function MakeSharedLibrary:boolean;override; end; @@ -224,6 +225,14 @@ end; +procedure TLinkerHaiku.InitSysInitUnitName; +const + SysInitUnitNames: array[boolean] of string[15] = ( 'si_c', 'si_dllc' ); +begin + sysinitunit:=SysInitUnitNames[current_module.islibrary]; +end; + + function TLinkerHaiku.WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; Var linkres : TLinkRes; @@ -238,8 +247,6 @@ { 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 @@ -247,20 +254,27 @@ linklibc:=true; end; - if (not linklibc) and makelib then - begin - linklibc:=true; - cprtobj:='dllprt.o'; - end - else if makelib then - begin - // Making a dll with libc linking. Should be always the case under Haiku. - cprtobj:='dllcprt0'; - end; - + prtobj:=''; + cprtobj:=''; + if not (target_info.system in systems_internal_sysinit) then + begin + prtobj:='prt0'; + cprtobj:='cprt0'; + if (not linklibc) and makelib then + begin + linklibc:=true; + cprtobj:='dllprt.o'; + end + else if makelib then + begin + // Making a dll with libc linking. Should be always the case under Haiku. + cprtobj:='dllcprt0'; + end; + end; + if linklibc then - prtobj:=cprtobj; + prtobj:=cprtobj; { Open link.res file } LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,false); Index: compiler/systems.pas =================================================================== --- compiler/systems.pas (revision 40720) +++ compiler/systems.pas (working copy) @@ -350,7 +350,8 @@ systems_internal_sysinit = [system_i386_win32,system_x86_64_win64, system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux, - system_m68k_atari,system_m68k_palmos + system_m68k_atari,system_m68k_palmos, + system_i386_haiku ]+systems_darwin+systems_amigalike; { all systems that use garbage collection for reference-counted types } Index: rtl/haiku/i386/si_c.pp =================================================================== --- rtl/haiku/i386/si_c.pp (nonexistent) +++ rtl/haiku/i386/si_c.pp (working copy) @@ -0,0 +1,73 @@ +{ + 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 _thread_do_exit_notification; cdecl; external libc name '_thread_do_exit_notification'; +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 + { This is actually a BeOS legacy stub in Haiku, according to the C code, + calling it might not be necessary (KB) } + _thread_do_exit_notification; + + { call C exit code } + __exit(_ExitCode); +end; + + +end. Index: rtl/haiku/i386/si_dllc.pp =================================================================== --- rtl/haiku/i386/si_dllc.pp (nonexistent) +++ rtl/haiku/i386/si_dllc.pp (working copy) @@ -0,0 +1,64 @@ +{ + 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 _thread_do_exit_notification; cdecl; external libc name '_thread_do_exit_notification'; + +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 + { This is actually a BeOS legacy stub in Haiku, according to the C code, + calling it might not be necessary (KB) } + _thread_do_exit_notification; + + { call C exit code } + __exit(_ExitCode); +end; + + +end. Index: rtl/haiku/Makefile.fpc =================================================================== --- rtl/haiku/Makefile.fpc (revision 40720) +++ rtl/haiku/Makefile.fpc (working copy) @@ -7,7 +7,7 @@ [target] loaders=prt0 cprt0 dllcprt0 func dllprt -units=system uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \ +units=system si_c si_dllc uuchar baseunix unixtype ctypes objpas macpas iso7185 extpas strings \ # beos \ errors dos dl \ sysconst sysutils \ @@ -68,9 +68,8 @@ ifdef RELEASE override FPCOPT+=-Ur endif +override FPCOPT+=-dFPC_USE_LIBC -override FPCOPT+= -dHASUNIX -n -dFPC_USE_LIBC -Si - # Paths OBJPASDIR=$(RTL)/objpas GRAPHDIR=$(INC)/graph Index: rtl/haiku/syscall.inc =================================================================== --- rtl/haiku/syscall.inc (revision 40720) +++ rtl/haiku/syscall.inc (working copy) @@ -22,6 +22,12 @@ **************************************************************************** } + +procedure Sys_Call; assembler; nostackframe; +asm + int $25; +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 ! Index: rtl/haiku/syscallh.inc =================================================================== --- rtl/haiku/syscallh.inc (revision 40720) +++ rtl/haiku/syscallh.inc (working copy) @@ -47,7 +47,7 @@ // Errno : cint; {$ENDIF} -procedure sys_call; external name 'sys_call'; // BeOS +//procedure sys_call; external name 'sys_call'; // BeOS //begin //end; Index: rtl/haiku/system.pp =================================================================== --- rtl/haiku/system.pp (revision 40720) +++ rtl/haiku/system.pp (working copy) @@ -34,13 +34,11 @@ {***************************************************************************** System Dependent Exit code *****************************************************************************} -procedure prthaltproc;external name '_haltproc'; +procedure haltproc(exitcode: longint); cdecl; external name '_haltproc'; procedure system_exit; begin - asm - jmp prthaltproc - end; + haltproc(ExitCode); End;