mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 05:31:29 +01:00
269 lines
6.6 KiB
ObjectPascal
269 lines
6.6 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time librar~y.
|
|
Copyright (c) 2000 by Marco van de Voort
|
|
member of the Free Pascal development team.
|
|
|
|
System unit for Linux.
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
{ These things are set in the makefile, }
|
|
{ But you can override them here.}
|
|
|
|
|
|
{ If you use an aout system, set the conditional AOUT}
|
|
{ $Define AOUT}
|
|
|
|
Unit {$ifdef VER1_0}Syslinux{$else}System{$endif};
|
|
|
|
Interface
|
|
{$define oldreaddir}
|
|
{$define usedomain}
|
|
{$define posixworkaround}
|
|
{$define FPC_IS_SYSTEM}
|
|
{$ifdef FPC_USE_LIBC}
|
|
{$define usegetcwd}
|
|
{$endif}
|
|
|
|
{$I sysunixh.inc}
|
|
|
|
Implementation
|
|
|
|
|
|
{$ifdef FPC_USE_LIBC}
|
|
|
|
const clib = 'c';
|
|
|
|
type libcint=longint;
|
|
plibcint=^libcint;
|
|
|
|
function geterrnolocation: Plibcint; cdecl;external clib name'__errno_location';
|
|
|
|
function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
|
|
|
|
begin
|
|
geterrno:=geterrnolocation^;
|
|
end;
|
|
|
|
procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
|
|
begin
|
|
geterrnolocation^:=err;
|
|
end;
|
|
|
|
{$else}
|
|
|
|
{$ifdef ver1_0}
|
|
Var
|
|
{$else}
|
|
ThreadVar
|
|
{$endif}
|
|
Errno : longint;
|
|
|
|
function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
|
|
|
|
begin
|
|
GetErrno:=Errno;
|
|
end;
|
|
|
|
procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
|
|
|
|
begin
|
|
Errno:=err;
|
|
end;
|
|
{$endif}
|
|
|
|
{$I system.inc}
|
|
|
|
{ OS dependant parts }
|
|
|
|
{$I errno.inc} // error numbers
|
|
{$I bunxtype.inc} // c-types, unix base types, unix
|
|
// base structures
|
|
|
|
{*****************************************************************************
|
|
Extra cdecl declarations for FPC_USE_LIBC for this os
|
|
*****************************************************************************}
|
|
|
|
{$ifdef FPC_USE_LIBC}
|
|
Function fpReadLink(name,linkname:pchar;maxlen:cint):cint; cdecl; external name 'readlink';
|
|
function fpgetcwd(buf:pchar;_size:size_t):pchar; cdecl; external name 'getcwd';
|
|
{$endif}
|
|
|
|
|
|
{$I ossysc.inc} // base syscalls
|
|
{$I osmain.inc} // base wrappers *nix RTL (derivatives)
|
|
|
|
{*****************************************************************************
|
|
OS Memory allocation / deallocation
|
|
****************************************************************************}
|
|
|
|
function SysOSAlloc(size: ptrint): pointer;
|
|
begin
|
|
result := sbrk(size);
|
|
end;
|
|
|
|
{$define HAS_SYSOSFREE}
|
|
|
|
procedure SysOSFree(p: pointer; size: ptrint);
|
|
begin
|
|
fpmunmap(p, size);
|
|
end;
|
|
|
|
{ more OS independant parts}
|
|
|
|
{$I text.inc}
|
|
{$I heap.inc}
|
|
|
|
{*****************************************************************************
|
|
UnTyped File Handling
|
|
*****************************************************************************}
|
|
|
|
{$i file.inc}
|
|
|
|
{*****************************************************************************
|
|
Typed File Handling
|
|
*****************************************************************************}
|
|
|
|
{$i typefile.inc}
|
|
|
|
|
|
procedure SysInitStdIO;
|
|
begin
|
|
OpenStdIO(Input,fmInput,StdInputHandle);
|
|
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
|
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
|
|
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
|
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
|
end;
|
|
|
|
|
|
procedure SysInitExecPath;
|
|
var
|
|
i : longint;
|
|
begin
|
|
execpathstr[0]:=#0;
|
|
i:=Fpreadlink('/proc/self/exe',@execpathstr[1],high(execpathstr));
|
|
{ it must also be an absolute filename, linux 2.0 points to a memory
|
|
location so this will skip that }
|
|
if (i>0) and (execpathstr[1]='/') then
|
|
execpathstr[0]:=char(i);
|
|
end;
|
|
|
|
function GetProcessID: SizeUInt;
|
|
begin
|
|
GetProcessID := SizeUInt (fpGetPID);
|
|
end;
|
|
|
|
|
|
Begin
|
|
IsConsole := TRUE;
|
|
IsLibrary := FALSE;
|
|
StackLength := InitialStkLen;
|
|
StackBottom := Sptr - StackLength;
|
|
{ Set up signals handlers }
|
|
InstallSignals;
|
|
{ Setup heap }
|
|
InitHeap;
|
|
SysInitExceptions;
|
|
{ Arguments }
|
|
SetupCmdLine;
|
|
SysInitExecPath;
|
|
{ Setup stdin, stdout and stderr }
|
|
SysInitStdIO;
|
|
{ Reset IO Error }
|
|
InOutRes:=0;
|
|
(* This should be changed to a real value during *)
|
|
(* thread driver initialization if appropriate. *)
|
|
ThreadID := 1;
|
|
{$ifdef HASVARIANT}
|
|
initvariantmanager;
|
|
{$endif HASVARIANT}
|
|
End.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.20 2004-12-05 14:36:37 hajny
|
|
+ GetProcessID added
|
|
|
|
Revision 1.19 2004/11/04 09:32:31 peter
|
|
ErrOutput added
|
|
|
|
Revision 1.18 2004/07/09 22:31:22 peter
|
|
* fixed execpathstr setting
|
|
|
|
Revision 1.17 2004/07/08 21:22:15 daniel
|
|
* Tweaking...
|
|
|
|
Revision 1.16 2004/07/08 19:45:42 daniel
|
|
* Use /proc/self/exe instead of /proc/[getpid]/exe
|
|
|
|
Revision 1.15 2004/06/17 16:16:13 peter
|
|
* New heapmanager that releases memory back to the OS, donated
|
|
by Micha Nelissen
|
|
|
|
Revision 1.14 2004/01/20 23:09:14 hajny
|
|
* ExecuteProcess fixes, ProcessID and ThreadID added
|
|
|
|
Revision 1.13 2004/01/01 14:16:55 marco
|
|
* getcwd missed cdecl
|
|
|
|
Revision 1.12 2003/12/31 20:20:57 marco
|
|
* small additions for getcwd what we need for FPC_USE_LIBC
|
|
|
|
Revision 1.11 2003/12/30 16:26:10 marco
|
|
* some more fixes. Testing on idefix
|
|
|
|
Revision 1.10 2003/12/30 15:43:20 marco
|
|
* linux now compiles with FPC_USE_LIBC
|
|
|
|
Revision 1.9 2003/12/30 12:36:56 marco
|
|
* FPC_USE_LIBC
|
|
|
|
Revision 1.8 2003/09/14 20:15:01 marco
|
|
* Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
|
|
|
|
Revision 1.7 2003/04/30 22:11:06 florian
|
|
+ for a lot of x86-64 dependend files mostly dummies added
|
|
|
|
Revision 1.6 2002/12/27 18:36:16 peter
|
|
* Setup ExecPathStr for ParamStr(0)
|
|
|
|
Revision 1.5 2002/12/18 20:42:29 peter
|
|
* initial stacklen setup
|
|
|
|
Revision 1.3 2002/12/18 16:44:09 marco
|
|
* more new RTL
|
|
|
|
Revision 1.7 2002/11/12 14:57:48 marco
|
|
* Ugly hack to temporarily be able to use system.pp for Linux too
|
|
|
|
Revision 1.6 2002/10/27 11:58:30 marco
|
|
* Modifications from Saturday.
|
|
|
|
Revision 1.5 2002/10/26 18:27:51 marco
|
|
* First series POSIX calls commits. Including getcwd.
|
|
|
|
Revision 1.4 2002/10/18 12:19:58 marco
|
|
* Fixes to get the generic *BSD RTL compiling again + fixes for thread
|
|
support. Still problems left in fexpand. (inoutres?) Therefore fixed
|
|
sysposix not yet commited
|
|
|
|
Revision 1.3 2002/10/13 09:25:39 florian
|
|
+ call to initvariantmanager inserted
|
|
|
|
Revision 1.2 2002/09/07 16:01:17 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
Revision 1.1 2002/08/19 12:29:11 marco
|
|
* First working POSIX *BSD system unit.
|
|
|
|
}
|