mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-05 19:10:15 +02:00
* quick hack from Linux system unit
This commit is contained in:
parent
06d493775e
commit
aec3ded0cf
124
rtl/morphos/system.pp
Normal file
124
rtl/morphos/system.pp
Normal file
@ -0,0 +1,124 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
This file is part of the Free Pascal run time library.
|
||||||
|
Copyright (c) 2004 by Karoly Balogh for Genesi Sarl
|
||||||
|
|
||||||
|
System unit for MorphOS.
|
||||||
|
|
||||||
|
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}Sysmorph{$else}System{$endif};
|
||||||
|
|
||||||
|
Interface
|
||||||
|
|
||||||
|
{$define FPC_IS_SYSTEM}
|
||||||
|
|
||||||
|
{$I sysunixh.inc}
|
||||||
|
|
||||||
|
Implementation
|
||||||
|
|
||||||
|
|
||||||
|
{$I system.inc}
|
||||||
|
|
||||||
|
{ OS dependant parts }
|
||||||
|
|
||||||
|
{$I errno.inc} // error numbers
|
||||||
|
{$I bunxtype.inc} // c-types, unix base types, unix
|
||||||
|
// base structures
|
||||||
|
|
||||||
|
|
||||||
|
{$I ossysc.inc} // base syscalls
|
||||||
|
{$I osmain.inc} // base wrappers *nix RTL (derivatives)
|
||||||
|
|
||||||
|
{ 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(StdOut,fmOutput,StdOutputHandle);
|
||||||
|
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SysInitExecPath;
|
||||||
|
var
|
||||||
|
hs : string[16];
|
||||||
|
link : string;
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
str(Fpgetpid,hs);
|
||||||
|
hs:='/proc/'+hs+'/exe'#0;
|
||||||
|
i:=Fpreadlink(@hs[1],@link[1],high(link));
|
||||||
|
{ it must also be an absolute filename, linux 2.0 points to a memory
|
||||||
|
location so this will skip that }
|
||||||
|
if (i>0) and (link[1]='/') then
|
||||||
|
begin
|
||||||
|
link[0]:=chr(i);
|
||||||
|
ExecPathStr:=link;
|
||||||
|
end;
|
||||||
|
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.1 2004-02-13 07:19:53 karoly
|
||||||
|
* quick hack from Linux system unit
|
||||||
|
|
||||||
|
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user