1 |
{ Copyright (C) 2005 Bas Steendijk and Peter Green
|
2 |
For conditions of distribution and use, see copyright notice in zlib_license.txt
|
3 |
which is included in the package
|
4 |
----------------------------------------------------------------------------- }
|
5 |
unit bfifo;
|
6 |
{$ifdef fpc}
|
7 |
{$mode delphi}
|
8 |
{$endif}
|
9 |
|
10 |
interface
|
11 |
|
12 |
uses blinklist,pgtypes;
|
13 |
|
14 |
const
|
15 |
pagesize=1420;
|
16 |
|
17 |
type
|
18 |
tfifo=class(tobject)
|
19 |
private
|
20 |
l:tlinklist; {add to}
|
21 |
getl:tlinklist; {remove from}
|
22 |
ofs:integer;
|
23 |
getofs:integer;
|
24 |
public
|
25 |
size:integer;
|
26 |
procedure add(data:pointer;len:integer);
|
27 |
function get(var resultptr:pointer;len:integer):integer;
|
28 |
procedure del(len:integer);
|
29 |
constructor create;
|
30 |
destructor destroy; override;
|
31 |
end;
|
32 |
|
33 |
|
34 |
implementation
|
35 |
|
36 |
var
|
37 |
testcount:integer;
|
38 |
|
39 |
{
|
40 |
|
41 |
xx1..... add
|
42 |
xxxxxxxx
|
43 |
....2xxx delete
|
44 |
|
45 |
1 ofs
|
46 |
2 getofs
|
47 |
|
48 |
}
|
49 |
|
50 |
procedure tfifo.add;
|
51 |
var
|
52 |
a:integer;
|
53 |
p:tlinklist;
|
54 |
begin
|
55 |
if len <= 0 then exit;
|
56 |
inc(size,len);
|
57 |
while len > 0 do begin
|
58 |
p := l;
|
59 |
if ofs = pagesize then begin
|
60 |
p := tplinklist.create;
|
61 |
if getl = nil then getl := p;
|
62 |
getmem(tplinklist(p).p,pagesize);
|
63 |
inc(testcount);
|
64 |
linklistadd(l,p);
|
65 |
ofs := 0;
|
66 |
end;
|
67 |
a := pagesize - ofs;
|
68 |
if len < a then a := len;
|
69 |
move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);
|
70 |
inc(taddrint(data),a);
|
71 |
dec(len,a);
|
72 |
inc(ofs,a);
|
73 |
end;
|
74 |
end;
|
75 |
|
76 |
function tfifo.get;
|
77 |
var
|
78 |
p:tlinklist;
|
79 |
begin
|
80 |
if len > size then len := size;
|
81 |
if len <= 0 then begin
|
82 |
result := 0;
|
83 |
resultptr := nil;
|
84 |
exit;
|
85 |
end;
|
86 |
p := getl;
|
87 |
resultptr := pointer(taddrint(tplinklist(p).p)+getofs);
|
88 |
result := pagesize-getofs;
|
89 |
if result > len then result := len;
|
90 |
end;
|
91 |
|
92 |
procedure tfifo.del;
|
93 |
var
|
94 |
a:integer;
|
95 |
p,p2:tlinklist;
|
96 |
begin
|
97 |
if len <= 0 then exit;
|
98 |
p := getl;
|
99 |
if len > size then len := size;
|
100 |
dec(size,len);
|
101 |
|
102 |
if len = 0 then exit;
|
103 |
|
104 |
while len > 0 do begin
|
105 |
a := pagesize-getofs;
|
106 |
if a > len then a := len;
|
107 |
inc(getofs,a);
|
108 |
dec(len,a);
|
109 |
if getofs = pagesize then begin
|
110 |
p2 := p.prev;
|
111 |
freemem(tplinklist(p).p);
|
112 |
dec(testcount);
|
113 |
linklistdel(l,p);
|
114 |
p.destroy;
|
115 |
p := p2;
|
116 |
getl := p;
|
117 |
getofs := 0;
|
118 |
end;
|
119 |
end;
|
120 |
|
121 |
if size = 0 then begin
|
122 |
if assigned(l) then begin
|
123 |
p := l;
|
124 |
freemem(tplinklist(p).p);
|
125 |
dec(testcount);
|
126 |
linklistdel(l,p);
|
127 |
p.destroy;
|
128 |
getl := nil;
|
129 |
end;
|
130 |
ofs := pagesize;
|
131 |
getofs := 0;
|
132 |
end;
|
133 |
end;
|
134 |
|
135 |
constructor tfifo.create;
|
136 |
begin
|
137 |
ofs := pagesize;
|
138 |
inherited create;
|
139 |
end;
|
140 |
|
141 |
destructor tfifo.destroy;
|
142 |
begin
|
143 |
del(size);
|
144 |
inherited destroy;
|
145 |
end;
|
146 |
|
147 |
end.
|