← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/linux/bunxsysc.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/rtl/linux/bunxsysc.inc
 
1
{
 
2
    This file is part of the Free Pascal run time library.
 
3
    Copyright (c) 2002 by Marco van de Voort
 
4
 
 
5
    Calls needed for the baseunix unit, but not for system.
 
6
    Some calls that can be used for both Linux and *BSD will be
 
7
    moved to a /unix/ includedfile later.
 
8
 
 
9
    See the file COPYING.FPC, included in this distribution,
 
10
    for details about the copyright.
 
11
 
 
12
    This program is distributed in the hope that it will be useful,
 
13
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
 
 
16
 **********************************************************************}
 
17
 
 
18
Function fpKill(Pid:pid_t;Sig:cint):cint;
 
19
{
 
20
  Send signal 'sig' to a process, or a group of processes.
 
21
  If Pid >  0 then the signal is sent to pid
 
22
     pid=-1                         to all processes except process 1
 
23
     pid < -1                         to process group -pid
 
24
  Return value is zero, except for case three, where the return value
 
25
  is the number of processes to which the signal was sent.
 
26
}
 
27
 
 
28
begin
 
29
 fpkill:=do_syscall(syscall_nr_kill,TSysParam(pid),TSysParam(sig));
 
30
// if kill<0 THEN
 
31
//  Kill:=0;
 
32
end;
 
33
 
 
34
Function fpSigPending(var nset: TSigSet):cint;
 
35
{
 
36
  Allows examination of pending signals. The signal mask of pending
 
37
  signals is set in SSet
 
38
}
 
39
begin
 
40
  fpsigpending:=do_syscall(syscall_nr_rt_sigpending,TSysParam(@nset));
 
41
end;
 
42
 
 
43
function fpsigsuspend(const sigmask:TSigSet):cint;
 
44
{
 
45
 Set the signal mask with Mask, and suspend the program until a signal
 
46
 is received.
 
47
}
 
48
 
 
49
begin
 
50
  fpsigsuspend:= do_syscall(syscall_nr_rt_sigsuspend,TSysParam(@sigmask));
 
51
end;
 
52
 
 
53
Type
 
54
  ITimerVal= Record
 
55
              It_Interval,
 
56
              It_Value      : TimeVal;
 
57
             end;
 
58
 
 
59
Const   ITimer_Real    =0;
 
60
        ITimer_Virtual =1;
 
61
        ITimer_Prof    =2;
 
62
 
 
63
Function SetITimer(Which : Longint;Const value : ItimerVal; var VarOValue:ItimerVal):Longint;
 
64
 
 
65
Begin
 
66
  SetItimer:=Do_Syscall(syscall_nr_setitimer,Which,TSysParam(@Value),TSysParam(@varovalue));
 
67
End;
 
68
 
 
69
Function GetITimer(Which : Longint;Var value : ItimerVal):Longint;
 
70
 
 
71
Begin
 
72
  GetItimer:=Do_Syscall(syscall_nr_getItimer,Which,TSysParam(@value));
 
73
End;
 
74
 
 
75
Function fpalarm(Seconds: cuint):cuint;
 
76
 
 
77
Var it,oitv : Itimerval;
 
78
    retval  : cuint;
 
79
 
 
80
Begin
 
81
//      register struct itimerval *itp = &it;
 
82
 
 
83
 it.it_interval.tv_sec:=0;
 
84
 it.it_interval.tv_usec:=0;
 
85
 it.it_value.tv_usec:=0;
 
86
 it.it_value.tv_sec:=seconds;
 
87
 If SetITimer(ITIMER_REAL,it,oitv)<0 Then
 
88
   Exit(0);                     // different from *BSD!
 
89
 
 
90
 retval:= oitv.it_value.tv_usec;
 
91
 if retval<>0 Then
 
92
   inc(retval);
 
93
 fpAlarm:=retval;
 
94
End;
 
95
 
 
96
// The following versions are for internal use _ONLY_
 
97
// This because it works for the first 32 signals _ONLY_, but that
 
98
// is enough since they are depreciated, and for legacy applications
 
99
// anyway.
 
100
 
 
101
function sigblock(mask:cuint):cint;
 
102
 
 
103
var nset,oset: TSigSet;
 
104
 
 
105
begin
 
106
 fpsigemptyset(nset);
 
107
 // fpsigaddset(nset,mask);   needs _mask_
 
108
 nset[0]:=mask;
 
