mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 16:09:17 +02:00
* linuxold etc moved to linux/ No need anymore for 1.0.x bootstrapping
git-svn-id: trunk@2542 -
This commit is contained in:
parent
a1ffe2a2a9
commit
a0ee97efb1
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -4498,10 +4498,7 @@ rtl/unix/ipc.pp svneol=native#text/plain
|
|||||||
rtl/unix/ipccdecl.inc svneol=native#text/plain
|
rtl/unix/ipccdecl.inc svneol=native#text/plain
|
||||||
rtl/unix/keyboard.pp svneol=native#text/plain
|
rtl/unix/keyboard.pp svneol=native#text/plain
|
||||||
rtl/unix/linux.pp svneol=native#text/plain
|
rtl/unix/linux.pp svneol=native#text/plain
|
||||||
rtl/unix/linuxnew.inc svneol=native#text/plain
|
|
||||||
rtl/unix/linuxold.inc svneol=native#text/plain
|
|
||||||
rtl/unix/mouse.pp svneol=native#text/plain
|
rtl/unix/mouse.pp svneol=native#text/plain
|
||||||
rtl/unix/oldlinux.pp svneol=native#text/plain
|
|
||||||
rtl/unix/oscdeclh.inc svneol=native#text/plain
|
rtl/unix/oscdeclh.inc svneol=native#text/plain
|
||||||
rtl/unix/ports.pp svneol=native#text/plain
|
rtl/unix/ports.pp svneol=native#text/plain
|
||||||
rtl/unix/printer.pp svneol=native#text/plain
|
rtl/unix/printer.pp svneol=native#text/plain
|
||||||
|
@ -1,145 +0,0 @@
|
|||||||
{
|
|
||||||
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.
|
|
File diff suppressed because it is too large
Load Diff
@ -1 +0,0 @@
|
|||||||
{$i linuxold.inc}
|
|
Loading…
Reference in New Issue
Block a user