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

Annotation of /trunk/bfifo.pas

Parent Directory Parent Directory | Revision Log Revision Log


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