← Back to branch summary

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

« back to all changes in this revision

Viewing changes to rtl/sunos/unixsysc.inc

  • 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/sunos/unixsysc.inc
1
 
{
2
 
   $Id: unixsysc.inc,v 1.3 2002/09/07 16:01:26 peter Exp $
3
 
   This file is part of the Free Pascal run time library.
4
 
   Copyright (c) 1999-2000 by Michael Van Canneyt,
5
 
     member of the Free Pascal development team.
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
 
**********************************************************************}
15
 
 
16
 
//- libc funktions
17
 
const _MKNOD_VER=2;
18
 
 
19
 
Function cFork:longint;cdecl; external name 'fork1'; // fork1 is better here then fork
20
 
Procedure cExecve(path:pchar;args:ppchar;ep:ppchar); cdecl; external name 'execve';
21
 
Function cWaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; cdecl; external name 'waitpid';
22
 
Function cGetTimeOfDay(var tv:timeval;var tz:timezone):integer;cdecl;external name 'gettimeofday';
23
 
Function cNice(n:LongInt):LongInt; cdecl; external name 'nice';
24
 
Function cGetPid:LongInt;cdecl; external name 'getpid';
25
 
Function cGetPPid:LongInt;cdecl; external name 'getppid';
26
 
Function cGetUid:Longint;cdecl; external name 'getuid';
27
 
Function cGetEUid:Longint;cdecl; external name 'geteuid';
28
 
Function cGetGid:Longint;cdecl; external name 'getgid';
29
 
Function cGetEGid:Longint;cdecl; external name 'getgid';
30
 
Function cSetUid(aUID:longint):longint;cdecl; external name 'setuid';
31
 
Function cSetGid(aGID:longint):longint;cdecl; external name 'setuid';
32
 
function cSetreUid(aRealUID,aEffUid:Longint):Longint; cdecl; external name 'setreuid';
33
 
function cSetreGid(aRealGID,aEffGid:Longint):Longint; cdecl; external name 'setreuid';
34
 
Function cfTruncate(fd,size:longint):Longint;cdecl; external name 'ftruncate';
35
 
Function cfSync (fd : Longint) : Longint; cdecl; external name 'fsync';
36
 
Function cChmod(path:pathstr;Newmode:longint):Longint; cdecl; external name 'chmod';
37
 
Function cChown(path:pathstr;NewUid,NewGid:longint):Longint;cdecl; external name 'chown';
38
 
Function cUmask(Mask:Longint):Longint;cdecl;external name 'umask';
39
 
//Function  cFlock (fd,mode : longint) : longint; cdecl; external name 'flock';
40
 
Function cDup(oldfile:longint):longint;cdecl;external name 'dup';
41
 
Function cDup2(oldfile,newfile:longint):longint;cdecl;external name 'dup2';
42
 
Function cGetPriority(Which,Who:LongInt):LongInt;cdecl; external name 'getpriority';
43
 
Function cSetPriority(Which:LongInt;Who:LongInt;What:LongInt):LongInt;cdecl; external name 'setpriority';
44
 
Function cFcntl(Fd:longint;Cmd:LongInt):LongInt;cdecl;external name 'fcntl';
45
 
Function cFcntlArg(Fd:longint;Cmd:LongInt; arg:LongInt):LongInt;cdecl;external name 'fcntl';
46
 
Function cAccess(Path:pCHar; mode:LongInt):LongInt; cdecl; external name 'access';
47
 
Function cPipe(var pip:tpipe):LongInt; cdecl; external name 'pipe';
48
 
Function cUtime(path:pchar; var utim:utimebuf):LongInt; cdecl; external name 'utime';
49
 
Function cSelect(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):LongInt;cdecl; external name 'select';
50
 
Function cKill(Pid:longint;Sig:longint):LongINt;cdecl; external name 'kill';
51
 
Function cIOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; cdecl; external name 'ioctl';
52
 
Function cAlarm(Sec : Longint) : longint;cdecl; external name 'alarm';
53
 
Function cmknod(Vers:LongInt;pathname:pchar;mode,dev:longint):longint; cdecl; external name '_xmknod';
54
 
