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

Contents of /trunk/bfifo.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Mar 28 02:26:58 2008 UTC (11 years, 5 months ago) by plugwash
File size: 2745 byte(s)
initial import

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 a:integer;
80 begin
81 if len > size then len := size;
82 if len <= 0 then begin
83 result := 0;
84 resultptr := nil;
85 exit;
86 end;
87 p := getl;
88 resultptr := pointer(taddrint(tplinklist(p).p)+getofs);
89 result := pagesize-getofs;
90 if result > len then result := len;
91 end;
92
93 procedure tfifo.del;
94 var
95 a:integer;
96 p,p2:tlinklist;
97 begin
98 if len <= 0 then exit;
99 p := getl;
100 if len > size then len := size;
101 dec(size,len);
102
103 if len = 0 then exit;
104
105 while len > 0 do begin
106 a := pagesize-getofs;
107 if a > len then a := len;
108 inc(getofs,a);
109 dec(len,a);
110 if getofs = pagesize then begin
111 p2 := p.prev;
112 freemem(tplinklist(p).p);
113 dec(testcount);
114 linklistdel(l,p);
115 p.destroy;
116 p := p2;
117 getl := p;
118 getofs := 0;
119 end;
120 end;
121
122 if size = 0 then begin
123 if assigned(l) then begin
124 p := l;
125 freemem(tplinklist(p).p);
126 dec(testcount);
127 linklistdel(l,p);
128 p.destroy;
129 getl := nil;
130 end;
131 ofs := pagesize;
132 getofs := 0;
133 end;
134 end;
135
136 constructor tfifo.create;
137 begin
138 ofs := pagesize;
139 inherited create;
140 end;
141
142 destructor tfifo.destroy;
143 begin
144 del(size);
145 inherited destroy;
146 end;
147
148 end.

Properties

Name Value
svn:executable

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