1{
2    This file is part of the Free Pascal run time library.
3    Copyright (c) 1999-2000 by the Free Pascal development team.
4
5    AIX system unit
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15unit System;
16
17interface
18
19{$define FPC_IS_SYSTEM}
20
21{$linklib m}
22
23{ include system-independent routine headers }
24
25{$I sysunixh.inc}
26
27var argc:longint;
28    argv:PPchar;
29    envp:PPchar;
30
31implementation
32
33
34{ OS independant parts}
35
36{$I system.inc}
37
38{*****************************************************************************
39                       Misc. System Dependent Functions
40*****************************************************************************}
41
42procedure pascalmain;external name 'PASCALMAIN';
43
44procedure FPC_SYSTEMMAIN(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl; [public];
45
46begin
47  argc:=argcparam;
48  argv:=argvparam;
49  envp:=envpparam;
50  pascalmain;  {run the pascal main program}
51end;
52
53
54procedure System_exit;
55begin
56   Fpexit(cint(ExitCode));
57End;
58
59
60Function ParamCount: Longint;
61Begin
62  Paramcount:=argc-1
63End;
64
65
66function BackPos(c:char; const s: shortstring): integer;
67var
68 i: integer;
69Begin
70  for i:=length(s) downto 0 do
71    if s[i] = c then break;
72  if i=0 then
73    BackPos := 0
74  else
75    BackPos := i;
76end;
77
78
79function paramstr(l: longint) : string;
80 var
81  s: string;
82  s1: string;
83 begin
84   { stricly conforming POSIX applications  }
85   { have the executing filename as argv[0] }
86     if (l < argc) then
87       paramstr:=strpas(argv[l])
88     else
89       paramstr:='';
90 end;
91
92Procedure Randomize;
93Begin
94  randseed:=longint(Fptime(nil));
95End;
96
97
98{*****************************************************************************
99                         SystemUnit Initialization
100*****************************************************************************}
101
102function  reenable_signal(sig : longint) : boolean;
103var
104  e,oe : TSigSet;
105  i,j : byte;
106  olderrno: cint;
107begin
108  fillchar(e,sizeof(e),#0);
109  fillchar(oe,sizeof(oe),#0);
110  { set is 1 based PM }
111  dec(sig);
112  i:=sig mod sizeof(clong);
113  j:=sig div sizeof(clong);
114  e[j]:=1 shl i;
115  { this routine is called from a signal handler, so must not change errno }
116  olderrno:=geterrno;
117  fpsigprocmask(SIG_UNBLOCK,@e,@oe);
118  reenable_signal:=geterrno=0;
119  seterrno(olderrno);
120end;
121
122{$i sighnd.inc}
123
124procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
125var
126  act: SigActionRec;
127begin
128  { Initialize the sigaction structure }
129  { all flags and information set to zero }
130  FillChar(act, sizeof(SigActionRec),0);
131  { initialize handler                    }
132  act.sa_handler:=@SignalToRunError;
133  act.sa_flags:=SA_SIGINFO;
134  FpSigAction(signum,act,oldact);
135end;
136
137var
138  oldsigfpe: SigActionRec; public name '_FPC_OLDSIGFPE';
139  oldsigsegv: SigActionRec; public name '_FPC_OLDSIGSEGV';
140  oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
141  oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
142
143Procedure InstallSignals;
144begin
145  InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
146  InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
147  InstallDefaultSignalHandler(SIGBUS,oldsigbus);
148  InstallDefaultSignalHandler(SIGILL,oldsigill);
149end;
150
151Procedure RestoreOldSignalHandlers;
152begin
153  FpSigAction(SIGFPE,@oldsigfpe,nil);
154  FpSigAction(SIGSEGV,@oldsigsegv,nil);
155  FpSigAction(SIGBUS,@oldsigbus,nil);
156  FpSigAction(SIGILL,@oldsigill,nil);
157end;
158
159
160procedure SetupCmdLine;
161var
162  bufsize,
163  len,j,
164  size,i : longint;
165  found  : boolean;
166  buf    : pchar;
167
168  procedure AddBuf;
169  begin
170    reallocmem(cmdline,size+bufsize);
171    move(buf^,cmdline[size],bufsize);
172    inc(size,bufsize);
173    bufsize:=0;
174  end;
175
176begin
177  GetMem(buf,ARG_MAX);
178  size:=0;
179  bufsize:=0;
180  i:=0;
181  while (i<argc) do
182   begin
183     len:=strlen(argv[i]);
184     if len>ARG_MAX-2 then
185      len:=ARG_MAX-2;
186     found:=false;
187     for j:=1 to len do
188      if argv[i][j]=' ' then
189       begin
190         found:=true;
191         break;
192       end;
193     if bufsize+len>=ARG_MAX-2 then
194      AddBuf;
195     if found then
196      begin
197        buf[bufsize]:='"';
198        inc(bufsize);
199      end;
200     move(argv[i]^,buf[bufsize],len);
201     inc(bufsize,len);
202     if found then
203      begin
204        buf[bufsize]:='"';
205        inc(bufsize);
206      end;
207     if i<argc-1 then
208      buf[bufsize]:=' '
209     else
210      buf[bufsize]:=#0;
211     inc(bufsize);
212     inc(i);
213   end;
214  AddBuf;
215  FreeMem(buf,ARG_MAX);
216end;
217
218
219procedure SysInitStdIO;
220begin
221  OpenStdIO(Input,fmInput,StdInputHandle);
222  OpenStdIO(Output,fmOutput,StdOutputHandle);
223  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
224  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
225  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
226end;
227
228
229function GetProcessID: SizeUInt;
230begin
231 GetProcessID := SizeUInt (fpGetPID);
232end;
233
234function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
235begin
236  result := stklen;
237end;
238
239
240const
241  FP_TRAP_SYNC = 1;                { precise fpu exceptions }
242  FP_TRAP_OFF = 0;                 { disable fpu exceptions }
243  FP_TRAP_QUERY = 2;               { current fpu exception state }
244  FP_TRAP_IMP = 3;                 { imprecise non-recoverable fpu exceptions }
245  FP_TRAP_IMP_REC = 4;             { imprecise recoverable fpu exceptions }
246  FP_TRAP_FASTMODE = 128;          { fastest fpu exception state }
247  FP_TRAP_ERROR = -1;
248  FP_TRAP_UNIMPL = -2;
249
250  TRP_INVALID     = $00000080;
251  TRP_OVERFLOW    = $00000040;
252  TRP_UNDERFLOW   = $00000020;
253  TRP_DIV_BY_ZERO = $00000010;
254  TRP_INEXACT     = $00000008;
255
256
257function fp_trap(flag: longint): longint; cdecl; external;
258procedure fp_enable(Mask: DWord);cdecl;external;
259
260Begin
261  IsConsole := TRUE;
262  StackLength := CheckInitialStkLen(InitialStkLen);
263  StackBottom := Sptr - StackLength;
264  { Set up signals handlers (may be needed by init code to test cpu features) }
265  InstallSignals;
266
267  SysResetFPU;
268  if not(IsLibrary) then
269    begin
270      { clear pending exceptions }
271      feclearexcept(FE_ALL_EXCEPT);
272      { enable floating point exceptions process-wide (try two possibilities) }
273      if fp_trap(FP_TRAP_SYNC)=FP_TRAP_UNIMPL then
274        fp_trap(FP_TRAP_IMP);
275
276      SysInitFPU;
277      { now enable the actual individual exceptions, except for underflow and
278        inexact (also disabled by default on x86 and in the softfpu mask) }
279      fp_enable(TRP_INVALID or TRP_DIV_BY_ZERO or TRP_OVERFLOW);
280    end;
281
282{ Setup heap }
283  InitHeap;
284  SysInitExceptions;
285
286  initunicodestringmanager;
287
288{ Setup stdin, stdout and stderr }
289  SysInitStdIO;
290{ Reset IO Error }
291  InOutRes:=0;
292{ Arguments }
293  SetupCmdLine;
294  InitSystemThreads;
295  InitSystemDynLibs;
296  { restore original signal handlers in case this is a library }
297  if IsLibrary then
298    RestoreOldSignalHandlers;
299End.
300