Function clStat(Vers:LongInt; Filename:pchar;var Buffer: Stat):longint; cdecl; external name '_lxstat';
55
 
Function cfStatfs(fd:LongInt; var Info:StatFs):LongInt; cdecl; external name 'fstatvfs';
56
 
Function cStatfs(Filename:pchar;var Buffer: StatFs):longint; cdecl; external name 'statvfs';
57
 
function cMUnMap(p:pointer;size:longint):integer;cdecl;external name 'munmap';
58
 
function cNanoSleep(const req : timespec;var rem : timespec) : longint; cdecl;external name 'nanosleep';
59
 
function cPause:longint; cdecl; external name 'pause';
60
 
function cSigProcMask(How:longint;SSet,OldSSet:PSigSet):longint; cdecl; external name 'sigprocmask';
61
 
function cSigPending(var s:SigSet):integer;cdecl; external name 'sigpending';
62
 
function cSigSuspend(s:PSigSet):longint;cdecl;external name 'sigsuspend';
63
 
function _cSignal(Signum:longint;Handler:Longint):SignalHandler; cdecl; external name 'signal';
64
 
function cSysInfo(cmd:longint; buff:pchar; len:longint):longint; cdecl; external name 'sysinfo';
65
 
{$LinkLib rt} // nanosleep
66
 
 
67
 
procedure libcerrorfix(fl:boolean); inline;
68
 
 
69
 
begin
70
 
 if fl then
71
 
  begin
72
 
   Linuxerror:=libcerrno;
73
 
   errno:=liberrno;
74
 
  end
75
 
 else
76
 
  begin
77
 
    Linuxerror:=0;
78
 
    ErrNo:=0;
79
 
  end;
80
 
end;
81
 
 
82
 
 
83
 
Function Fork:longint;
84
 
{
85
 
  This function issues the 'fork' System call. the program is duplicated in memory
86
 
  and Execution continues in parent and child process.
87
 
  In the parent process, fork returns the PID of the child. In the child process,
88
 
  zero is returned.
89
 
  A negative value indicates that an error has occurred, the error is returned in
90
 
  LinuxError.
91
 
}
92
 
var     r       : LongInt;
93
 
begin
94
 
  r:=cFork; Fork:=r;
95
 
  libcerrorfix((r=-1));
96
 
end;
97
 
 
98
 
{ Solaris has no clone, there thread funktion (libthread), like thr_create, but they haven't
99
 
the same options with flags and return a TID istead of a PID.
100
 
If one is interestet he might look to a Hack for lxrun which is contributed as diff.
101
 
Allthough the lxrun-hack dos not work at all, it shows what to take care of }
102
 
 
103
 
function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
104
 
var     pid     : Longint;
105
 
begin // Quick Hack, never tested, but should work if func does not believe on the Stack
106
 
  if (pointer(func)=nil) or (sp=nil) then
107
 
   begin
108
 
     LinuxError:=Sys_EInval;
109
 
     Errno:=sys_einval;
110
 
     exit(-1);
111
 
   end;
112
 
  pid:=fork;
113
 
  if (pid=0) then begin //Child
114
 
    func(args) ;
115
 
    ExitProcess(0);
116
 
   end;
117
 
  clone:=pid;
118
 
end;
119
 
 
120
 
 
121
 
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
122
 
{
123
 
  Replaces the current program by the program specified in path,
124
 
  arguments in args are passed to Execve.
125
 
  environment specified in ep is passed on.
126
 
}
127
 
begin
128
 
  cExecve(path,args,ep);
129
 
