/[lcore]/trunk/bfifo.pas
ViewVC logotype

Contents of /trunk/bfifo.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 94 - (show annotations)
Mon Feb 21 21:40:05 2011 UTC (6 years, 9 months ago) by beware
File size: 2731 byte(s)
eliminated a lot of hints and warnings
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.

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5