system.pp 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283
  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(ErrOutput,fmOutput,StdErrorHandle);
  115. OpenStdIO(StdOut,fmOutput,StdOutputHandle);
  116. OpenStdIO(StdErr,fmOutput,StdErrorHandle);
  117. end;
  118. {$ifdef FPC_USE_LIBC}
  119. { can also be used with other BSD's if they use the system's crtX instead of prtX }
  120. {$ifdef Darwin}
  121. procedure pascalmain; external name 'PASCALMAIN';
  122. { Main entry point in C style, needed to capture program parameters. }
  123. procedure main(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl; [public];
  124. begin
  125. argc:= argcparam;
  126. argv:= argvparam;
  127. envp:= envpparam;
  128. pascalmain; {run the pascal main program}
  129. end;
  130. {$endif Darwin}
  131. {$endif FPC_USE_LIBC}
  132. Begin
  133. IsConsole := TRUE;
  134. IsLibrary := FALSE;
  135. StackLength := InitialStkLen;
  136. StackBottom := Sptr - StackLength;
  137. { Set up signals handlers }
  138. InstallSignals;
  139. { Setup heap }
  140. InitHeap;
  141. SysInitExceptions;
  142. { Arguments }
  143. SetupCmdLine;
  144. { Setup stdin, stdout and stderr }
  145. SysInitStdIO;
  146. { Reset IO Error }
  147. InOutRes:=0;
  148. (* This should be changed to a real value during *)
  149. (* thread driver initialization if appropriate. *)
  150. ThreadID := 1;
  151. {$ifdef HASVARIANT}
  152. initvariantmanager;
  153. {$endif HASVARIANT}
  154. End.
  155. {
  156. $Log$
  157. Revision 1.20 2004-11-04 09:32:31 peter
  158. ErrOutput added
  159. Revision 1.19 2004/07/17 15:31:03 jonas
  160. * initialise StackLength (fixes stack checking in general, and tw2897 in
  161. particular)
  162. Revision 1.18 2004/07/03 22:49:34 daniel
  163. * Moved declarations downwards
  164. Revision 1.17 2004/07/03 22:44:37 daniel
  165. * Declared envp,argc,argv in interface for Darwin
  166. Revision 1.16 2004/06/19 08:06:04 marco
  167. * moved heap.inc and text.inc before sysalloc as suggested. Why wasn't this
  168. done directly?
  169. Revision 1.15 2004/06/17 16:16:13 peter
  170. * New heapmanager that releases memory back to the OS, donated
  171. by Micha Nelissen
  172. Revision 1.14 2004/01/22 13:46:14 marco
  173. bsd
  174. Revision 1.13 2004/01/20 23:09:14 hajny
  175. * ExecuteProcess fixes, ProcessID and ThreadID added
  176. Revision 1.12 2004/01/04 20:32:05 jonas
  177. + geterrnolocation for Darwin
  178. + C-style main for Darwin (generic, can be used for anything)
  179. Revision 1.11 2003/12/30 12:26:21 marco
  180. * FPC_USE_LIBC
  181. Revision 1.10 2003/10/26 17:01:04 marco
  182. * moved sigprocmask to system
  183. Revision 1.9 2003/10/26 16:42:22 marco
  184. * texception4 fix merge
  185. Revision 1.8 2003/01/05 19:01:28 marco
  186. * FreeBSD compiles now with baseunix mods.
  187. Revision 1.7 2002/11/12 14:57:48 marco
  188. * Ugly hack to temporarily be able to use system.pp for Linux too
  189. Revision 1.6 2002/10/27 11:58:30 marco
  190. * Modifications from Saturday.
  191. Revision 1.5 2002/10/26 18:27:51 marco
  192. * First series POSIX calls commits. Including getcwd.
  193. Revision 1.4 2002/10/18 12:19:58 marco
  194. * Fixes to get the generic *BSD RTL compiling again + fixes for thread
  195. support. Still problems left in fexpand. (inoutres?) Therefore fixed
  196. sysposix not yet commited
  197. Revision 1.3 2002/10/13 09:25:39 florian
  198. + call to initvariantmanager inserted
  199. Revision 1.2 2002/09/07 16:01:17 peter
  200. * old logs removed and tabs fixed
  201. Revision 1.1 2002/08/19 12:29:11 marco
  202. * First working POSIX *BSD system unit.
  203. }