109
 sigblock:= fpsigprocmask(SIG_BLOCK,@nset,@oset);   // SIG_BLOCK=1
 
110
 if sigblock=0 Then
 
111
  sigblock:=oset[0];
 
112
end;
 
113
 
 
114
function sigpause(sigmask:cint):cint;
 
115
 
 
116
var nset: TSigSet;
 
117
 
 
118
begin
 
119
 fpsigemptyset(nset);
 
120
 nset[0]:=sigmask;
 
121
 sigpause:= fpsigsuspend(nset);
 
122
end;
 
123
 
 
124
function fppause:cint;
 
125
 
 
126
begin
 
127
  fppause:=sigpause(sigblock(cuint(0)));
 
128
end;
 
129
 
 
130
function fpsleep(seconds:cuint):cuint;
 
131
{see comments in libc}
 
132
 
 
133
var time_to_sleep,time_remaining : timespec;
 
134
    nset,oset  : TSigSet;
 
135
    oerrno     : cint;
 
136
    oact       : sigactionrec;
 
137
 
 
138
begin
 
139
        time_to_sleep.tv_sec := seconds;
 
140
        time_to_sleep.tv_nsec := 0;
 
141
         fpsigemptyset(nset);
 
142
         fpsigaddset  (nset,SIGCHLD);
 
143
         if fpsigprocmask(SIG_BLOCK,@nset,@oset)=-1 Then
 
144
          exit(cuint(-1));
 
145
        if fpsigismember(oset,SIGCHLD)<>0 Then
 
146
          Begin
 
147
            fpsigemptyset(nset);
 
148
            fpsigaddset  (nset,SIGCHLD);
 
149
            if fpsigaction(SIGCHLD,NIL,@oact)<0 Then
 
150
              begin
 
151
                oerrno:=fpgeterrno;
 
152
                fpsigprocmask(SIG_SETMASK,@oset,NIL);
 
153
                fpseterrno(oerrno);
 
154
                exit(cuint(-1));
 
155
              End;
 
156
            if oact.sa_handler=SigActionhandler(SIG_IGN) Then
 
157
             Begin
 
158
               fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining);
 
159
               oerrno:=fpgeterrno;
 
160
               fpsigprocmask(SIG_SETMASK,@oset,NIL);
 
161
               fpseterrno(oerrno);
 
162
             End
 
163
            Else
 
164
             Begin
 
165
               fpsigprocmask(SIG_SETMASK,@oset,NIL);
 
166
               fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining)
 
167
             End;
 
168
          end
 
169
        else
 
170
            fpsleep:=fpnanosleep(@time_to_sleep, @time_remaining);
 
171
        if fpsleep<>0 Then
 
172
         if time_remaining.tv_nsec>=500000000 Then
 
173
          inc(fpsleep);
 
174
End;
 
175
 
 
176
function fpuname(var name:utsname):cint; [public,alias:'FPC_SYSC_UNAME'];
 
177
 
 
178
begin
 
179
  fpuname:=Do_Syscall(syscall_nr_uname,TSysParam(@name));
 
180
end;
 
181
 
 
182
Function fpGetDomainName(Name:PChar; NameLen:size_t):cint;
 
183
 
 
184
Var
 
185
        srec  : utsname;
 
186
        tsize : size_t;
 
187
Begin
 
188
        if fpuname(srec)<0 Then
 
189
          exit(-1);
 
190
        tsize:=strlen(@srec.domain[0]);
 
191
        if tsize>(namelen-1) Then
 
192
         tsize:=namelen-1;
 
193
        move(srec.domain[0],name[0],tsize);
 
194
        name[namelen-1]:=#0;
 
195
        fpgetDomainName:=0;
 
196
End;
 
197
 
 
198
function fpGetHostName(Name:PChar; NameLen:size_t):cint;
 
199
 
 
200
Var
 
201
        srec  : utsname;
 
202
        tsize : size_t;
 
203
begin
 
204
        if fpuname(srec)<0 Then
 
205
          exit(-1);
 
206
        tsize:=strlen(@srec.nodename[0]);
 
207
        if tsize>(namelen-1) Then
 
208
         tsize:=namelen-1;
 
209
        move(srec.nodename[0],name[0],tsize);
 
210
        name[namelen-1]:=#0;
 
211
        fpgethostName:=0;
 
212
End;
 
213
 
 
214
const WAIT_ANY = -1;
 
215
 
 
216
function fpwait(var stat_loc:cint): pid_t;
 
