mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 09:59:41 +02:00
146 lines
3.8 KiB
PHP
146 lines
3.8 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Michael Van Canneyt,
|
|
BSD parts (c) 2000 by Marco van de Voort
|
|
members of the Free Pascal development team.
|
|
|
|
New linux unit. Linux only calls only. Will be renamed to linux.pp
|
|
when 1.0.x support is killed off.
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY;without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit Linux;
|
|
|
|
interface
|
|
|
|
Type
|
|
TSysinfo = packed record
|
|
uptime : longint;
|
|
loads : array[1..3] of longint;
|
|
totalram,
|
|
freeram,
|
|
sharedram,
|
|
bufferram,
|
|
totalswap,
|
|
freeswap : longint;
|
|
procs : integer;
|
|
s : string[18];
|
|
end;
|
|
PSysInfo = ^TSysInfo;
|
|
|
|
Function Sysinfo(var Info:TSysinfo):Boolean; {$ifdef FPC_USE_LIBC} cdecl; external name 'sysinfo'; {$endif}
|
|
|
|
Const
|
|
CSIGNAL = $000000ff; // signal mask to be sent at exit
|
|
CLONE_VM = $00000100; // set if VM shared between processes
|
|
CLONE_FS = $00000200; // set if fs info shared between processes
|
|
CLONE_FILES = $00000400; // set if open files shared between processes
|
|
CLONE_SIGHAND = $00000800; // set if signal handlers shared
|
|
CLONE_PID = $00001000; // set if pid shared
|
|
|
|
type
|
|
TCloneFunc=function(args:pointer):longint;cdecl;
|
|
|
|
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clone'; {$endif}
|
|
|
|
implementation
|
|
|
|
{$ifndef FPC_USE_LIBC}
|
|
Uses Syscall;
|
|
|
|
Function Sysinfo(var Info:TSysinfo):Boolean;
|
|
{
|
|
Get system info
|
|
}
|
|
Begin
|
|
Sysinfo:=do_SysCall(SysCall_nr_Sysinfo,TSysParam(@info))=0;
|
|
End;
|
|
|
|
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
|
|
|
begin
|
|
if (pointer(func)=nil) or (sp=nil) then
|
|
exit(-1); // give an error result
|
|
{$ifdef cpui386}
|
|
{$ASMMODE ATT}
|
|
asm
|
|
{ Insert the argument onto the new stack. }
|
|
movl sp,%ecx
|
|
subl $8,%ecx
|
|
movl args,%eax
|
|
movl %eax,4(%ecx)
|
|
|
|
{ Save the function pointer as the zeroth argument.
|
|
It will be popped off in the child in the ebx frobbing below. }
|
|
movl func,%eax
|
|
movl %eax,0(%ecx)
|
|
|
|
{ Do the system call }
|
|
pushl %ebx
|
|
movl flags,%ebx
|
|
movl SysCall_nr_clone,%eax
|
|
int $0x80
|
|
popl %ebx
|
|
test %eax,%eax
|
|
jnz .Lclone_end
|
|
|
|
{ We're in the new thread }
|
|
subl %ebp,%ebp { terminate the stack frame }
|
|
call *%ebx
|
|
{ exit process }
|
|
movl %eax,%ebx
|
|
movl $1,%eax
|
|
int $0x80
|
|
|
|
.Lclone_end:
|
|
movl %eax,__RESULT
|
|
end;
|
|
{$endif cpui386}
|
|
{$ifdef cpum68k}
|
|
{ No yet translated, my m68k assembler is too weak for such things PM }
|
|
(*
|
|
asm
|
|
{ Insert the argument onto the new stack. }
|
|
movl sp,%ecx
|
|
subl $8,%ecx
|
|
movl args,%eax
|
|
movl %eax,4(%ecx)
|
|
|
|
{ Save the function pointer as the zeroth argument.
|
|
It will be popped off in the child in the ebx frobbing below. }
|
|
movl func,%eax
|
|
movl %eax,0(%ecx)
|
|
|
|
{ Do the system call }
|
|
pushl %ebx
|
|
movl flags,%ebx
|
|
movl SysCall_nr_clone,%eax
|
|
int $0x80
|
|
popl %ebx
|
|
test %eax,%eax
|
|
jnz .Lclone_end
|
|
|
|
{ We're in the new thread }
|
|
subl %ebp,%ebp { terminate the stack frame }
|
|
call *%ebx
|
|
{ exit process }
|
|
movl %eax,%ebx
|
|
movl $1,%eax
|
|
int $0x80
|
|
|
|
.Lclone_end:
|
|
movl %eax,__RESULT
|
|
end;
|
|
*)
|
|
{$endif cpum68k}
|
|
end;
|
|
{$endif}
|
|
|
|
end.
|