{ This only gets set when the call fails, otherwise we don't get here ! }
130
 
  Linuxerror:=libcerrno;
131
 
  errno:=libcerrno;
132
 
end;
133
 
 
134
 
 
135
 
Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
136
 
{
137
 
  Replaces the current program by the program specified in path,
138
 
  arguments in args are passed to Execve.
139
 
  environment specified in ep is passed on.
140
 
}
141
 
begin
142
 
  path:=path+#0; cExecve(@path[1],args,ep);
143
 
{ This only gets set when the call fails, otherwise we don't get here ! }
144
 
  Linuxerror:=libcerrno;
145
 
  errno:=libcerrno;
146
 
end;
147
 
 
148
 
 
149
 
Procedure ExitProcess(val:longint);external name '_exit'; // not 'exit' ('exit' close the shared handle)
150
 
 
151
 
 
152
 
Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;
153
 
{
154
 
  Waits until a child with PID Pid exits, or returns if it is exited already.
155
 
  Any resources used by the child are freed.
156
 
  The exit status is reported in the adress referred to by Status. It should
157
 
  be a longint.
158
 
}
159
 
begin
160
 
  WaitPid:=cWaitPid(Pid,Status,Options); { =>PID, -1+errno=eintr: Signal, -1+errno,  0=Ok }
161
 
  libcerrorfix(WaitPid=-1));
162
 
end;
163
 
 
164
 
 
165
 
 
166
 
Procedure GetTimeOfDay(var tv:timeval);
167
 
{
168
 
  Get the number of seconds since 00:00, January 1 1970, GMT
169
 
  the time NOT corrected any way
170
 
}
171
 
var     tz      : timezone;
172
 
        r       : Integer;
173
 
begin
174
 
  r:=cGetTimeOfDay(tv,tz);
175
 
  libcerrorfix (r=-1);
176
 
end;
177
 
 
178
 
Function GetTimeOfDay: longint;
179
 
{
180
 
  Get the number of seconds since 00:00, January 1 1970, GMT
181
 
  the time NOT corrected any way
182
 
}
183
 
var     tz      : timezone;
184
 
        tv      : timeval;
185
 
begin
186
 
  libcerrorfix(cGetTimeOfDay(tv,tz)=-1);
187
 
  GetTimeOfDay:=tv.sec;
188
 
end;
189
 
 
190
 
 
191
 
Function GetPriority(Which,Who:Integer):integer;
192
 
{
193
 
  Get Priority of process, process group, or user.
194
 
   Which : selects what kind of priority is used.
195
 
           can be one of the following predefined Constants :
196
 
              Prio_User.
197
 
              Prio_PGrp.
198
 
              Prio_Process.
199
 
   Who : depending on which, this is , respectively :
200
 
              Uid
201
 
              Pid
202
 
              Process Group id
203
 
   Errors are reported in linuxerror _only_. (priority can be negative)
204
 
}
205
 
begin
206
 
  errno:=0;
207
 
  if (which<prio_process) or (which>prio_user) then
208
 
   begin
209
 
     { We can save an interrupt here }
210
 
     getpriority:=0;
211
 
     linuxerror:=Sys_einval;
212
 
     Errno:=sys_einval;
213
 
   end
214
 
  else
215
 
   begin
216
 
     GetPriority:=cGetPriority(Which,Who);
217
 
     libcerrorfix(getpriority=-1);
218
 
   end;
219
 
end;
220
 
 
221
 
 
222
 
Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
223
 
{
224
 
 Set Priority of process, process group, or user.
225
 
   Which : selects what kind of priority is used.
226
 
           can be one of the following predefined Constants :
227
 
              Prio_User.
228
 
              Prio_PGrp.
229
 
              Prio_Process.
230
 
   Who : depending on value of which, this is, respectively :
231
 
              Uid
232
 
              Pid
233
 
              Process Group id
234
 
   what : A number between -20 and 20. -20 is most favorable, 20 least.
235
 
          0 is the default.
236
 
}
237
 
var     r       : Integer;
238
 
begin
239
 
  errno:=0;
240
 
  if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
241
 
   begin
242
 
   linuxerror:=Sys_einval  { We can save an interrupt here }
243
 
   errno:=libcerrno;
244
 
   end
245
 
  else
246
 
   begin
247
 
     r:=cSetPriority(Which,Who,What);
248
 
     libcerrorfix(r=-1);
249
 
   end;
250
 
end;
251
 
 
252
 
Procedure Nice(N:integer);
253
 
{
254
 
  Set process priority. A positive N means a lower priority.
255
 
  A negative N decreases priority.
256
 
}
257
 
begin
258
 
  libcerrorfix(cNice(n)=-1);
259
 
end;
260
 
 
261
 
 
262
 
Function GetPid:LongInt;
263
 
{
264
 
  Get Process ID.
265
 
}
266
 
begin
267
 
  GetPid:=cGetPid;
268
 
  libcerrorfix(GetPID=-1);
269
 
end;
270
 
 
271
 
Function GetPPid:LongInt;
272
 
{
273
 
  Get Process ID of parent process.
274
 
}
275
 
begin
276
 
  GetPPid:=cGetPPid;
277
 
  libcerrorfix(GetPPID=-1);
278
 
end;
279
 
 
280
 
 
281
 
Function GetUid:Longint;
282
 
{
283
 
  Get User ID.
284
 
}
285
 
begin
286
 
  GetUid:=cGetUid;
287
 
  libcerrorfix (GetUid=-1);
288
 
end;
289
 
 
290
 
 
291
 
Function GetEUid:Longint;
292
 
{
293
 
  Get _effective_ User ID.
294
 
}
295
 
begin
296
 
  GetEUid:=cGetEUid;
297
 
  libcerrorfix(GetEUid=-1);
298
 
end;
299
 
 
300
 
 
301
 
Function GetGid:Longint;
302
 
{
303
 
  Get Group ID.
304
 
}
305
 
begin
306
 
  GetGid:=cGetGid;
307
 
  libcerrorfix(GetGid=-1);
308
 
end;
309
 
 
310
 
Function GetEGid:Longint;
311
 
{
312
 
  Get _effective_ Group ID.
313
 
}
314
 
begin
315
 
  GetEGid:=cGetEGid;
316
 
  libcerrorfix (GetEGid=-1);
317
 
end;
318
 
 
319
 
// Set the real userid/groupid (uid/gid from calling process)
320
 
function SetUid(aUID:Longint):Boolean;
321
 
begin
322
 
  SetUid:=(cSetUid(aUid)=0);
323
 
  libcerrorfix( not(SetUid));
324
 
end;
325
 
 
326
 
function SetGid(aGID:Longint):Boolean;
327
 
begin
328
 
  SetGid:=(cSetGid(aGid)=0);
329
 
  libcerrorfix( not(SetGid));
330
 
end;
331
 
 
332
 
// Set the real and effective userid/groupid (like setuid/setgid bit in file permissions)
333
 
function SetreUid(aRealUID,aEffUid:Longint):Boolean;
334
 
begin
335
 
  SetreUid:=(cSetreUid(aRealUID,aEffUID)=0);
336
 
  libcerrorfix( not(SetreUid));
337
 
end;
338
 
 
339
 
function SetreUid(aUID:Longint):Boolean;
340
 
 begin
341
 
   SetreUid:=SetreUid(aUID,aUID);
342
 
 end;
343
 
 
344
 
function SetreGid(aRealGid,aEffGid:Longint):Boolean; overload;
345
 
begin
346
 
  SetreGid:=(cSetreUid(aRealGID,aEffGID)=0);
347
 
  libcerrorfix(not(SetreGid));
348
 
end;
349
 
 
350
 
function SetreGid(aGid:Longint):Boolean;overload;
351
 
begin
352
 
  SetreGid:=SetreGid(aGID,aGID);
353
 
end;
354
 
 
355
 
Function fdTruncate(fd,size:longint):boolean;
356
 
begin
357
 
  fdTruncate:=cfTruncate(fd,size)<>-1;
358
 
  libcerrorfix(not fdTruncate);
359
 
end;
360
 
 
361
 
Function  fdFlush (fd : Longint) : Boolean;
362
 
begin
363
 
  fdFlush:=cfSync(fd)<>-1;
364
 
  libcerrorfix( not fdFlush);
365
 
end;
366
 
 
367
 
Function Fcntl(Fd:longint;Cmd:integer):integer;
368
 
{
369
 
  Read or manipulate a file.(See also fcntl (2) )
370
 
  Possible values for Cmd are :
371
 
    F_GetFd,F_GetFl,F_GetOwn F_DUPFd, F_Dup2FD...
372
 
  Errors are reported in Linuxerror;
373
 
  If Cmd is different from the allowed values, linuxerror=Sys_eninval.
374
 
}
375
 
begin
376
 
  // the retun is not compatible to the linux-definition (returning 0 on -1 (err)), but 0 may be a valid return
377
 
  if (cmd in [F_GetFd,F_GetFl,F_GetOwn, {solaris:} F_DupFd]) then
378
 
   begin
379
 
     Fcntl:=cFcntl(fd,Cmd);
380
 
     libcerrorfix(Fcntl=-1);
381
 
   end
382
 
  else
383
 
   begin
384
 
     linuxerror:=Sys_einval;
385
 
     Errno:=sys_einval;
386
 
     Fcntl:=-1;
387
 
   end;
388
 
end;
389
 
 
390
 
Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
391
 
{
392
 
  Read or manipulate a file. (See also fcntl (2) )
393
 
  Possible values for Cmd are :
394
 
    F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
395
 
  Errors are reported in Linuxerror;
396
 
  If Cmd is different from the allowed values, linuxerror=Sys_eninval.
397
 
  F_DupFD is not allowed, due to the structure of Files in Pascal.
398
 
}
399
 
 
400
 
begin
401
 
  if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn {Solaris:} ,F_Dup2Fd,F_FreeSp{,F_GetLk64,F_SetLk64,F_SetLkw64}]) then
