← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/solaris/system.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/solaris/system.pp
 
1
{
 
2
    $Id: system.pp,v 1.6 2005/02/14 17:13:31 peter Exp $
 
3
    This file is part of the Free Pascal run time library.
 
4
    Copyright (c) 1999-2000 by the Free Pascal development team.
 
5
 
 
6
    Solaris system unit
 
7
 
 
8
    See the file COPYING.FPC, included in this distribution,
 
9
    for details about the copyright.
 
10
 
 
11
    This program is distributed in the hope that it will be useful,
 
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
14
 
 
15
 **********************************************************************}
 
16
unit System;
 
17
 
 
18
interface
 
19
 
 
20
{$define FPC_IS_SYSTEM}
 
21
 
 
22
{ include system-independent routine headers }
 
23
 
 
24
{$I sysunixh.inc}
 
25
 
 
26
var argc:longint;
 
27
    argv:PPchar;
 
28
    envp:PPchar;
 
29
 
 
30
 
 
31
implementation
 
32
 
 
33
{ OS independant parts}
 
34
 
 
35
{$I system.inc}
 
36
 
 
37
{*****************************************************************************
 
38
                       Misc. System Dependent Functions
 
39
*****************************************************************************}
 
40
 
 
41
{$i start.inc}
 
42
 
 
43
procedure System_exit;
 
44
begin
 
45
   Fpexit(cint(ExitCode));
 
46
End;
 
47
 
 
48
 
 
49
Function ParamCount: Longint;
 
50
Begin
 
51
  Paramcount:=argc-1
 
52
End;
 
53
 
 
54
 
 
55
function BackPos(c:char; const s: shortstring): integer;
 
56
var
 
57
 i: integer;
 
58
Begin
 
59
  for i:=length(s) downto 0 do
 
60
    if s[i] = c then break;
 
61
  if i=0 then
 
62
    BackPos := 0
 
63
  else
 
64
    BackPos := i;
 
65
end;
 
66
 
 
67
 
 
68
 { variable where full path and filename and executable is stored }
 
69
 { is setup by the startup of the system unit.                    }
 
70
var
 
71
 execpathstr : shortstring;
 
72
 
 
73
function paramstr(l: longint) : string;
 
74
 var
 
75
  s: string;
 
76
  s1: string;
 
77
 begin
 
78
   { stricly conforming POSIX applications  }
 
79
   { have the executing filename as argv[0] }
 
80
//   if l=0 then
 
81
//     begin
 
82
//       paramstr := execpathstr;
 
83
//     end
 
84
//   else
 
85
     paramstr:=strpas(argv[l]);
 
86
 end;
 
87
 
 
88
Procedure Randomize;
 
89
Begin
 
90
  randseed:=longint(Fptime(nil));
 
91
End;
 
92
 
 
93
 
 
94
{*****************************************************************************
 
95
                         SystemUnit Initialization
 
96
*****************************************************************************}
 
97
 
 
98
function  reenable_signal(sig : longint) : boolean;
 
99
var
 
100
  e,oe : TSigSet;
 
101
  i,j : byte;
 
102
begin
 
