← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to demo/linux/epoll-pipe.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

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