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