lcore/trunk/bfifo.pas

{ 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;
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.
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.
No admin address has been configured">No admin address has been configured	ViewVC Help
Powered by ViewVC 1.1.26