217
{
 
218
  Waits until a child with PID Pid exits, or returns if it is exited already.
 
219
  Any resources used by the child are freed.
 
220
  The exit status is reported in the adress referred to by Status. It should
 
221
  be a longint.
 
222
}
 
223
 
 
224
begin // actually a wait4() call with 4th arg 0.
 
225
 fpWait:=do_syscall(syscall_nr_Wait4,WAIT_ANY,TSysParam(@Stat_loc),0,0);
 
226
end;
 
227
 
 
228
//function fpgetpid : pid_t;
 
229
 
 
230
// begin
 
231
//  fpgetpid:=do_syscall(syscall_nr_getpid);
 
232
// end;
 
233
 
 
234
function fpgetppid : pid_t;
 
235
 
 
236
begin
 
237
 fpgetppid:=do_syscall(syscall_nr_getppid);
 
238
end;
 
239
 
 
240
function fpgetuid : uid_t;
 
241
 
 
242
begin
 
243
 fpgetuid:=do_syscall(syscall_nr_getuid);
 
244
end;
 
245
 
 
246
function fpgeteuid : uid_t;
 
247
 
 
248
begin
 
249
 fpgeteuid:=do_syscall(syscall_nr_geteuid);
 
250
end;
 
251
 
 
252
function fpgetgid : gid_t;
 
253
 
 
254
begin
 
255
 fpgetgid:=do_syscall(syscall_nr_getgid);
 
256
end;
 
257
 
 
258
function fpgetegid : gid_t;
 
259
 
 
260
begin
 
261
 fpgetegid:=do_syscall(syscall_nr_getegid);
 
262
end;
 
263
 
 
264
function fpsetuid(uid : uid_t): cint;
 
265
 
 
266
begin
 
267
 fpsetuid:=do_syscall(syscall_nr_setuid,uid);
 
268
end;
 
269
 
 
270
function fpsetgid(gid : gid_t): cint;
 
271
 
 
272
begin
 
273
 fpsetgid:=do_syscall(syscall_nr_setgid,gid);
 
274
end;
 
275
 
 
276
// type tgrparr=array[0..0] of gid_t;
 
277
 
 
278
function fpgetgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
 
279
 
 
280
begin
 
281
 fpgetgroups:=do_syscall(syscall_nr_getgroups,gidsetsize,TSysParam(@grouplist));
 
282
end;
 
283
 
 
284
function fpgetpgrp : pid_t;
 
285
 
 
286
begin
 
287
 fpgetpgrp:=do_syscall(syscall_nr_getpgrp);
 
288
end;
 
289
 
 
290
function fpsetsid : pid_t;
 
291
 
 
292
begin
 
293
 fpsetsid:=do_syscall(syscall_nr_setsid);
 
294
end;
 
295
 
 
296
Function fpumask(cmask:mode_t):mode_t;
 
297
{
 
298
  Sets file creation mask to (Mask and 0777 (octal) ), and returns the
 
299
  previous value.
 
300
}
 
301
begin
 
302
 fpumask:=Do_syscall(syscall_nr_umask,cmask);
 
303
end;
 
304
 
 
305
Function fplink(existing:pchar;newone:pchar):cint;
 
306
{
 
307
  Proceduces a hard link from new to old.
 
308
  In effect, new will be the same file as old.
 
309
}
 
310
begin
 
311
  fpLink:=Do_Syscall(syscall_nr_link,TSysParam(existing),TSysParam(newone));
 
312
end;
 
313
 
 
314
Function fpmkfifo(path:pchar;mode:mode_t):cint;
 
315
 
 
316
begin
 
317
 
 
318
fpmkfifo:=do_syscall(syscall_nr_mknod,TSysParam(path),TSysParam(mode or S_IFIFO),TSysParam(0));
 
319
end;
 
320
 
 
321
Function fpchmod(path:pchar;mode:mode_t):cint;
 
322
 
 
323
begin
 
324
  fpchmod:=do_syscall(syscall_nr_chmod,TSysParam(path),TSysParam(mode));
 
325
end;
 
326
 
 
327
Function fpchown(path:pchar;owner:uid_t;group:gid_t):cint;
 
328
 
 
329
begin
 
330
  fpChOwn:=do_syscall(syscall_nr_chown,TSysParam(path),TSysParam(owner),TSysParam(group));
 
331
end;
 
332
 
 
333
Function fpUtime(path:pchar;times:putimbuf):cint;
 
334
 
 
335
begin
 
336
 fputime:=do_syscall(syscall_nr_utime,TSysParam(path),TSysParam(times));
 
