mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-07 09:58:37 +02:00
263 lines
9.7 KiB
ObjectPascal
263 lines
9.7 KiB
ObjectPascal
{
|
|
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;
|
|
|
|
{$packrecords c}
|
|
|
|
interface
|
|
|
|
uses
|
|
ctypes;
|
|
|
|
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
|
|
CLONE_PTRACE = $00002000; // Set if tracing continues on the child.
|
|
CLONE_VFORK = $00004000; // Set if the parent wants the child to wake it up on mm_release.
|
|
CLONE_PARENT = $00008000; // Set if we want to have the same parent as the cloner.
|
|
CLONE_THREAD = $00010000; // Set to add to same thread group.
|
|
CLONE_NEWNS = $00020000; // Set to create new namespace.
|
|
CLONE_SYSVSEM = $00040000; // Set to shared SVID SEM_UNDO semantics.
|
|
CLONE_SETTLS = $00080000; // Set TLS info.
|
|
CLONE_PARENT_SETTID = $00100000; // Store TID in userlevel buffer before MM copy.
|
|
CLONE_CHILD_CLEARTID = $00200000; // Register exit futex and memory location to clear.
|
|
CLONE_DETACHED = $00400000; // Create clone detached.
|
|
CLONE_UNTRACED = $00800000; // Set if the tracing process can't force CLONE_PTRACE on this clone.
|
|
CLONE_CHILD_SETTID = $01000000; // Store TID in userlevel buffer in the child.
|
|
CLONE_STOPPED = $02000000; // Start in stopped state.
|
|
|
|
|
|
FUTEX_WAIT = 0;
|
|
FUTEX_WAKE = 1;
|
|
FUTEX_FD = 2;
|
|
FUTEX_REQUEUE = 3;
|
|
FUTEX_CMP_REQUEUE = 4;
|
|
FUTEX_WAKE_OP = 5;
|
|
FUTEX_LOCK_PI = 6;
|
|
FUTEX_UNLOCK_PI = 7;
|
|
FUTEX_TRYLOCK_PI = 8;
|
|
|
|
FUTEX_OP_SET = 0; // *(int *)UADDR2 = OPARG;
|
|
FUTEX_OP_ADD = 1; // *(int *)UADDR2 += OPARG;
|
|
FUTEX_OP_OR = 2; // *(int *)UADDR2 |= OPARG;
|
|
FUTEX_OP_ANDN = 3; // *(int *)UADDR2 &= ~OPARG;
|
|
FUTEX_OP_XOR = 4; // *(int *)UADDR2 ^= OPARG;
|
|
|
|
FUTEX_OP_OPARG_SHIFT = 8; // Use (1 << OPARG) instead of OPARG.
|
|
|
|
FUTEX_OP_CMP_EQ = 0; // if (oldval == CMPARG) wake
|
|
FUTEX_OP_CMP_NE = 1; // if (oldval != CMPARG) wake
|
|
FUTEX_OP_CMP_LT = 2; // if (oldval < CMPARG) wake
|
|
FUTEX_OP_CMP_LE = 3; // if (oldval <= CMPARG) wake
|
|
FUTEX_OP_CMP_GT = 4; // if (oldval > CMPARG) wake
|
|
FUTEX_OP_CMP_GE = 5; // if (oldval >= CMPARG) wake
|
|
|
|
{ FUTEX_WAKE_OP will perform atomically
|
|
int oldval = *(int *)UADDR2;
|
|
*(int *)UADDR2 = oldval OP OPARG;
|
|
if (oldval CMP CMPARG)
|
|
wake UADDR2; }
|
|
|
|
function FUTEX_OP(op, oparg, cmp, cmparg: cint): cint; {$ifdef SYSTEMINLINE}inline;{$endif}
|
|
|
|
const
|
|
EPOLLIN = $01; { The associated file is available for read(2) operations. }
|
|
EPOLLPRI = $02; { There is urgent data available for read(2) operations. }
|
|
EPOLLOUT = $04; { The associated file is available for write(2) operations. }
|
|
EPOLLERR = $08; { Error condition happened on the associated file descriptor. }
|
|
EPOLLHUP = $10; { Hang up happened on the associated file descriptor. }
|
|
EPOLLET = $80000000; { Sets the Edge Triggered behaviour for the associated file descriptor. }
|
|
|
|
{ Valid opcodes ( "op" parameter ) to issue to epoll_ctl }
|
|
EPOLL_CTL_ADD = 1;
|
|
EPOLL_CTL_DEL = 2;
|
|
EPOLL_CTL_MOD = 3;
|
|
|
|
{Some console iotcl's.}
|
|
GIO_FONT = $4B60; {gets font in expanded form}
|
|
PIO_FONT = $4B61; {use font in expanded form}
|
|
GIO_FONTX = $4B6B; {get font using struct consolefontdesc}
|
|
PIO_FONTX = $4B6C; {set font using struct consolefontdesc}
|
|
PIO_FONTRESET = $4B6D; {reset to default font}
|
|
GIO_CMAP = $4B70; {gets colour palette on VGA+}
|
|
PIO_CMAP = $4B71; {sets colour palette on VGA+}
|
|
KIOCSOUND = $4B2F; {start sound generation (0 for off)}
|
|
KDMKTONE = $4B30; {generate tone}
|
|
KDGETLED = $4B31; {return current led state}
|
|
KDSETLED = $4B32; {set led state [lights, not flags]}
|
|
KDGKBTYPE = $4B33; {get keyboard type}
|
|
KDADDIO = $4B34; {add i/o port as valid}
|
|
KDDELIO = $4B35; {del i/o port as valid}
|
|
KDENABIO = $4B36; {enable i/o to video board}
|
|
KDDISABIO = $4B37; {disable i/o to video board}
|
|
KDSETMODE = $4B3A; {set text/graphics mode}
|
|
KDGETMODE = $4B3B; {get current mode}
|
|
KDMAPDISP = $4B3C; {map display into address space}
|
|
KDUNMAPDISP = $4B3D; {unmap display from address space}
|
|
GIO_SCRNMAP = $4B40; {get screen mapping from kernel}
|
|
PIO_SCRNMAP = $4B41; {put screen mapping table in kernel}
|
|
GIO_UNISCRNMAP = $4B69; {get full Unicode screen mapping}
|
|
PIO_UNISCRNMAP = $4B6A; {set full Unicode screen mapping}
|
|
GIO_UNIMAP = $4B66; {get unicode-to-font mapping from kernel}
|
|
PIO_UNIMAP = $4B67; {put unicode-to-font mapping in kernel}
|
|
PIO_UNIMAPCLR = $4B68; {clear table, possibly advise hash algorithm}
|
|
KDGKBDIACR = $4B4A; {read kernel accent table}
|
|
KDSKBDIACR = $4B4B; {write kernel accent table}
|
|
KDGETKEYCODE = $4B4C; {read kernel keycode table entry}
|
|
KDSETKEYCODE = $4B4D; {write kernel keycode table entry}
|
|
KDSIGACCEPT = $4B4E; {accept kbd generated signals}
|
|
KDFONTOP = $4B72; {font operations}
|
|
|
|
{Keyboard types (for KDGKBTYPE)}
|
|
KB_84 = 1;
|
|
KB_101 = 2; {Normal PC keyboard.}
|
|
KB_OTHER = 3;
|
|
|
|
{Keyboard LED constants.}
|
|
LED_SCR = 1; {scroll lock led}
|
|
LED_NUM = 2; {num lock led}
|
|
LED_CAP = 4; {caps lock led}
|
|
|
|
{Tty modes. (for KDSETMODE)}
|
|
KD_TEXT = 0;
|
|
KD_GRAPHICS = 1;
|
|
KD_TEXT0 = 2; {obsolete}
|
|
KD_TEXT1 = 3; {obsolete}
|
|
|
|
MAP_GROWSDOWN = $100; { stack-like segment }
|
|
MAP_DENYWRITE = $800; { ETXTBSY }
|
|
MAP_EXECUTABLE = $1000; { mark it as an executable }
|
|
MAP_LOCKED = $2000; { pages are locked }
|
|
MAP_NORESERVE = $4000; { don't check for reservations }
|
|
|
|
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}
|
|
|
|
const
|
|
MODIFY_LDT_CONTENTS_DATA = 0;
|
|
MODIFY_LDT_CONTENTS_STACK = 1;
|
|
MODIFY_LDT_CONTENTS_CODE = 2;
|
|
|
|
{ Flags for user_desc.flags }
|
|
UD_SEG_32BIT = $01;
|
|
UD_CONTENTS_DATA = MODIFY_LDT_CONTENTS_DATA shl 1;
|
|
UD_CONTENTS_STACK = MODIFY_LDT_CONTENTS_STACK shl 1;
|
|
UD_CONTENTS_CODE = MODIFY_LDT_CONTENTS_CODE shl 1;
|
|
UD_READ_EXEC_ONLY = $08;
|
|
UD_LIMIT_IN_PAGES = $10;
|
|
UD_SEG_NOT_PRESENT = $20;
|
|
UD_USEABLE = $40;
|
|
UD_LM = $80;
|
|
|
|
type
|
|
user_desc = packed record
|
|
entry_number : cint;
|
|
base_addr : cuint;
|
|
limit : cuint;
|
|
flags : cuint;
|
|
end;
|
|
|
|
TUser_Desc = user_desc;
|
|
PUser_Desc = ^user_desc;
|
|
|
|
|
|
type
|
|
EPoll_Data = record
|
|
case integer of
|
|
0: (ptr: pointer);
|
|
1: (fd: cint);
|
|
2: (u32: cuint);
|
|
3: (u64: cuint64);
|
|
end;
|
|
|
|
TEPoll_Data = Epoll_Data;
|
|
PEPoll_Data = ^Epoll_Data;
|
|
|
|
EPoll_Event = {$ifdef cpu64} packed {$endif} record
|
|
Events: cuint32;
|
|
Data : TEpoll_Data;
|
|
end;
|
|
|
|
TEPoll_Event = Epoll_Event;
|
|
PEpoll_Event = ^Epoll_Event;
|
|
|
|
{ open an epoll file descriptor }
|
|
function epoll_create(size: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_create'; {$endif}
|
|
{ control interface for an epoll descriptor }
|
|
function epoll_ctl(epfd, op, fd: cint; event: pepoll_event): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_ctl'; {$endif}
|
|
{ wait for an I/O event on an epoll file descriptor }
|
|
function epoll_wait(epfd: cint; events: pepoll_event; maxevents, timeout: cint): cint; {$ifdef FPC_USE_LIBC} cdecl; external name 'epoll_wait'; {$endif}
|
|
|
|
implementation
|
|
|
|
{$ifndef FPC_USE_LIBC}
|
|
uses Syscall;
|
|
|
|
function Sysinfo(var Info: TSysinfo): Boolean;
|
|
begin
|
|
Sysinfo := do_SysCall(SysCall_nr_Sysinfo,TSysParam(@info))=0;
|
|
end;
|
|
|
|
function FUTEX_OP(op, oparg, cmp, cmparg: cint): cint; {$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
FUTEX_OP := ((op and $F) shl 28) or ((cmp and $F) shl 24) or ((oparg and $FFF) shl 12) or (cmparg and $FFF);
|
|
end;
|
|
|
|
function epoll_create(size: cint): cint;
|
|
begin
|
|
epoll_create := do_syscall(syscall_nr_epoll_create,tsysparam(size));
|
|
end;
|
|
|
|
function epoll_ctl(epfd, op, fd: cint; event: pepoll_event): cint;
|
|
begin
|
|
epoll_ctl := do_syscall(syscall_nr_epoll_ctl, tsysparam(epfd),
|
|
tsysparam(op), tsysparam(fd), tsysparam(event));
|
|
end;
|
|
|
|
function epoll_wait(epfd: cint; events: pepoll_event; maxevents, timeout: cint): cint;
|
|
begin
|
|
epoll_wait := do_syscall(syscall_nr_epoll_wait, tsysparam(epfd),
|
|
tsysparam(events), tsysparam(maxevents), tsysparam(timeout));
|
|
end;
|
|
{$endif}
|
|
|
|
end.
|