402
 
   begin
403
 
     libcerrorfix( cFcntlArg(fd,Cmd,Arg)=-1);
404
 
   end
405
 
  else begin
406
 
   linuxerror:=Sys_einval;
407
 
   errno:=sys_einval;
408
 
  end;
409
 
end;
410
 
 
411
 
 
412
 
Function Chmod(path:pathstr;Newmode:longint):Boolean;
413
 
{
414
 
  Changes the permissions of a file.
415
 
}
416
 
begin
417
 
  Chmod:=cChmod(path,NewMode)=0;
418
 
  libcerrorfix( not Chmod);
419
 
end;
420
 
 
421
 
 
422
 
Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
423
 
{
424
 
  Change the owner and group of a file.
425
 
  A user can only change the group to a group of which he is a member.
426
 
  The super-user can change uid and gid of any file.
427
 
}
428
 
begin
429
 
  Chown:=cChown(path,NewUid,NewGid)=0;
430
 
  libcerrorfix(not Chown);
431
 
end;
432
 
 
433
 
 
434
 
Function Utime(path:pathstr;utim:utimebuf):boolean;
435
 
begin
436
 
  path:=path+#0;
437
 
  UTime:=cUtime(@Path[1],utim)=0;
438
 
  libcerrorfix( not UTime);
