system.pp 5.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time librar~y.
  4. Copyright (c) 2000 by Marco van de Voort
  5. member of the Free Pascal development team.
  6. System unit for the *BSD's.
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. { These things are set in the makefile, }
  14. { But you can override them here.}
  15. { If you use an aout system, set the conditional AOUT}
  16. { $Define AOUT}
  17. Unit {$ifdef VER1_0}SysBSD{$else}System{$endif};
  18. Interface
  19. {$define FPC_USE_SIGPROCMASK}
  20. {$define FPC_USE_SIGALTSTACK}
  21. {$ifndef FPC_USE_LIBC}
  22. {$define FPC_USE_SYSCALL}
  23. {$endif}
  24. {$define FPC_IS_SYSTEM}
  25. {$I sysunixh.inc}
  26. CONST SIGSTKSZ = 40960;
  27. Implementation
  28. {$ifdef FPC_USE_LIBC}
  29. const clib = 'c';
  30. type libcint=longint;
  31. plibcint=^libcint;
  32. {$ifdef FreeBSD} // tested on x86
  33. function geterrnolocation: Plibcint; cdecl;external clib name '__error';
  34. {$else}
  35. {$ifdef NetBSD} // from a sparc dump.
  36. function geterrnolocation: Plibcint; cdecl;external clib name '__errno';
  37. {$else}
  38. {$ifdef Darwin}
  39. function geterrnolocation: Plibcint; cdecl;external clib name '__error';
  40. {$else}
  41. {$ifdef OpenBSD}
  42. var libcerrno : libcint; cvar;
  43. function geterrnolocation: Plibcint; cdecl;
  44. begin
  45. geterrnolocation:=@libcerrno;
  46. end;
  47. {$else}
  48. {$endif}
  49. {$endif}
  50. {$endif}
  51. {$endif}
  52. function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
  53. begin
  54. geterrno:=geterrnolocation^;
  55. end;
  56. procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
  57. begin
  58. geterrnolocation^:=err;
  59. end;
  60. {$else}
  61. {$ifdef ver1_0}
  62. Var
  63. {$else}
  64. threadvar
  65. {$endif}
  66. Errno : longint;
  67. function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
  68. begin
  69. GetErrno:=Errno;
  70. end;
  71. procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
  72. begin
  73. Errno:=err;
  74. end;
  75. {$endif}
  76. { OS independant parts}
  77. {$I system.inc}
  78. {*****************************************************************************
  79. OS Memory allocation / deallocation
  80. ****************************************************************************}
  81. { OS dependant parts }
  82. {$I errno.inc}
  83. {$I bunxtype.inc}
  84. {$I ossysc.inc}
  85. {$I osmain.inc}
  86. function SysOSAlloc(size: ptrint): pointer;
  87. begin
  88. result := sbrk(size);
  89. end;
  90. {$define HAS_SYSOSFREE}
  91. procedure SysOSFree(p: pointer; size: ptrint);
  92. begin
  93. fpmunmap(p, size);
  94. end;
  95. {$I text.inc}
  96. {$I heap.inc}
  97. {*****************************************************************************
  98. UnTyped File Handling
  99. *****************************************************************************}
  100. {$i file.inc}
  101. {*****************************************************************************
  102. Typed File Handling
  103. *****************************************************************************}
  104. {$i typefile.inc}
  105. procedure SysInitStdIO;
  106. begin
  107. OpenStdIO(Input,fmInput,StdInputHandle);
  108. OpenStdIO(Output,fmOutput,StdOutputHandle);
  109. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  110. OpenStdIO(StdErr,fmOutput,StdErrorHandle);
  111. end;
  112. {$ifdef FPC_USE_LIBC}
  113. { can also be used with other BSD's if they use the system's crtX instead of prtX }
  114. {$ifdef Darwin}
  115. procedure pascalmain; external name 'PASCALMAIN';
  116. { Main entry point in C style, needed to capture program parameters. }
  117. procedure main(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl; [public];
  118. begin
  119. argc:= argcparam;
  120. argv:= argvparam;
  121. envp:= envpparam;
  122. pascalmain; {run the pascal main program}
  123. end;
  124. {$endif Darwin}
  125. {$endif FPC_USE_LIBC}
  126. Begin
  127. IsConsole := TRUE;
  128. IsLibrary := FALSE;
  129. StackBottom := Sptr - StackLength;
  130. { Set up signals handlers }
  131. InstallSignals;
  132. { Setup heap }
  133. InitHeap;
  134. SysInitExceptions;
  135. { Arguments }
  136. SetupCmdLine;
  137. { Setup stdin, stdout and stderr }
  138. SysInitStdIO;
  139. { Reset IO Error }
  140. InOutRes:=0;
  141. (* This should be changed to a real value during *)
  142. (* thread driver initialization if appropriate. *)
  143. ThreadID := 1;
  144. {$ifdef HASVARIANT}
  145. initvariantmanager;
  146. {$endif HASVARIANT}
  147. End.
  148. {
  149. $Log$
  150. Revision 1.16 2004-06-19 08:06:04 marco
  151. * moved heap.inc and text.inc before sysalloc as suggested. Why wasn't this
  152. done directly?
  153. Revision 1.15 2004/06/17 16:16:13 peter
  154. * New heapmanager that releases memory back to the OS, donated
  155. by Micha Nelissen
  156. Revision 1.14 2004/01/22 13:46:14 marco
  157. bsd
  158. Revision 1.13 2004/01/20 23:09:14 hajny
  159. * ExecuteProcess fixes, ProcessID and ThreadID added
  160. Revision 1.12 2004/01/04 20:32:05 jonas
  161. + geterrnolocation for Darwin
  162. + C-style main for Darwin (generic, can be used for anything)
  163. Revision 1.11 2003/12/30 12:26:21 marco
  164. * FPC_USE_LIBC
  165. Revision 1.10 2003/10/26 17:01:04 marco
  166. * moved sigprocmask to system
  167. Revision 1.9 2003/10/26 16:42:22 marco
  168. * texception4 fix merge
  169. Revision 1.8 2003/01/05 19:01:28 marco
  170. * FreeBSD compiles now with baseunix mods.
  171. Revision 1.7 2002/11/12 14:57:48 marco
  172. * Ugly hack to temporarily be able to use system.pp for Linux too
  173. Revision 1.6 2002/10/27 11:58:30 marco
  174. * Modifications from Saturday.
  175. Revision 1.5 2002/10/26 18:27:51 marco
  176. * First series POSIX calls commits. Including getcwd.
  177. Revision 1.4 2002/10/18 12:19:58 marco
  178. * Fixes to get the generic *BSD RTL compiling again + fixes for thread
  179. support. Still problems left in fexpand. (inoutres?) Therefore fixed
  180. sysposix not yet commited
  181. Revision 1.3 2002/10/13 09:25:39 florian
  182. + call to initvariantmanager inserted
  183. Revision 1.2 2002/09/07 16:01:17 peter
  184. * old logs removed and tabs fixed
  185. Revision 1.1 2002/08/19 12:29:11 marco
  186. * First working POSIX *BSD system unit.
  187. }