system.pp 6.2 KB

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