bfifo.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 unit bfifo;\r
   6 {$ifdef fpc}\r
   7   {$mode delphi}\r
   8 {$endif}\r
   9 \r
  10 interface\r
  11 \r
  12 uses blinklist,pgtypes;\r
  13 \r
  14 const\r
  15   pagesize=1420;\r
  16 \r
  17 type\r
  18   tfifo=class(tobject)\r
  19   private\r
  20     l:tlinklist;     {add to}\r
  21     getl:tlinklist; {remove from}\r
  22     ofs:integer;\r
  23     getofs:integer;\r
  24   public\r
  25     size:integer;\r
  26     procedure add(data:pointer;len:integer);\r
  27     function get(var resultptr:pointer;len:integer):integer;\r
  28     procedure del(len:integer);\r
  29     constructor create;\r
  30     destructor destroy; override;\r
  31   end;\r
  32 \r
  33 \r
  34 implementation\r
  35 \r
  36 var\r
  37   testcount:integer;\r
  38 \r
  39 {\r
  40 \r
  41 xx1..... add\r
  42 xxxxxxxx\r
  43 ....2xxx delete\r
  44 \r
  45 1 ofs\r
  46 2 getofs\r
  47 \r
  48 }\r
  49 \r
  50 procedure tfifo.add;\r
  51 var\r
  52   a:integer;\r
  53   p:tlinklist;\r
  54 begin\r
  55   if len <= 0 then exit;\r
  56   inc(size,len);\r
  57   while len > 0 do begin\r
  58     p := l;\r
  59     if ofs = pagesize then begin\r
  60       p := tplinklist.create;\r
  61       if getl = nil then getl := p;\r
  62       getmem(tplinklist(p).p,pagesize);\r
  63       inc(testcount);\r
  64       linklistadd(l,p);\r
  65       ofs := 0;\r
  66     end;\r
  67     a := pagesize - ofs;\r
  68     if len < a then a := len;\r
  69     move(data^,pointer(taddrint(tplinklist(p).p)+ofs)^,a);\r
  70     inc(taddrint(data),a);\r
  71     dec(len,a);\r
  72     inc(ofs,a);\r
  73   end;\r
  74 end;\r
  75 \r
  76 function tfifo.get;\r
  77 var\r
  78   p:tlinklist;\r
  79   a:integer;\r
  80 begin\r
  81   if len > size then len := size;\r
  82   if len <= 0 then begin\r
  83     result := 0;\r
  84     resultptr := nil;\r
  85     exit;\r
  86   end;\r
  87   p := getl;\r
  88   resultptr := pointer(taddrint(tplinklist(p).p)+getofs);\r
  89   result := pagesize-getofs;\r
  90   if result > len then result := len;\r
  91 end;\r
  92 \r
  93 procedure tfifo.del;\r
  94 var\r
  95   a:integer;\r
  96   p,p2:tlinklist;\r
  97 begin\r
  98   if len <= 0 then exit;\r
  99   p := getl;\r
 100   if len > size then len := size;\r
 101   dec(size,len);\r
 102 \r
 103   if len = 0 then exit;\r
 104 \r
 105   while len > 0 do begin\r
 106     a := pagesize-getofs;\r
 107     if a > len then a := len;\r
 108     inc(getofs,a);\r
 109     dec(len,a);\r
 110     if getofs = pagesize then begin\r
 111       p2 := p.prev;\r
 112       freemem(tplinklist(p).p);\r
 113       dec(testcount);\r
 114       linklistdel(l,p);\r
 115       p.destroy;\r
 116       p := p2;\r
 117       getl := p;\r
 118       getofs := 0;\r
 119     end;\r
 120   end;\r
 121 \r
 122   if size = 0 then begin\r
 123     if assigned(l) then begin\r
 124       p := l;\r
 125       freemem(tplinklist(p).p);\r
 126       dec(testcount);\r
 127       linklistdel(l,p);\r
 128       p.destroy;\r
 129       getl := nil;\r
 130     end;\r
 131     ofs := pagesize;\r
 132     getofs := 0;\r
 133   end;\r
 134 end;\r
 135 \r
 136 constructor tfifo.create;\r
 137 begin\r
 138   ofs := pagesize;\r
 139   inherited create;\r
 140 end;\r
 141 \r
 142 destructor tfifo.destroy;\r
 143 begin\r
 144   del(size);\r
 145   inherited destroy;\r
 146 end;\r
 147 \r
 148 end.\r