439
 
end;
440
 
 
441
 
 
442
 
Function  Flock (fd,mode : longint) : boolean;
443
 
begin
444
 
  FLock:=TRUE;
445
 
//  FLock:=cFLock(fd,mode)=0;
446
 
  libcerrorfix(not FLock);
447
 
end;
448
 
 
449
 
 
450
 
 
451
 
Function Fstat(Fd:Longint;var Info:stat):Boolean;
452
 
{
453
 
  Get all information on a file descriptor, and return it in info.
454
 
}
455
 
begin
456
 
  FStat:=Sys_fstat(fd,Info)=0;
457
 
  libcerrorfix( not FStat);
458
 
end;
459
 
 
460
 
 
461
 
Function Lstat(Filename: PathStr;var Info:stat):Boolean;
462
 
{
463
 
  Get all information on a link (the link itself), and return it in info.
464
 
}
465
 
begin
466
 
  FileName:=FileName+#0;
467
 
  LStat:=clstat(STAT_VERS,@FileName[1],Info)=0;
468
 
  libcerrorfix( not LStat);
469
 
end;
470
 
 
471
 
 
472
 
 
473
 
Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
474
 
{
475
 
  Get all information on a fileSystem, and return it in Info.
476
 
  Path is the name of a file/directory on the fileSystem you wish to
477
 
  investigate.
478
 
}
479
 
begin
480
 
  path:=path+#0;
481
 
  FSStat:=cstatfs(@path[1],Info)=0;
482
 
  libcerrorfix(not FSStat);
483
 
end;
484
 
 
485
 
 
486
 
 
487
 
Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
488
 
