summaryrefslogtreecommitdiff
path: root/fpcsrc/utils/fppkg/lnet/sys/lkqueueeventer.inc
blob: 6c75a1d24c8915c87af45cf965a2e38549f4d0f2 (plain)
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{% lkqueueeventer.inc included by levents.pas }

{$ifdef BSD}

{ TLKQueueEventer }

constructor TLKQueueEventer.Create;
begin
  inherited Create;
  Inflate;
  FFreeSlot := 0;
  FTimeout.tv_sec := 0;
  FTimeout.tv_nsec := 0;
  FQueue := KQueue;
  if FQueue < 0 then
    raise Exception.Create('Unable to create kqueue: ' + StrError(fpGetErrno));
end;

destructor TLKQueueEventer.Destroy;
begin
  fpClose(FQueue);
  inherited Destroy;
end;

function TLKQueueEventer.GetTimeout: Integer;
begin
  Result := FTimeout.tv_sec + FTimeout.tv_nsec * 1000 * 1000;
end;

procedure TLKQueueEventer.SetTimeout(const Value: Integer);
begin
  if Value >= 0 then begin
    FTimeout.tv_sec := Value div 1000;
    FTimeout.tv_nsec := (Value mod 1000) * 1000;
  end else begin
    FTimeout.tv_sec := -1;
    FTimeout.tv_nsec := 0;
  end;
end;

procedure TLKQueueEventer.HandleIgnoreRead(aHandle: TLHandle);
const
  INBOOL: array[Boolean] of Integer = (EV_ENABLE, EV_DISABLE);
begin
  EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ,
         INBOOL[aHandle.IgnoreRead], 0, 0, Pointer(aHandle));

  Inc(FFreeSlot);
  if FFreeSlot > Length(FChanges) then
    Inflate;
end;

procedure TLKQueueEventer.Inflate;
const
  BASE_SIZE = 100;
var
  OldLength: Integer;
begin
  OldLength := Length(FChanges);
  if OldLength > 1 then begin
    SetLength(FChanges, Sqr(OldLength));
    SetLength(FEvents, Sqr(OldLength));
  end else begin
    SetLength(FChanges, BASE_SIZE);
    SetLength(FEvents, BASE_SIZE);
  end;
end;

function TLKQueueEventer.AddHandle(aHandle: TLHandle): Boolean;
begin
  Result := inherited AddHandle(aHandle);

  if FFreeSlot > Length(FChanges) then
    Inflate;
  EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_WRITE,
         EV_ADD or EV_CLEAR, 0, 0, Pointer(aHandle));
  Inc(FFreeSlot);

  if FFreeSlot > Length(FChanges) then
    Inflate;
  if not aHandle.FIgnoreRead then begin
    EV_SET(@FChanges[FFreeSlot], aHandle.FHandle, EVFILT_READ,
           EV_ADD, 0, 0, Pointer(aHandle));
    Inc(FFreeSlot);
  end;
end;

function TLKQueueEventer.CallAction: Boolean;
var
  i, n: Integer;
  Temp: TLHandle;
begin
  Result := False;
  if FInLoop then
    Exit;

  if FTimeout.tv_sec >= 0 then
    n := KEvent(FQueue, @FChanges[0], FFreeSlot,
              @FEvents[0], Length(FEvents), @FTimeout)
  else
    n := KEvent(FQueue, @FChanges[0], FFreeSlot,
              @FEvents[0], Length(FEvents), nil);

  FFreeSlot := 0;
  if n < 0 then
    Bail('Error on kqueue', LSocketError);
  Result := n > 0;
  if Result then begin
    FInLoop := True;
    for i := 0 to n-1 do begin
      Temp := TLHandle(FEvents[i].uData);
      
      if  (not Temp.FDispose)
      and (FEvents[i].Filter = EVFILT_WRITE) then
        if Assigned(Temp.FOnWrite) and not Temp.IgnoreWrite then
          Temp.FOnWrite(Temp);

      if  (not Temp.FDispose)
      and (FEvents[i].Filter = EVFILT_READ) then
        if Assigned(Temp.FOnRead) and not Temp.IgnoreRead then
          Temp.FOnRead(Temp);
      
      if  (not Temp.FDispose)
      and ((FEvents[i].Flags and EV_ERROR) > 0) then
        if Assigned(Temp.FOnError) and not Temp.IgnoreError then
          Temp.FOnError(Temp, 'Handle error' + LStrError(LSocketError));

      if Temp.FDispose then
        AddForFree(Temp);
    end;
    FInLoop := False;
    if Assigned(FFreeRoot) then
      FreeHandles;
  end;
end;

function BestEventerClass: TLEventerClass;
begin
  {$IFNDEF FORCE_SELECT}
  Result := TLKQueueEventer;
  {$ELSE}
  Result := TLSelectEventer;
  {$ENDIF}
end;

{$endif} // BSD