337
end;
 
338
 
 
339
 
 
340
{$ifndef FPC_BASEUNIX_HAS_FPPIPE}
 
341
Function fppipe(var fildes : tfildes):cint;
 
342
 
 
343
begin
 
344
 fppipe:=do_syscall(syscall_nr_pipe,TSysParam(@fildes));
 
345
end;
 
346
{$endif FPC_BASEUNIX_HAS_FPPIPE}
 
347
 
 
348
 
 
349
function fpfcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
 
350
 
 
351
begin
 
352
 fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,arg);
 
353
end;
 
354
 
 
355
function fpfcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
 
356
 
 
357
begin
 
358
 fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,TSysParam(@arg));
 
359
end;
 
360
 
 
361
function fpfcntl(fildes:cint;Cmd:cint):cint;
 
362
 
 
363
begin
 
364
 fpfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd);
 
365
end;
 
366
 
 
367
function fpexecve(path:pchar;argv:ppchar;envp:ppchar):cint;
 
368
 
 
369
Begin
 
370
  fpexecve:=do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(argv),TSysParam(envp));
 
371
End;
 
372
 
 
373
function fpexecv(path:pchar;argv:ppchar):cint;
 
374
 
 
375
Begin
 
376
  fpexecv:=do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(argv),TSysParam(envp));
 
377
End;
 
378
 
 
379
function fptimes(var buffer : tms):clock_t;
 
380
begin
 
381
  fptimes:=Do_syscall(syscall_nr_times,TSysParam(@buffer));
 
382
end;
 
383
 
 
384
Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint;
 
385
{
 
386
  Select checks whether the file descriptor sets in readfs/writefs/exceptfs
 
387
  have changed.
 
388
}
 
389
 
 
390
begin
 
391
{$ifdef cpux86_64}
 
392
  {$define bunxfunc_fpselect_implemented}
 