{
489
 
  Get all information on a fileSystem, and return it in Info.
490
 
  Fd is the file descriptor of a file/directory on the fileSystem
491
 
  you wish to investigate.
492
 
}
493
 
begin
494
 
  FSStat:=cfstatfs(fd,Info)=0;
495
 
  libcerrorfix( not FSStat);
496
 
end;
497
 
 
498
 
 
499
 
 
500
 
Function Link(OldPath,NewPath:pathstr):boolean;
501
 
{
502
 
  Proceduces a hard link from new to old.
503
 
  In effect, new will be the same file as old.
504
 
}
505
 
begin
506
 
  OldPath:=OldPath+#0; NewPath:=NewPath+#0;
507
 
  Link:=Sys_SymLink(@OldPath[1],@NewPath[1])<>-1;
508
 
  libcerrorfix( not Link);
509
 
end;
510
 
 
511
 
 
512
 
Function Umask(Mask:Integer):integer;
513
 
{
514
 
  Sets file creation mask to (Mask and 0777 (octal) ), and returns the
515
 
  previous value.
516
 
}
517
 
begin
518
 
  Umask:=cUmask(Mask);
519
 
  libcerrorfix (Umask=-1);
520
 
end;
521
 
 
522
 
 
523
 
Function Access(Path:Pathstr ;mode:integer):boolean;
524
 
{
525
 
  Test users access rights on the specified file.
526
 
  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
527
 
  R,W,X stand for read,write and Execute access, simultaneously.
528
 
  F_OK checks whether the test would be allowed on the file.
529
 
  i.e. It checks the search permissions in all directory components
530
 
  of the path.
531
 
  The test is done with the real user-ID, instead of the effective.
532
 
  If access is denied, or an error occurred, false is returned.
533
 
  If access is granted, true is returned.
534
 
  Errors other than no access,are reported in linuxerror.
535
 
}
536
 
begin
537
 
  path:=path+#0;
538
 
  Access:=cAccess(@Path[1],mode)=0;
539
 
  libcerrorfix( not Access);
540
 
end;
541
 
 
542
 
Function  Dup(oldfile:longint;var newfile:longint):Boolean;
543
 
{
544
 
  Copies the filedescriptor oldfile to newfile
545
 
}
546
 
begin
547
 
  NewFile:=cDup(OldFile);
548
 
  Dup:=(NewFile<>-1);
549
 
  libcerrorfix( not Dup);
550
 
end;
551
 
 
552
 
Function Dup2(oldfile,newfile:longint):Boolean;
553
 
{
554
 
  Copies the filedescriptor oldfile to newfile
555
 
}
556
 
begin
557
 
  Dup2:=cDup2(OldFile,NewFile)<>-1;
558
 
  libcerrorfix( not Dup2);
559
 
end;
560
 
 
561
 
 
562
 
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
563
 
{
564
 
  Select checks whether the file descriptor sets in readfs/writefs/exceptfs
565
 
  have changed.
566
 
}
567
 
Var
568
 
  SelectArray : Array[1..5] of longint;
569
 
begin
570
 
  Select:=cSelect(N,readfds,writefds,exceptfds,TimeOut);
571
 
  libcerrorfix( Select=-1);
572
 
end;
573
 
 
574
 
Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
575
 
{
576
 
  Sets up a pair of file variables, which act as a pipe. The first one can
577
 
  be read from, the second one can be written to.
578
 
  If the operation was unsuccesful, linuxerror is set.
579
 
}
580
 
var
581
 
  pip  : tpipe;
582
 
begin
583
 
  AssignPipe:=cPipe(pip)=0;
584
 
  if AssignPipe then begin
585
 
    pipe_in:=pip[1];
586
 
    pipe_out:=pip[2];
587
 
    LinuxError:=0;
588
 
    Errno:=0;
589
 
   end
590
 
  else
591
 
   begin
592
 
    LinuxError:=libcErrNo;
593
 
    Errno:=libcerrno;
594
 
   end;
595
 
end;
596
 
 
597
 
Function PClose(Var F:text) :longint;
598
 
var
599
 
  pl : ^longint;
600
 
begin
601
 
  Sys_Close(Textrec(F).Handle);
602
 
