/usr/share/doc/fp-compiler/2.6.4/linux/epoll-pipe.pas is in fp-compiler-2.6.4 2.6.4+dfsg-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | // demonstration file for the epoll() linux specific call, by Micha
// Nelissen
program epoll_pipe;
{$mode objfpc}{$h+}
uses
baseunix, unix, linux;
const
NumPipes = 100;
NumActive = 1;
NumWrites = NumPipes;
NumRuns = 16;
var
gPipes: array of tfildes;
gEvents: array of epoll_event;
gCount, gFired, gWrites: integer;
epoll_fd: integer;
function getustime: qword;
var
tm: timeval;
begin
fpgettimeofday(@tm, nil);
result := tm.tv_sec * 1000000 + tm.tv_usec;
end;
procedure read_cb(fd, idx: integer);
var
widx: integer;
ch: char;
begin
widx := idx + NumActive + 1;
if fpread(fd, ch, sizeof(ch)) <> 0 then
inc(gCount)
else
writeln('false read event: fd=', fd, ' idx=', idx);
if gWrites <> 0 then
begin
if widx >= NumPipes then
dec(widx, NumPipes);
fpwrite(gPipes[widx][1], 'e', 1);
dec(gWrites);
inc(gFired);
end;
end;
procedure run_once(var work: integer; var tr: qword);
var
i, res: integer;
ts, te: qword;
begin
gFired := 0;
for i := 0 to NumActive-1 do
begin
fpwrite(gPipes[i][1], 'e', 1);
inc(gFired);
end;
gCount := 0;
gWrites := NumWrites;
ts := getustime;
repeat
res := epoll_wait(epoll_fd, @gEvents[0], NumPipes, 0);
for i := 0 to res-1 do
read_cb(gPipes[gEvents[i].data.u32][0], gEvents[i].data.u32);
until gCount = gFired;
te := getustime;
tr := te-ts;
work := gCount;
end;
var
lEvent: epoll_event;
i, work: integer;
tr: qword;
begin
SetLength(gEvents, NumPipes);
SetLength(gPipes, NumPipes);
epoll_fd := epoll_create(NumPipes);
if epoll_fd = -1 then
begin
writeln('error calling epoll_create');
halt(1);
end;
for i := 0 to NumPipes-1 do
begin
if fppipe(gPipes[i]) = -1 then
begin
writeln('error calling pipe');
halt(1);
end;
fpfcntl(gPipes[i][0], F_SETFL, fpfcntl(gPipes[i][0], F_GETFL) or O_NONBLOCK);
lEvent.events := EPOLLIN;
lEvent.data.u32 := i;
if epoll_ctl(epoll_fd, EPOLL_CTL_ADD, gPipes[i][0], @lEvent) < 0 then
begin
writeln('error calling epoll_ctl');
halt(1);
end;
end;
for i := 0 to NumRuns-1 do
begin
run_once(work, tr);
if work = 0.0 then
halt(1);
writeln(double(tr)/double(work):10:7);
end;
end.
|