1{ 2 Copyright (c) 2002 by Marco van de Voort 3 4 The base *BSD syscalls required to implement the system unit. These 5 are aliased for use in other units (to avoid poluting the system units 6 interface) 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} 17 18{$i ostypes.inc} 19 20{$ifdef FPC_USE_LIBC} 21 {$Linklib root} 22 // Out of date atm. 23const clib = 'root'; 24const netlib = 'net'; 25 26 27{$ifdef FPC_IS_SYSTEM} 28{$i oscdeclh.inc} 29{$endif} 30{$I osmacro.inc} 31 32{ var 33 Errno : cint; external name 'errno'; 34 35 function Fptime(tloc:ptime_t): time_t; cdecl; external name 'time'; 36 function Fpopen(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open'; 37 function Fpclose(fd : cint): cint; cdecl; external name 'close'; 38 function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek'; 39 function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read'; 40 function Fpwrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write'; 41 function Fpunlink(const path: pchar): cint; cdecl; external name 'unlink'; 42 function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename'; 43 function Fpstat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat'; 44 function Fpchdir(const path : pchar): cint; cdecl; external name 'chdir'; 45 function Fpmkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir'; 46 function Fprmdir(const path : pchar): cint; cdecl; external name 'rmdir'; 47 function Fpopendir(const dirname : pchar): pdir; cdecl; external name 'opendir'; 48 function Fpreaddir(var dirp : dir) : pdirent;cdecl; external name 'readdir'; 49 function Fpclosedir(var dirp : dir): cint; cdecl; external name 'closedir'; 50 procedure Fpexit(status : cint); cdecl; external name '_exit'; 51 function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction'; 52 function Fpftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate'; 53 function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename'; 54 function Fpfstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat'; 55 function Fpfork : pid_t; cdecl; external name 'fork'; 56 function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve'; 57 function Fpwaitpid(pid : pid_t; tat_loc : pcint; options: cint): pid_t; cdecl; external name 'waitpid'; 58 function Fpaccess(const pathname : pchar; amode : cint): cint; cdecl; external name 'access'; 59 60 function Fpuname(var name: utsname): cint; cdecl; external name 'uname'; 61 62 function FpDup(oldd:cint):cint; cdecl; external name 'dup'; 63 function FpDup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2'; 64} 65{$else} 66 67{***************************************************************************** 68 --- Main:The System Call Self --- 69*****************************************************************************} 70 71{ The system designed for Linux can't be used for *BSD so easily, since 72 *BSD pushes arguments, instead of loading them to registers.} 73 74// Var ErrNo : Longint; 75 76{$I syscallh.inc} 77{$I syscall.inc} 78{$I sysnr.inc} 79{$I osmacro.inc} 80 81// Should be moved to a FreeBSD specific unit in the future. 82 83function Fptime( tloc:ptime): time_t; [public, alias : 'FPC_SYSC_TIME']; 84 85{VAR tv : timeval; 86 tz : timezone; 87 retval : longint; 88} 89var 90 args : SysCallArgs; 91begin 92 { don't treat errno, since there is never any } 93 tloc^ := Do_Syscall(syscall_nr_time,args); 94 fptime := tloc^; 95{begin 96// Retval:=do_syscall(syscall_nr_gettimeofday,TSysParam(@tv),TSysParam(@tz)); 97 If retval=-1 then 98 Fptime:=-1 99 else 100 Begin 101 If Assigned(tloc) Then 102 TLoc^:=tv.tv_sec; 103 Fptime:=tv.tv_sec; 104 End; 105} 106End; 107 108{***************************************************************************** 109 --- File:File handling related calls --- 110*****************************************************************************} 111 112function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN']; 113var 114 args: SysCallArgs; 115begin 116 args.param[1] := $FFFFFFFF; 117 args.param[2] := cint(path); 118 args.param[3] := flags; 119 args.param[4] := cint(mode); 120 args.param[5] := 0; { close on execute flag } 121 fpopen:= SysCall(syscall_nr_open, args); 122{Begin 123 Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode)); 124} 125End; 126 127function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE']; 128var 129 args : SysCallArgs; 130begin 131 args.param[1] := fd; 132 fpclose:=SysCall(syscall_nr_close,args); 133{begin 134 Fpclose:=do_syscall(syscall_nr_close,fd); 135} 136end; 137 138{$ifdef netbsd} 139 {$ifdef cpupowerpc} 140 {$define netbsdmacppc} 141 {$endif} 142{$endif} 143 144{$ifdef netbsdmacppc} 145{$i sysofft.inc} // odd ball calling convention. 146{$else} 147 // generic versions. 148function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK']; 149 150{ 151this one is special for the return value being 64-bit.. 152hi/lo offset not yet tested. 153 154NetBSD: ok, but implicit return value in edx:eax 155FreeBSD: same implementation as NetBSD. 156} 157var 158 args: SysCallArgs; 159 160begin 161 args.param[1] := fd; 162 args.param[2] := cint(offset and $FFFFFFFF); 163 args.param[3] := cint((offset shr 32) and $FFFFFFFF); 164 args.param[4] := whence; 165 { we currently only support seeks upto 32-bit in length } 166 fplseek := off_t(SysCall(syscall_nr_lseek,args)); 167(*begin 168 Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence); 169*) 170end; 171 172type 173 { _kwstat_ kernel call structure } 174 pwstat = ^twstat; 175 twstat = packed record 176{00} filler : array[1..3] of longint; 177{12} newmode : mode_t; { chmod mode_t parameter } 178{16} unknown1 : longint; 179{20} newuser : uid_t; { chown uid_t parameter } 180{24} newgroup : gid_t; { chown gid_t parameter } 181{28} trunc_offset : off_t; { ftrucnate parameter } 182{36} unknown2 : array[1..2] of longint; 183{44} utime_param: int64; 184{52} unknown3 : array[1..2] of longint; 185 end; 186 187function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE']; 188var 189 args: SysCallArgs; 190 wstat : pwstat; 191begin 192 New(wstat); 193 FillChar(wstat^,sizeof(wstat),0); 194 wstat^.trunc_offset := flength; 195 args.param[1] := fd; 196 args.param[2] := $00000000; 197 args.param[3] := cint(wstat); 198 args.param[4] := $00000008; 199 args.param[5] := $00000001; 200 fpftruncate:=SysCall(syscall_nr_ftruncate, args); 201 Dispose(wstat); 202{begin 203 Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength)); 204} 205end; 206 207const 208 B_OS_NAME_LENGTH = 32; 209 B_PAGE_SIZE = 4096; 210 211const 212 B_NO_LOCK = 0; 213 B_LAZY_LOCK = 1; 214 B_FULL_LOCK = 2; 215 B_CONTIGUOUS = 3; 216 B_LOMEM = 4; 217 218 B_ANY_ADDRESS = 0; 219 B_EXACT_ADDRESS = 1; 220 B_BASE_ADDRESS = 2; 221 B_CLONE_ADDRESS = 3; 222 B_ANY_KERNEL_ADDRESS = 4; 223 224 B_READ_AREA = 1; 225 B_WRITE_AREA = 2; 226 227type 228 area_id = Longint; 229 230function create_area(name : pchar; var addr : longint; 231 addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id; 232var 233 args : SysCallArgs; 234begin 235 args.param[1] := cint(name); 236 args.param[2] := cint(@addr); 237 args.param[3] := cint(addr_typ); 238 args.param[4] := cint(size); 239 args.param[5] := cint(lock_type); 240 args.param[6] := cint(protection); 241 create_area := SysCall(syscall_nr_create_area, args); 242end; 243 244Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias: 'FPC_SYSC_MMAP']; 245var 246 heap_handle : area_id; 247const 248 zero=0; 249 myheapsize=$20000; 250 myheaprealsize=$20000; 251var 252 myheapstart:pointer; 253 s : string; 254begin 255 WriteLn('fpmmap'); 256 Str(len, s); 257 WriteLn(s); 258 myheapstart:=start; 259{$IFDEF FPC_USE_LIBC} 260 heap_handle := create_area('fpcheap',myheapstart,0,len,0,3);//!! 261{$ELSE} 262 heap_handle := create_area('fpcheap',longint(myheapstart),0,len,0,3);//!! 263{$ENDIF} 264 case heap_handle of 265 B_BAD_VALUE : WriteLn('B_BAD_VALUE'); 266 B_PAGE_SIZE : WriteLn('B_PAGE_SIZE'); 267 B_NO_MEMORY : WriteLn('B_NO_MEMORY'); 268 B_ERROR : WriteLn('B_ERROR'); 269 end; 270 271 fpmmap := myheapstart; 272// not available under BeOS 273// Fpmmap:=pointer(longint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,{$ifdef cpupowerpc}0,{$endif}offst{$ifdef cpui386},0{$endif}))); 274end; 275 276{$endif} 277 278 279function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ']; 280var 281 args : SysCallArgs; 282 funcresult: ssize_t; 283 errorcode : cint; 284begin 285 args.param[1] := fd; 286 args.param[2] := cint(buf); 287 args.param[3] := cint(nbytes); 288 args.param[4] := cint(@errorcode); 289 funcresult := ssize_t(Do_SysCall(syscall_nr_read,args)); 290 if funcresult >= 0 then 291 begin 292 fpread := funcresult; 293 errno := 0; 294 end 295 else 296 begin 297 fpread := -1; 298 errno := errorcode; 299 end; 300{begin 301 Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes); 302} 303end; 304 305//function Fpmywrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write'; 306 307function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE']; 308var 309 args : SysCallArgs; 310 funcresult : ssize_t; 311 errorcode : cint; 312begin 313 errorcode := 0; 314 // There is a bug in syscall in 1.9 under BeOS !!! 315 // Fixed ! 26/05/2004 ! See in syscall.inc 316 args.param[1] := fd; 317 args.param[2] := cint(buf); 318 args.param[3] := cint(nbytes); 319 args.param[4] := cint(@errorcode); 320 funcresult := Do_SysCall(syscall_nr_write,args); 321 322// funcresult := Fpmywrite(fd, buf, nbytes); 323 324 if funcresult >= 0 then 325 begin 326 fpwrite := funcresult; 327 errno := 0; 328 end 329 else 330 begin 331 fpwrite := -1; 332 errno := errorcode; 333 end; 334{begin 335 Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes); 336} 337end; 338 339function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK']; 340var 341 args :SysCallArgs; 342begin 343 args.param[1] := $FFFFFFFF; 344 args.param[2] := cint(path); 345 fpunlink := SysCall(syscall_nr_unlink,args); 346{begin 347 Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path)); 348} 349end; 350 351function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME']; 352var 353 args: SysCallArgs; 354begin 355 args.param[1] := $FFFFFFFF; 356 args.param[2] := cint(old); 357 args.param[3] := $FFFFFFFF; 358 args.param[4] := cint(newpath); 359 fprename := SysCall(syscall_nr_rename,args); 360{begin 361 Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath)); 362} 363end; 364 365function Fpstat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT']; 366var 367 args : SysCallArgs; 368begin 369 args.param[1] := $FFFFFFFF; 370 args.param[2] := cint(path); 371 args.param[3] := cint(@buf); 372 args.param[4] := $01000000; 373 fpstat := SysCall(syscall_nr_stat, args); 374{begin 375 Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf)); 376} 377end; 378 379 380{***************************************************************************** 381 --- Directory:Directory related calls --- 382*****************************************************************************} 383 384function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR']; 385var 386 args: SysCallArgs; 387begin 388 args.param[1] := $FFFFFFFF; 389 args.param[2] := cint(path); 390 fpchdir := SysCall(syscall_nr_chdir, args); 391{begin 392 Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path)); 393} 394end; 395 396function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR']; 397var 398 args :SysCallArgs; 399begin 400 args.param[1] := $FFFFFFFF; 401 args.param[2] := cint(path); 402 args.param[3] := cint(mode); 403 fpmkdir := SysCall(syscall_nr_mkdir,args); 404(*begin {Mode is 16-bit on F-BSD 4!} 405 Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),mode); 406*) 407end; 408 409function Fprmdir(path : pchar): cint; [public, alias : 'FPC_SYSC_RMDIR']; 410var 411 args: SysCallArgs; 412begin 413 args.param[1] := $FFFFFFFF; 414 args.param[2] := cint(path); 415 fprmdir := SysCall(syscall_nr_rmdir,args); 416{begin 417 Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path)); 418} 419end; 420 421{$ifndef NewReaddir} 422 423const DIRBLKSIZ=1024; 424 425 426function Fpopendir(dirname : pchar): pdir; [public, alias : 'FPC_SYSC_OPENDIR']; 427var 428 args : SysCallArgs; 429 dirp: pdir; 430 fd : cint; 431begin 432 New(dirp); 433 { just in case } 434 FillChar(dirp^,sizeof(dir),#0); 435 if assigned(dirp) then 436 begin 437 args.param[1] := $FFFFFFFF; 438 args.param[2] := cint(dirname); 439 args.param[3] := 0; 440 fd:=SysCall(syscall_nr_opendir,args); 441 if fd = -1 then 442 begin 443 Dispose(dirp); 444 fpopendir := nil; 445 exit; 446 end; 447 dirp^.fd := fd; 448 fpopendir := dirp; 449 exit; 450 end; 451 Errno := ESysEMFILE; 452 fpopendir := nil; 453(*var 454 fd:longint; 455 st:stat; 456 ptr:pdir; 457begin 458 Fpopendir:=nil; 459 if Fpstat(dirname,st)<0 then 460 exit; 461{ Is it a dir ? } 462 if not((st.st_mode and $f000)=$4000)then 463 begin 464 errno:=ESysENOTDIR; 465 exit 466 end; 467{ Open it} 468 fd:=Fpopen(dirname,O_RDONLY,438); 469 if fd<0 then 470 Begin 471 Errno:=-1; 472 exit; 473 End; 474 new(ptr); 475 if ptr=nil then 476 Begin 477 Errno:=1; 478 exit; 479 End; 480 Getmem(ptr^.dd_buf,2*DIRBLKSIZ); 481 if ptr^.dd_buf=nil then 482 exit; 483 ptr^.dd_fd:=fd; 484 ptr^.dd_loc:=-1; 485 ptr^.dd_rewind:=longint(ptr^.dd_buf); 486 ptr^.dd_size:=0; 487// ptr^.dd_max:=sizeof(ptr^.dd_buf^); 488 Fpopendir:=ptr; 489*) 490end; 491 492function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR']; 493var 494 args : SysCallArgs; 495begin 496 if assigned(dirp) then 497 begin 498 args.param[1] := dirp^.fd; 499 fpclosedir := SysCall(syscall_nr_closedir,args); 500 Dispose(dirp); 501 dirp := nil; 502 exit; 503 end; 504 Errno := ESysEBADF; 505 fpclosedir := -1; 506{begin 507 Fpclosedir:=Fpclose(dirp^.dd_fd); 508 Freemem(dirp^.dd_buf); 509 dispose(dirp); 510} 511end; 512 513function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR']; 514 515{Different from Linux, Readdir on BSD is based on Getdents, due to the 516missing of the readdir syscall. 517Getdents requires the buffer to be larger than the blocksize. 518This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks 519with blockmode have this higher?} 520 521(*function readbuffer:longint; 522 523var retval :longint; 524 525begin 526 Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)}); 527 dirp^.dd_rewind:=TSysParam(dirp^.dd_buf); 528 if retval=0 then 529 begin 530 dirp^.dd_rewind:=0; 531 dirp^.dd_loc:=0; 532 end 533 else 534 dirP^.dd_loc:=retval; 535 readbuffer:=retval; 536end;*) 537var 538 args : SysCallArgs; 539 funcresult : cint; 540begin 541 args.param[1] := dirp^.fd; 542 args.param[2] := cint(@(dirp^.ent)); 543 args.param[3] := $0000011C; 544 args.param[4] := $00000001; 545 { the error will be processed here } 546 funcresult := Do_SysCall(syscall_nr_readdir, args); 547 if funcresult <> 1 then 548 begin 549 if funcresult <> 0 then 550 errno := funcresult; 551 fpreaddir := nil; 552 exit; 553 end; 554 errno := 0; 555 fpreaddir := @dirp^.ent 556(* 557var 558 FinalEntry : pdirent; 559 novalid : boolean; 560 Reclen : Longint; 561 CurEntry : PDirent; 562 563begin 564 if (dirp^.dd_buf=nil) or (dirp^.dd_loc=0) THEN 565 exit(nil); 566 if (dirp^.dd_loc=-1) OR {First readdir on this pdir. Initial fill of buffer} 567 (dirp^.dd_rewind>=(longint(dirp^.dd_buf)+dirblksiz)) then {no more entries left?} 568 Begin 569 if readbuffer=0 then {succesful read?} 570 Exit(NIL); {No more data} 571 End; 572 FinalEntry:=NIL; 573 CurEntry:=nil; 574 repeat 575 novalid:=false; 576 CurEntry:=pdirent(dirp^.dd_rewind); 577 RecLen:=CurEntry^.d_reclen; 578 if RecLen<>0 Then 579 begin {valid direntry?} 580 if CurEntry^.d_fileno<>0 then 581 FinalEntry:=CurEntry; 582 inc(dirp^.dd_rewind,Reclen); 583 end 584 else 585 begin {block entirely searched or reclen=0} 586 Novalid:=True; 587 if dirp^.dd_loc<>0 THEN {blocks left?} 588 if readbuffer()<>0 then {succesful read?} 589 novalid:=false; 590 end; 591 until (FinalEntry<>nil) or novalid; 592 If novalid then 593 FinalEntry:=nil; 594 FpReadDir:=FinalEntry;*) 595end; 596{$endif} 597 598{***************************************************************************** 599 --- Process:Process & program handling - related calls --- 600*****************************************************************************} 601 602procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT']; 603var 604 args : SysCallArgs; 605begin 606// sys_exit(status); 607 args.param[1] := status; 608 do_syscall(syscall_nr_exit, args); 609end; 610 611{ 612 Change action of process upon receipt of a signal. 613 Signum specifies the signal (all except SigKill and SigStop). 614 If Act is non-nil, it is used to specify the new action. 615 If OldAct is non-nil the previous action is saved there. 616} 617 618function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION']; 619 620{ 621 Change action of process upon receipt of a signal. 622 Signum specifies the signal (all except SigKill and SigStop). 623 If Act is non-nil, it is used to specify the new action. 624 If OldAct is non-nil the previous action is saved there. 625} 626var 627 args : SysCallArgs; 628begin 629 args.param[1] := sig; 630 args.param[2] := cint(@act); 631 args.param[3] := cint(@oact); 632 fpsigaction := SysCall(syscall_nr_sigaction, args); 633//begin 634// do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact)); 635end; 636 637(*=================== MOVED from sysunix.inc ========================*) 638 639 640function Fpfstat(fd : cint; var sb : stat): cint; [public, alias : 'FPC_SYSC_FSTAT']; 641 642var 643 args : SysCallArgs; 644begin 645 args.param[1] := fd; 646 args.param[2] := $00; 647 args.param[3] := cint(@sb); 648 args.param[4] := $00000001; 649 fpfstat := SysCall(syscall_nr_fstat, args); 650 651{begin 652 fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb)); 653} 654end; 655 656{$ifdef NewReaddir} 657{$I readdir.inc} 658{$endif} 659 660 661function fork : pid_t; external 'root' name 'fork'; 662{ These routines are currently not required for BeOS } 663function Fpfork : pid_t; [public, alias : 'FPC_SYSC_FORK']; 664{ 665 This function issues the 'fork' System call. the program is duplicated in memory 666 and Execution continues in parent and child process. 667 In the parent process, fork returns the PID of the child. In the child process, 668 zero is returned. 669 A negative value indicates that an error has occurred, the error is returned in 670 LinuxError. 671} 672 673Begin 674 WriteLn('fpfork'); 675 fpfork := fork; 676// Not required for BeOS 677// Fpfork:=Do_syscall(SysCall_nr_fork); 678End; 679 680{ 681function Fpexecve(const path : pathstr; const argv : ppchar; const envp: ppchar): cint; 682} 683{ 684 Replaces the current program by the program specified in path, 685 arguments in args are passed to Execve. 686 environment specified in ep is passed on. 687} 688 689{ 690Begin 691 path:=path+#0; 692 do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp)); 693End; 694} 695{ 696function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; [public, alias : 'FPC_SYSC_EXECVE']; 697} 698{ 699 Replaces the current program by the program specified in path, 700 arguments in args are passed to Execve. 701 environment specified in ep is passed on. 702} 703{ 704Begin 705 do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp)); 706End; 707} 708function waitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; external 'root' name 'waitpid'; 709function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID']; 710{ 711 Waits until a child with PID Pid exits, or returns if it is exited already. 712 Any resources used by the child are freed. 713 The exit status is reported in the adress referred to by Status. It should 714 be a longint. 715} 716 717begin // actually a wait4() call with 4th arg 0. 718 FpWaitPID := waitpid(pid, stat_loc, options); 719// FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options,0); 720end; 721 722function Fpaccess(const pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS']; 723{ 724 Test users access rights on the specified file. 725 Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK. 726 R,W,X stand for read,write and Execute access, simultaneously. 727 F_OK checks whether the test would be allowed on the file. 728 i.e. It checks the search permissions in all directory components 729 of the path. 730 The test is done with the real user-ID, instead of the effective. 731 If access is denied, or an error occurred, false is returned. 732 If access is granted, true is returned. 733 Errors other than no access,are reported in unixerror. 734} 735var 736 args : SysCallArgs; 737begin 738 args.param[1] := $FFFFFFFF; 739 args.param[2] := cint(pathname); 740 args.param[3] := amode; 741 fpaccess := SysCall(syscall_nr_access,args); 742 743{begin 744 FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode); 745} 746end; 747(* 748function Fpaccess(const pathname : pathstr; amode : cint): cint; 749 750{ 751 Test users access rights on the specified file. 752 Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK. 753 R,W,X stand for read,write and Execute access, simultaneously. 754 F_OK checks whether the test would be allowed on the file. 755 i.e. It checks the search permissions in all directory components 756 of the path. 757 The test is done with the real user-ID, instead of the effective. 758 If access is denied, or an error occurred, false is returned. 759 If access is granted, true is returned. 760 Errors other than no access,are reported in unixerror. 761} 762 763begin 764 pathname:=pathname+#0; 765 Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0; 766end; 767*) 768 769Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP']; 770 771begin 772 {$warning TODO BeOS FpDup implementation} 773// Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes)); 774end; 775 776Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2']; 777 778begin 779 {$warning TODO BeOS FpDup2 implementation} 780// Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2)); 781end; 782 783 784 785Function Fpmunmap(start:pointer;len:size_t):cint; [public, alias :'FPC_SYSC_MUNMAP']; 786begin 787 {$warning TODO BeOS Fpmunmap implementation} 788// Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len); 789end; 790 791 792Function Fpmprotect(start:pointer;len:size_t;prot:cint):cint; [public, alias : 'FPC_SYSC_MPROTECT']; 793begin 794 {$warning TODO BeOS Fpmprotect implementation} 795// Fpmprotect:=do_syscall(syscall_nr_mprotect,TSysParam(start),TSysParam(len),TSysParam(prot)); 796end; 797 798 799{ 800 Interface to Unix ioctl call. 801 Performs various operations on the filedescriptor Handle. 802 Ndx describes the operation to perform. 803 Data points to data needed for the Ndx function. The structure of this 804 data is function-dependent. 805} 806 807Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL']; 808// This was missing here, instead hardcoded in Do_IsDevice 809begin 810 {$warning TODO BeOS FpIOCtl implementation} 811// FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data)); 812end; 813 814 815Function FpGetPid:LongInt; [public, alias : 'FPC_SYSC_GETPID']; 816{ 817 Get Process ID. 818} 819 820begin 821 {$warning TODO BeOS FpGetPid implementation} 822// FpGetPID:=do_syscall(syscall_nr_getpid); 823end; 824 825function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY']; 826 827begin 828 {$warning TODO BeOS fpgettimeofday implementation} 829// fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp)); 830end; 831 832function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK']; 833 834{ 835 Change the list of currently blocked signals. 836 How determines which signals will be blocked : 837 SigBlock : Add SSet to the current list of blocked signals 838 SigUnBlock : Remove the signals in SSet from the list of blocked signals. 839 SigSetMask : Set the list of blocked signals to SSet 840 if OldSSet is non-null, the old set will be saved there. 841} 842 843begin 844 {$warning TODO BeOS FPSigProcMask implementation} 845// FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset)); 846end; 847{$user BLA!} 848Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP']; 849begin 850 {$warning TODO BeOS FpNanoSleep implementation} 851{$ifndef darwin} 852// FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem)); 853{$else not darwin} 854{$warning: TODO: nanosleep!!!} 855{$endif not darwin} 856end; 857 858function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD']; 859{$ifndef darwin} 860const intpathmax = 1024-4; // didn't use POSIX data in libc 861 // implementation. 862var ept,bpt : pchar; 863 c : char; 864 ret : cint; 865 866begin 867 {$warning TODO BeOS Fpgetcwd implementation} 868(* if pt=NIL Then 869 begin 870 // POSIX: undefined. (exit(nil) ?) 871 // BSD : allocate mem for path. 872 getmem(pt,intpathmax); 873 if pt=nil Then 874 exit(nil); 875 ept:=pt+intpathmax; 876 end 877 else 878 Begin 879 if (_size=0) Then 880 Begin 881 seterrno(ESysEINVAL); 882 exit(nil); 883 End; 884 if (_size=1) Then 885 Begin 886 seterrno(ESysERANGE); 887 exit(nil); 888 End; 889 ept:=pt+_size; 890 end; 891 892 ret := do_syscall(syscall_nr___getcwd,TSysParam(pt),TSysParam( ept - pt)); 893 If (ret = 0) Then 894 If (pt[0] <> '/') Then 895 Begin 896 bpt := pt; 897 ept := pt + strlen(pt) - 1; 898 While (bpt < ept) Do 899 Begin 900 c := bpt^; 901 bpt^:=ept^; 902 inc(bpt); 903 ept^:=c; 904 dec(ept); 905 End; 906 End; 907 Fpgetcwd:=pt;*) 908end; 909{$else not darwin} 910{$i getcwd.inc} 911{$endif darwin} 912 913{$endif} 914 915Function Do_IsDevice(Handle:Longint):boolean; 916{ 917 Interface to Unix ioctl call. 918 Performs various operations on the filedescriptor Handle. 919 Ndx describes the operation to perform. 920 Data points to data needed for the Ndx function. The structure of this 921 data is function-dependent. 922} 923begin 924 do_isdevice:= (handle=StdInputHandle) or 925 (handle=StdOutputHandle) or 926 (handle=StdErrorHandle); 927end; 928 929{ 930extern _IMPEXP_ROOT status_t get_image_symbol(image_id imid, 931 const char *name, int32 sclass, void **ptr); 932extern _IMPEXP_ROOT status_t get_nth_image_symbol(image_id imid, int32 index, 933 char *buf, int32 *bufsize, int32 *sclass, 934 void **ptr); 935} 936 937// 938{$ifdef FPC_USE_LIBC} 939 940// private; use the macros, below 941function _get_image_info(image : image_id; var info : image_info; size : size_t) 942 : status_t; cdecl; external 'root' name '_get_image_info'; 943 944function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t) 945 : status_t; cdecl; external 'root' name '_get_next_image_info'; 946 947function get_image_info(image : image_id; var info : image_info) : status_t; 948begin 949 Result := _get_image_info(image, info, SizeOf(info)); 950end; 951 952function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t; 953begin 954 Result := _get_next_image_info(team, cookie, info, SizeOf(info)); 955end; 956 957{$else} 958 959 function wait_for_thread(thread: thread_id; var status : status_t): status_t; 960 var 961 args: SysCallArgs; 962 i: longint; 963 begin 964 args.param[1] := cint(thread); 965 args.param[2] := cint(@status); 966 wait_for_thread := SysCall(syscall_nr_wait_thread, args); 967 end; 968 969 function get_team_info(team: team_id; var info : team_info): status_t; 970 var 971 args: SysCallArgs; 972 begin 973 args.param[1] := cint(team); 974 args.param[2] := cint(@info); 975 get_team_info := SysCall(syscall_nr_get_team_info, args); 976 end; 977 978 979 function kill_team(team: team_id): status_t; 980 var 981 args: SysCallArgs; 982 begin 983 args.param[1] := cint(team); 984 kill_team := SysCall(syscall_nr_kill_team, args); 985 end; 986 987 function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t; 988 var 989 args: SysCallArgs; 990 begin 991 args.param[1] := cint(team); 992 args.param[2] := cint(@cookie); 993 args.param[3] := cint(@info); 994 args.param[4] := cint(sizeof(image_info)); 995 get_next_image_info := SysCall(syscall_nr_get_next_image_info, args); 996 end; 997 998 function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id; 999 var 1000 args: SysCallArgs; 1001 i: longint; 1002 begin 1003 args.param[1] := cint(argc); 1004 args.param[2] := cint(argv); 1005 args.param[3] := cint(envp); 1006 load_image := SysCall(syscall_nr_load_image, args); 1007 end; 1008 1009 function get_system_info(var info: system_info): status_t; 1010 var 1011 args: SysCallArgs; 1012 i: longint; 1013 begin 1014 args.param[1] := cint(@info); 1015 i := SysCall(syscall_nr_get_system_info, args); 1016 get_system_info := i; 1017 end; 1018 1019 function dev_for_path(const pathname : pchar): dev_t; 1020 var 1021 args: SysCallArgs; 1022 buffer: array[1..15] of longint; 1023 i: cint; 1024 begin 1025 args.param[1] := $FFFFFFFF; 1026 args.param[2] := cint(pathname); 1027 args.param[3] := cint(@buffer); 1028 args.param[4] := $01000000; 1029 if SysCall(syscall_nr_rstat, args)=0 then 1030 i:=buffer[1] 1031 else 1032 i:=-1; 1033 dev_for_path := i; 1034 end; 1035 1036 1037 function fs_stat_dev(device: dev_t; var info: fs_info): dev_t; 1038 var 1039 args: SysCallArgs; 1040 begin 1041 args.param[1] := cint(device); 1042 args.param[2] := 0; 1043 args.param[3] := $FFFFFFFF; 1044 args.param[4] := 0; 1045 args.param[5] := cint(@info); 1046 fs_stat_dev := SysCall(syscall_nr_statfs, args); 1047 end; 1048 1049{$endif} 1050 1051 1052(* Implemented in sytem under BeOS 1053CONST 1054 { Constansts for MMAP } 1055 MAP_PRIVATE =2; 1056 MAP_ANONYMOUS =$1000; 1057 1058Function sbrk(size : cint) : pointer; 1059begin 1060 sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0); 1061 if sbrk=pointer(-1) then 1062 sbrk:=nil 1063 else 1064 seterrno(0); 1065end; 1066*) 1067 1068