{ closed our side, Now wait for the other - this appears to be needed ?? }
603
 
  pl:=@(textrec(f).userdata[2]);
604
 
  pclose:=WaitProcess(pl^);
605
 
end;
606
 
 
607
 
 
608
 
Function PClose(Var F:file) : longint;
609
 
var
610
 
  pl : ^longint;
611
 
begin
612
 
  Sys_Close(Filerec(F).Handle);
613
 
{ closed our side, Now wait for the other - this appears to be needed ?? }
614
 
  pl:=@(filerec(f).userdata[2]);
615
 
  pclose:=WaitProcess(pl^);
616
 
end;
617
 
 
618
 
 
619
 
Function Sysinfo(var Info:TSysinfo):Boolean; // ToDO
620
 
{
621
 
  Get system info
622
 
  (Mvdv:Linux specific, not implemented under FreeBSD too.
623
 
   Under FreeBSD I will simply implement a sysctl unit)
624
 
}
625
 
var
626
 
  regs : SysCallregs;
627
 
Begin
628
 
(*  regs.reg2:=longint(@info);
629
 
  Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;*)
630
 
  WriteLN('SysInfo not supported yet ');
631
 
End;
632
 
 
633
 
 
634
 
Function mkFifo(pathname:string;mode:longint):boolean;
635
 
begin
636
 
  pathname:=pathname+#0;
637
 
  mode:=mode or STAT_IFIFO;
638
 
  mkFifo:=cmknod(_MKNOD_VER,@pathname[1],mode,0)=0;
639
 
  libcerrorfix(not mkFifo);
640
 
end;
641
 
 
642
 
{
643
 
Function Uname(var unamerec:utsname):Boolean; // ToDo
644
 
{
645
 
  Get machine's names
646
 
}
647
 
var
648
 
  regs : SysCallregs;
649
 
Begin
650
 
  Errno:=0;
651
 
  cSysInfo(SI_SYSNAME,@unamerec.sysname,SizeOf(unamerec.sysname));
652
 
  cSysInfo(SI_HOSTNAME,@unamerec.nodename,SizeOf(unamerec.nodename));
653
 
  cSysInfo(SI_RELEASE,@unamerec.release,SizeOf(unamerec.release));
654
 
  cSysInfo(SI_VERSION,@unamerec.version,SizeOf(unamerec.version));
655
 
  cSysInfo(SI_MACHINE,@unamerec.machine,SizeOf(unamerec.machine));
656
 
  cSysInfo(SI_SRPC_DOMAIN,@unamerec.domainname,SizeOf(unamerec.domainname));
657
 
  LinuxError:=Errno;
658
 
End;
659
 
}
660
 
 
661
 
Function Kill(Pid:longint;Sig:longint):integer;
662
 
{
663
 
  Send signal 'sig' to a process, or a group of processes.
664
 
  If Pid >  0 then the signal is sent to pid
665
 
     pid=-1                         to all processes except process 1
666
 
     pid < -1                         to process group -pid
667
 
  Return value is zero, except for case three, where the return value
668
 
  is the number of processes to which the signal was sent.
669
 
}
670
 
begin
671
 
  Kill:=cKill(PID,Sig);
672
 
  libcerrorfix( Kill=-1);
673
 
  if kill<0 then Kill:=0; // from the linux source
674
 
end;
675
 
 
676
 
 
677
 
 
678
 
Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet); //ToDo
679
 
{
680
 
  Change the list of currently blocked signals.
681
 
  How determines which signals will be blocked :
682
 
   SigBlock   : Add SSet to the current list of blocked signals
683
 
   SigUnBlock : Remove the signals in SSet from the list of blocked signals.
684
 
   SigSetMask : Set the list of blocked signals to SSet
685
 
  if OldSSet is non-null, the old set will be saved there.
686
 
}
687
 
begin
688
 
  libcerrorfix( cSigProcMask(How,SSet,OldSSet)=0);
689
 
end;
690
 
 
691
 
 
692
 
Function SigPending:SigSet;
693
 
{
694
 
  Allows examination of pending signals. The signal mask of pending
695
 
  signals is set in SSet
696
 
}
697
 
