+++ /dev/null
-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
- For conditions of distribution and use, see copyright notice in zlib_license.txt\r
- which is included in the package\r
- ----------------------------------------------------------------------------- }\r
-unit bfifo;\r
-{$ifdef fpc}\r
- {$mode delphi}\r
-{$endif}\r
-\r
-interface\r
-\r
-uses blinklist,pgtypes;\r
-\r
-const\r
- pagesize=1420;\r
-\r
-type\r
- tfifo=class(tobject)\r
- private\r
- l:tlinklist; {add to}\r
- getl:tlinklist; {remove from}\r
- ofs:integer;\r
- getofs:integer;\r
- public\r
- size:integer;\r
- procedure add(data:pointer;len:integer);\r
- function get(var resultptr:pointer;len:integer):integer;\r
- procedure del(len:integer);\r
- constructor create;\r
- destructor destroy; override;\r
- end;\r
-\r
-\r
-implementation\r
-\r
-var\r
- testcount:integer;\r
-\r
-{\r
-\r
-xx1..... add\r
-xxxxxxxx\r
-....2xxx delete\r
-\r
-1 ofs\r
-2 getofs\r
-\r
-}\r
-\r
-procedure tfifo.add;\r
-var\r
- a:integer;\r
- p:tlinklist;\r
-begin\r
- if len <= 0 then exit;\r
- inc(size,len);\r
- while len > 0 do begin\r
- p := l;\r
- if ofs = pagesize then begin\r
- p := tplinklist.create;\r
- if getl = nil then getl := p;\r
- getmem(tplinklist(p).p,pagesize);\r
- inc(testcount);\r
- linklistadd(l,p);\r
- ofs := 0;\r
- end;\r
- a := pagesize - ofs;\r
- if len < a then a := len;\r
- move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);\r
- inc(taddrint(data),a);\r
- dec(len,a);\r
- inc(ofs,a);\r
- end;\r
-end;\r
-\r
-function tfifo.get;\r
-var\r
- p:tlinklist;\r
- a:integer;\r
-begin\r
- if len > size then len := size;\r
- if len <= 0 then begin\r
- result := 0;\r
- resultptr := nil;\r
- exit;\r
- end;\r
- p := getl;\r
- resultptr := pointer(taddrint(tplinklist(p).p)+getofs);\r
- result := pagesize-getofs;\r
- if result > len then result := len;\r
-end;\r
-\r
-procedure tfifo.del;\r
-var\r
- a:integer;\r
- p,p2:tlinklist;\r
-begin\r
- if len <= 0 then exit;\r
- p := getl;\r
- if len > size then len := size;\r
- dec(size,len);\r
-\r
- if len = 0 then exit;\r
-\r
- while len > 0 do begin\r
- a := pagesize-getofs;\r
- if a > len then a := len;\r
- inc(getofs,a);\r
- dec(len,a);\r
- if getofs = pagesize then begin\r
- p2 := p.prev;\r
- freemem(tplinklist(p).p);\r
- dec(testcount);\r
- linklistdel(l,p);\r
- p.destroy;\r
- p := p2;\r
- getl := p;\r
- getofs := 0;\r
- end;\r
- end;\r
-\r
- if size = 0 then begin\r
- if assigned(l) then begin\r
- p := l;\r
- freemem(tplinklist(p).p);\r
- dec(testcount);\r
- linklistdel(l,p);\r
- p.destroy;\r
- getl := nil;\r
- end;\r
- ofs := pagesize;\r
- getofs := 0;\r
- end;\r
-end;\r
-\r
-constructor tfifo.create;\r
-begin\r
- ofs := pagesize;\r
- inherited create;\r
-end;\r
-\r
-destructor tfifo.destroy;\r
-begin\r
- del(size);\r
- inherited destroy;\r
-end;\r
-\r
-end.\r