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

Annotation of /trunk/bfifo.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (hide annotations)
Fri Feb 5 03:32:29 2010 UTC (9 years, 10 months ago) by plugwash
File size: 2745 byte(s)
remove executable property

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     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:eol-style CRLF

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