Var
698
 
  dummy : Sigset;
699
 
begin
700
 
  libcerrorfix(cSigPending(dummy)=0);
701
 
  Sigpending:=dummy;
702
 
end;
703
 
 
704
 
 
705
 
Procedure SigSuspend(Mask:Sigset); // ToDo
706
 
{
707
 
 Set the signal mask with Mask, and suspend the program until a signal
708
 
 is received.
709
 
}
710
 
begin
711
 
  libcerrorfix (cSigSuspend(@Mask)=0);
712
 
end;
713
 
 
714
 
Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
715
 
{
716
 
  Install a new handler for signal Signum.
717
 
  The old signal handler is returned.
718
 
  This call does, in fact, the same as SigAction.
719
 
}
720
 
var
721
 
  r :LongInt;
722
 
begin
723
 
  Signal:=NIL;
724
 
  r:=longint(_cSignal(Signum,longint(Handler)));
725
 
  if (r=-1) then begin
726
 
     Signal:=nil;
727
 
     LinuxError:=libcerrno;
728
 
     Errno:=libcerrno;
729
 
    end
730
 
   else
731
 
   begin
732
 
     Signal:=signalhandler(r);
733
 
     LinuxError:=0;
734
 
     ErrNo:=0;
735
 
    end;
736
 
  exit;
737
 
end;
738
 
 
739
 
 
740
 
Function  Alarm(Sec : Longint) : longint;
741
 
begin
742
 
  Alarm:=cAlarm(Sec);
743
 
  LinuxError:=0; // no error
744
 
  Errno:=0;
745
 
end;
746
 
 
747
 
Procedure Pause;
748
 
begin cPause;end;
749
 
 
750
 
 
751
 
Function NanoSleep(const req : timespec;var rem : timespec) : longint;
752
 
begin
753
 
  NanoSleep:=cNanoSleep(req,rem);
754
 
  Libcerrorfix( NanoSleep=-1);
755
 
end;
756
 
 
757
 
 
758
 
Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
759
 
{
760
 
  Interface to Unix ioctl call.
761
 
  Performs various operations on the filedescriptor Handle.
762
 
  Ndx describes the operation to perform.
763
 
  Data points to data needed for the Ndx function. The structure of this
764
 
  data is function-dependent.
765
 
}
766
 
begin
767
 
  IOCtl:=cIOCtl(Handle,Ndx,Data)<>-1;
768
 
  libcerrorfix( not IOCtl);
769
 
end;
770
 
 
771
 
function MUnMap (P : Pointer; Size : Longint) : Boolean;
772
 
begin
773
 
  MUnMap:=cMUnMap(p,size)=0;
774
 
  libcerrorfix( not MUnMap);
775
 
end;
776
 
 
777
 
{--------------------------------
778
 
      Port IO functions
779
 
--------------------------------}
780
 
{
781
 
// all of them has to be checked for soalris
782
 
Function  IOperm (From,Num : Cardinal; Value : Longint) : boolean;
783
 
{
784
 
  Set permissions on NUM ports starting with port FROM to VALUE
785
 
  this works ONLY as root.
786
 
}
787
 
 
788
 
Var
789
 
  Sr : Syscallregs;
790
 
begin
791
 
(*  Sr.Reg2:=From;
792
 
  Sr.Reg3:=Num;
793
 
  Sr.Reg4:=Value;
794
 
  IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
795
 
  LinuxError:=Errno;*)
796
 
  WriteLN('IOperm not suppoted yet');
797
 
end;
798
 
 
799
 
Function IoPL(Level : longint) : Boolean;
800
 
 
801
 
Var
802
 
  Sr : Syscallregs;
803
 
begin
804
 
(*  Sr.Reg2:=Level;
805
 
  IOPL:=Syscall(Syscall_nr_iopl,sr)=0;
806
 
  LinuxError:=Errno;*)
807
 
  WriteLN('IoPL not suppoted yet');
808
 
end;
809
 
 
810
 
{
811
 
  $Log: unixsysc.inc,v $
812
 
  Revision 1.3  2002/09/07 16:01:26  peter
813
 
    * old logs removed and tabs fixed
814
 
 
815
 
}