paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 20:00:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Turn cmdline into property on Linux.

Browse Source 
* Move some procedure in Linux system unit.

git-svn-id: trunk@4964 -
This commit is contained in:
daniel 2006-10-18 20:07:10 +00:00
parent 7c915938d9
commit bbc80554b1
2 changed files with 74 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
rtl/inc/systemh.inc
View File

@ -329,9 +329,6 @@ const
fmInOut = $D7B3;
fmAppend = $D7B4;
Filemode : byte = 2;
{$ifndef HAS_CMDLINE}
CmdLine : PChar = nil;
{$endif HAS_CMDLINE}
(* Value should be changed during system initialization as appropriate. *)
{ assume that this program will not spawn other threads, when the
@ -353,6 +350,11 @@ var
{ Threading support }
fpc_threadvar_relocate_proc : pointer; public name 'FPC_THREADVAR_RELOCATE';
{$ifndef HAS_CMDLINE}
{Value should be changed during system initialization as appropriate.}
var cmdline:Pchar=nil;
{$endif}
ThreadVar
ThreadID : TThreadID;

119
rtl/linux/system.pp
View File

@ -25,15 +25,25 @@
Unit System;
Interface
{*****************************************************************************}
interface
{*****************************************************************************}
{$define FPC_IS_SYSTEM}
{$define HAS_CMDLINE}
{$define USE_NOTHREADMANAGER}
{$i osdefs.inc}
{$I sysunixh.inc}
Implementation
function get_cmdline:Pchar;
property cmdline:Pchar read get_cmdline;
{*****************************************************************************}
implementation
{*****************************************************************************}
{ Include ELF resources }
@ -44,6 +54,7 @@ Implementation
{$I system.inc}
const calculated_cmdline:Pchar=nil;
{*****************************************************************************
Misc. System Dependent Functions
@ -63,7 +74,7 @@ Begin
End;
function BackPos(c:char; const s: shortstring): integer;
{function BackPos(c:char; const s: shortstring): integer;
var
i: integer;
Begin
@ -73,7 +84,7 @@ Begin
BackPos := 0
else
BackPos := i;
end;
end;}
{ variable where full path and filename and executable is stored }
@ -98,49 +109,10 @@ Begin
randseed:=longint(Fptime(nil));
End;
{*****************************************************************************
SystemUnit Initialization
cmdline
*****************************************************************************}
function reenable_signal(sig : longint) : boolean;
var
e : TSigSet;
i,j : byte;
begin
fillchar(e,sizeof(e),#0);
{ set is 1 based PM }
dec(sig);
i:=sig mod (sizeof(cuLong) * 8);
j:=sig div (sizeof(cuLong) * 8);
e[j]:=1 shl i;
fpsigprocmask(SIG_UNBLOCK,@e,nil);
reenable_signal:=geterrno=0;
end;
// signal handler is arch dependant due to processorexception to language
// exception translation
{$i sighnd.inc}
var
act: SigActionRec;
Procedure InstallSignals;
begin
{ Initialize the sigaction structure }
{ all flags and information set to zero }
FillChar(act, sizeof(SigActionRec),0);
{ initialize handler }
act.sa_handler := SigActionHandler(@SignalToRunError);
act.sa_flags:=SA_SIGINFO;
FpSigAction(SIGFPE,@act,nil);
FpSigAction(SIGSEGV,@act,nil);
FpSigAction(SIGBUS,@act,nil);
FpSigAction(SIGILL,@act,nil);
end;
procedure SetupCmdLine;
var
bufsize,
@ -151,14 +123,13 @@ var
procedure AddBuf;
begin
reallocmem(cmdline,size+bufsize);
move(buf^,cmdline[size],bufsize);
reallocmem(calculated_cmdline,size+bufsize);
move(buf^,calculated_cmdline[size],bufsize);
inc(size,bufsize);
bufsize:=0;
end;
begin
cmdline:=nil;
if i>=argc then
exit;
GetMem(buf,ARG_MAX);
@ -202,6 +173,55 @@ begin
FreeMem(buf,ARG_MAX);
end;
function get_cmdline:Pchar;
begin
if calculated_cmdline=nil then
setupcmdline;
get_cmdline:=calculated_cmdline;
end;
{*****************************************************************************
SystemUnit Initialization
*****************************************************************************}
function reenable_signal(sig : longint) : boolean;
var
e : TSigSet;
i,j : byte;
begin
fillchar(e,sizeof(e),#0);
{ set is 1 based PM }
dec(sig);
i:=sig mod (sizeof(cuLong) * 8);
j:=sig div (sizeof(cuLong) * 8);
e[j]:=1 shl i;
fpsigprocmask(SIG_UNBLOCK,@e,nil);
reenable_signal:=geterrno=0;
end;
// signal handler is arch dependant due to processorexception to language
// exception translation
{$i sighnd.inc}
var
act: SigActionRec;
Procedure InstallSignals;
begin
{ Initialize the sigaction structure }
{ all flags and information set to zero }
FillChar(act, sizeof(SigActionRec),0);
{ initialize handler }
act.sa_handler := SigActionHandler(@SignalToRunError);
act.sa_flags:=SA_SIGINFO;
FpSigAction(SIGFPE,@act,nil);
FpSigAction(SIGSEGV,@act,nil);
FpSigAction(SIGBUS,@act,nil);
FpSigAction(SIGILL,@act,nil);
end;
procedure SysInitStdIO;
begin
@ -251,7 +271,7 @@ end;
var
initialstkptr : Pointer;external name '__stkptr';
Begin
begin
SysResetFPU;
IsConsole := TRUE;
StackLength := CheckInitialStkLen(initialStkLen);
@ -264,7 +284,6 @@ Begin
{ Setup stdin, stdout and stderr }
SysInitStdIO;
{ Arguments }
SetupCmdLine;
SysInitExecPath;
{ Reset IO Error }
InOutRes:=0;
@ -272,4 +291,4 @@ Begin
InitSystemThreads;
initvariantmanager;
initwidestringmanager;
End.
end.