103
  fillchar(e,sizeof(e),#0);
 
104
  fillchar(oe,sizeof(oe),#0);
 
105
  { set is 1 based PM }
 
106
  dec(sig);
 
107
  i:=sig mod 32;
 
108
  j:=sig div 32;
 
109
  e[j]:=1 shl i;
 
110
  fpsigprocmask(SIG_UNBLOCK,@e,@oe);
 
111
  reenable_signal:=geterrno=0;
 
112
end;
 
113
 
 
114
{$i sighnd.inc}
 
115
 
 
116
var
 
117
  act: SigActionRec;
 
118
 
 
119
Procedure InstallSignals;
 
120
var
 
121
  oldact: SigActionRec;
 
122
begin
 
123
  { Initialize the sigaction structure }
 
124
  { all flags and information set to zero }
 
125
  FillChar(act, sizeof(SigActionRec),0);
 
126
  { initialize handler                    }
 
127
  act.sa_handler :=@SignalToRunError;
 
128
  act.sa_flags:=SA_SIGINFO;
 
129
  FpSigAction(SIGFPE,act,oldact);
 
130
  FpSigAction(SIGSEGV,act,oldact);
 
131
  FpSigAction(SIGBUS,act,oldact);
 
132
  FpSigAction(SIGILL,act,oldact);
 
133
end;
 
134
 
 
135
 
 
136
procedure SetupCmdLine;
 
137
var
 
138
  bufsize,
 
139
  len,j,
 
140
  size,i : longint;
 
141
  found  : boolean;
 
142
  buf    : pchar;
 
143
 
 
144
  procedure AddBuf;
 
145
  begin
 
146
    reallocmem(cmdline,size+bufsize);
 
147
    move(buf^,cmdline[size],bufsize);
 
148
    inc(size,bufsize);
 
149
    bufsize:=0;
 
150
  end;
 
151
 
 
152
begin
 
153
  GetMem(buf,ARG_MAX);
 
154
  size:=0;
 
155
  bufsize:=0;
 
156
  i:=0;
 
157
  while (i<argc) do
 
158
   begin
 
159
     len:=strlen(argv[i]);
 
160
     if len>ARG_MAX-2 then
 
161
      len:=ARG_MAX-2;
 
162
     found:=false;
 
163
     for j:=1 to len do
 
164
      if argv[i][j]=' ' then
 
165
       begin
 
166
         found:=true;
 
167
         break;
 
168
       end;
 
169
     if bufsize+len>=ARG_MAX-2 then
 
170
      AddBuf;
 
171
     if found then
 
172
      begin
 
173
        buf[bufsize]:='"';
 
174
        inc(bufsize);
 
175
      end;
 
176
     move(argv[i]^,buf[bufsize],len);
 
177
     inc(bufsize,len);
 
178
     if found then
 
179
      begin
 
180
        buf[bufsize]:='"';
 
181
        inc(bufsize);
 
182
      end;
 
183
     if i<argc then
 
184
      buf[bufsize]:=' '
 
185
     else
 
186
      buf[bufsize]:=#0;
 
187
     inc(bufsize);
 
188
     inc(i);
 
189
   end;
 
190
  AddBuf;
 
191
  FreeMem(buf,ARG_MAX);
 
192
end;
 
193
 
 
194
 
 
195
procedure SysInitStdIO;
 
196
begin
 
197
  OpenStdIO(Input,fmInput,StdInputHandle);
 
198
  OpenStdIO(Output,fmOutput,StdOutputHandle);
 
199
  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 
200
  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
 
201
  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 
202
end;
 
203
 
 
204
 
 
205
function GetProcessID: SizeUInt;
 
206
begin
 
207
 GetProcessID := SizeUInt (fpGetPID);
 
208
end;
 
209
 
 
210
 
 
211
Begin
 
212
  IsConsole := TRUE;
 
213
  IsLibrary := FALSE;
 
214
  StackLength := InitialStkLen;
 
215
  StackBottom := Sptr - StackLength;
 
216
{ Set up signals handlers }
 
217
  InstallSignals;
 
218
{ Setup heap }
 
219
  InitHeap;
 
220
  SysInitExceptions;
 
221
{ Arguments }
 
222
  SetupCmdLine;
 
223
{ Setup stdin, stdout and stderr }
 
224
  SysInitStdIO;
 
225
{ Reset IO Error }
 
226
  InOutRes:=0;
 
227
  InitSystemThreads;
 
228
{$ifdef HASVARIANT}
 
229
  initvariantmanager;
 
230
{$endif HASVARIANT}
 
231
{$ifdef HASWIDESTRING}
 
232
  initwidestringmanager;
 
233
{$endif HASWIDESTRING}
 
234
End.
 
235
 
 
236
{
 
237
 $Log: system.pp,v $
 
238
 Revision 1.6  2005/02/14 17:13:31  peter
 
239
   * truncate log
 
240
 
 
241
 Revision 1.5  2005/02/14 16:32:41  peter
 
242
   * solaris updates
 
243
 
 
244
 Revision 1.4  2005/02/13 22:13:20  peter
 
245
   * get solaris back in shape
 
246
 
 
247
 Revision 1.3  2005/02/13 21:47:56  peter
 
248
   * include file cleanup part 2
 
249
 
 
250
 Revision 1.2  2005/02/10 17:30:54  peter
 
251
   * renamed to solaris
 
252
 
 
253
 Revision 1.5  2005/02/07 22:17:26  peter
 
254
   * updated for 1.9.x unix rtl
 
255
 
 
256
 Revision 1.4  2005/02/01 20:22:50  florian
 
257
   * improved widestring infrastructure manager
 
258
 
 
259
}