
// 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.