393
  fpSelect:=do_syscall(syscall_nr_select,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
 
394
{$else}
 
395
  {$define bunxfunc_fpselect_implemented}
 
396
  fpSelect:=do_syscall(syscall_nr__newselect,n,tsysparam(readfds),tsysparam(writefds),tsysparam(exceptfds),tsysparam(timeout));
 
397
{$endif}
 
398
{$ifndef bunxfunc_fpselect_implemented}
 
399
  {$error Implement fpselect}
 
400
{$endif bunxfunc_fpselect_implemented}
 
401
end;
 
402
 
 
403
Function fpLstat(path:pchar;Info:pstat):cint;
 
404
{
 
405
  Get all information on a link (the link itself), and return it in info.
 
406
}
 
407
 
 
408
begin
 
409
 fpLStat:=do_syscall(
 
410
{$ifdef cpux86_64}
 
411
    syscall_nr_lstat,
 
412
{$else}
 
413
    syscall_nr_lstat64,
 
414
{$endif}
 
415
    TSysParam(path),TSysParam(info));
 
416
end;
 
417
 
 
418
Function fpLstat(Filename: ansistring;Info:pstat):cint;
 
419
{
 
420
  Get all information on a link (the link itself), and return it in info.
 
421
}
 
422
 
 
423
begin
 
424
 fpLStat:=do_syscall(
 
425
{$ifdef cpux86_64}
 
426
    syscall_nr_lstat,
 
427
{$else}
 
428
    syscall_nr_lstat64,
 
429
{$endif}
 
430
    TSysParam(pchar(filename)),TSysParam(info));
 
431
end;
 
432
 
 
433
 
 
434
function fpNice(N:cint):cint;
 
435
{
 
436
  Set process priority. A positive N means a lower priority.
 
437
  A negative N increases priority.
 
438
 
 
439
Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
 
440
}
 
441
 
 
442
{$ifdef cpux86_64}
 
443
var
 
444
  oldprio : cint;
 
445
{$endif}
 
446
begin
 
447
{$ifdef cpux86_64}
 
448
  oldprio:=fpGetPriority(Prio_Process,0);
 
449
  fpNice:=fpSetPriority(Prio_Process,0,oldprio+N);
 
450
  if fpNice=0 then
 
451
    fpNice:=fpGetPriority(Prio_Process,0);
 
452
{$else}
 
453
  fpNice:=do_syscall(Syscall_nr_nice,N);
 
454
{$endif}
 
455
end;
 
456
 
 
457
Function fpGetPriority(Which,Who:cint):cint;
 
458
{
 
459
  Get Priority of process, process group, or user.
 
460
   Which : selects what kind of priority is used.
 
461
           can be one of the following predefined Constants :
 
462
              Prio_User.
 
463
              Prio_PGrp.
 
464
              Prio_Process.
 
465
   Who : depending on which, this is , respectively :
 
466
              Uid
 
467
              Pid
 
468
              Process Group id
 
469
   Errors are reported in linuxerror _only_. (priority can be negative)
 
470
}
 
471
begin
 
472
  if (which<prio_process) or (which>prio_user) then
 
473
   begin
 
474
     { We can save an interrupt here }
 
475
     fpgetpriority:=-1;
 
476
     fpsetErrno(ESysEinval);
 
477
   end
 
478
  else
 
479
     fpGetPriority:=do_syscall(syscall_nr_GetPriority,which,who);
 
480
end;
 
481
 
 
482
Function fpSetPriority(Which,Who,What:cint):cint;
 
483
{
 
484
 Set Priority of process, process group, or user.
 
485
   Which : selects what kind of priority is used.
 
486
           can be one of the following predefined Constants :
 
487
              Prio_User.
 
488
              Prio_PGrp.
 
489
              Prio_Process.
 
490
   Who : depending on value of which, this is, respectively :
 
491
              Uid
 
492
              Pid
 
493
              Process Group id
 
494
   what : A number between -20 and 20. -20 is most favorable, 20 least.
 
495
          0 is the default.
 
496
}
 
497
begin
 
498
  if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
 
499
   fpseterrno(ESyseinval)  { We can save an interrupt here }
 
500
  else
 
501
   begin
 
502
     fpSetPriority:=do_syscall(Syscall_nr_Setpriority,which,who,what);
 
503
   end;
 
504
end;
 
505
 
 
506
 
 
507
Function fpSymlink(oldname,newname:pchar):cint;
 
508
{
 
509
  We need this for erase
 
510
}
 
511
 
 
512
begin
 
513
  fpsymlink:=do_syscall(syscall_nr_symlink,TSysParam(oldname),TSysParam(newname));
 
514
end;
 
515
 
 
516
function Fppread(fd: cint; buf: pchar; nbytes : size_t; offset:Toff): ssize_t; [public, alias : 'FPC_SYSC_PREAD'];
 
517
 
 
518
begin
 
519
  
 
520
        {$ifdef CPU64}
 
521
            Fppread:=do_syscall(syscall_nr_pread64,Fd,TSysParam(buf),nbytes,TSysParam(OffSet));
 
522
        {$else}
 
523
           Fppread:=do_syscall(syscall_nr_pread,Fd,TSysParam(buf),nbytes,
 
524
             {$ifdef FPC_BIG_ENDIAN}    hi(offset),lo(offset){$endif}
 
525
             {$ifdef FPC_LITTLE_ENDIAN} lo(offset),hi(offset){$endif}
 
526
            );
 
527
        {$endif}
 
528
end;
 
529
 
 
530
function Fppwrite(fd: cint;buf:pchar; nbytes : size_t; offset:Toff): ssize_t; [public, alias : 'FPC_SYSC_PWRITE'];
 
531
 
 
532
begin
 
533
        {$ifdef CPU64}
 
534
           Fppwrite:=do_syscall(syscall_nr_pwrite64,Fd,TSysParam(buf),nbytes,TSysParam(OffSet));
 
535
        {$else}
 
536
           Fppwrite:=do_syscall(syscall_nr_pwrite,Fd,TSysParam(buf),nbytes,
 
537
             {$ifdef FPC_BIG_ENDIAN}    hi(offset),lo(offset){$endif}
 
538
             {$ifdef FPC_LITTLE_ENDIAN} lo(offset),hi(offset){$endif}
 
539
            );
 
540
        {$endif}
 
541
end;
 
542
 
 
543
function Fpreadv(fd: cint; const iov : piovec; iovcnt : cint):ssize_t; [public, alias : 'FPC_SYSC_READV'];
 
544
 
 
545
begin
 
546
  Fpreadv:=do_syscall(syscall_nr_readv,Fd,TSysParam(iov),iovcnt);
 
547
end;
 
548
 
 
549
function Fpwritev(fd: cint; const iov : piovec; iovcnt : cint):ssize_t;  [public, alias : 'FPC_SYSC_WRITEV'];
 
550
 
 
551
begin
 
552
  Fpwritev:=do_syscall(syscall_nr_writev,Fd,TSysParam(iov),iovcnt);
 
553
end;
 
554