Store1.pas

   1 UNIT Store1;
   2 {Take tracks of files in store}
   3 {just simple, no cleaning, etc}
   4 INTERFACE
   5 uses SysUtils;
   6
   7 type
   8 tfid=array [0..19] of byte;
   9 tStoreObjectInfo=object
  10  final:boolean;    {hash matched}
  11  rc:Word; {0=no error 1=not found, other}
  12  length:LongWord;  {the whole file}
  13  seglen:longword;  {from cur to end of segment}
  14  offset:LongWord;  {only valid when reading}
  15
  16  procedure Open(const fid:tfid);
  17  procedure Close;
  18  procedure SegSeek(ofs:LongWord); unimplemented;
  19  procedure ReadAhead(cnt:Word; into:pointer);
  20  procedure WaitRead; {wait for read to finish, rc}
  21  procedure EnableWrite(const fid:tFID);
  22  procedure SetFLength(len:LongWord);
  23  procedure WriteSeg(ofs:LongWord;len:word;data:pointer);
  24  procedure GetMiss(out ofs:LongWord; out len:LongWord; var state:pointer);
  25  procedure GetMiss(out ofs:LongWord; out len:LongWord);
  26  private
  27  dh:tHandle; {handle to the data file}
  28  filename:string[80];
  29  segi:pointer{to seg info obj};
  30 end;
  31 tObjectInfo=tStoreObjectInfo;
  32
  33 {Should consult Download on non-final files}
  34
  35 IMPLEMENTATION
  36 const prefix='object';
  37
  38 type
  39 tSegStatic=packed object
  40  first,after:LongWord;
  41  end;
  42 tSeg_ptr=^tSeg;
  43 tSeg=object(tSegStatic)
  44  next:tSeg_ptr;
  45  end;
  46 tSegInfo_ptr=^tSegInfo;
  47 pSegInfo=tSegInfo_ptr;
  48 tSegInfo=object
  49  cache:^tSeg;
  50  name:tFID;
  51  refc:byte;
  52  next:tSegInfo_ptr;
  53  procedure SetSeg(ofs,len:LongWord; state:boolean);
  54  function GetSegLen(ofs:LongWord):LongWord;
  55  procedure Free;
  56  end;
  57 var SegInfoChain:^tSegInfo;
  58
  59
  60 procedure mkfilen(var d:string; flag:char; const fid:tfid);
  61  function hc(b:byte):char;
  62   begin
  63   if b<10 then hc:=char(ord('0')+b)
  64           else hc:=char(ord('A')-10+b);
  65   end;
  66  var b,i:byte;
  67  begin
  68  d:=prefix+flag+'/';
  69  b:=system.length(d);
  70  SetLength(d,b+40);
  71  inc(b);
  72  for i:=0 to 19 do begin
  73   d[b+(i*2)]:=hc(fid[i] shr 4);
  74   d[b+(i*2)+1]:=hc(fid[i] and $F);
  75  end;
  76 end;
  77
  78 function GetSegInfo(const fid:tFID):tSegInfo_ptr;
  79  var fn:string;
  80  var fh:file of tSegStatic;
  81  var cp:^tSeg;
  82  label nocr;
  83  begin
  84  result:=SegInfoChain;
  85  while assigned(result) do begin
  86   if CompareWord(result^.name,fid,10)=0 then goto nocr;
  87   result:=result^.next;
  88  end;
  89  mkfilen(fn,'i',fid);
  90  new(result);
  91  with result^ do begin
  92   cache:=nil;
  93   name:=fid;
  94   refc:=0;
  95   next:=nil;
  96   SegInfoChain:=result;
  97   Assign(fh,fn);
  98   {$I-}ReSet(fh);{$I+}if ioresult=0 then begin
  99    while not eof(fh) do begin
 100     new(cp);
 101     read(fh,cp^);
 102     cp^.next:=cache;
 103     cache:=cp;
 104    end;
 105    close(fh);
 106   end;
 107  end;
 108  nocr:
 109  Inc(result^.refc);
 110 end;
 111
 112 procedure tStoreObjectInfo.Open(const fid:tfid);
 113  begin
 114  mkfilen(filename,'f',fid);
 115  segi:=nil;
 116  Offset:=0;
 117  dh:=FileOpen(filename,fmOpenRead or fmShareDenyWrite);
 118  if dh<>-1 then begin
 119   rc:=0;
 120   final:=true;
 121   length:=FileSeek(dh,0,fsFromEnd);
 122   FileSeek(dh,0,fsFromBeginning);
 123  end else begin
 124   mkfilen(filename,'p',fid);
 125   final:=false;
 126   dh:=FileOpen(filename,fmOpenRead or fmShareDenyWrite);
 127   if dh<>-1 then begin
 128    rc:=0;
 129    final:=false;
 130    length:=FileSeek(dh,0,fsFromEnd);
 131    FileSeek(dh,0,fsFromBeginning);
 132    segi:=GetSegInfo(fid);
 133   end else begin
 134    Writeln('Store1: open failed for file ',filename,', ioresult=',IOResult);
 135    rc:=2;
 136   end;
 137  end;
 138 end;
 139
 140 procedure tStoreObjectInfo.EnableWrite(const fid:tFID);
 141  begin
 142  writeln('Store1: enaling write');
 143  assert((dh=-1)or(not final));
 144  if dh=-1 then begin
 145   {file was close, create}
 146   dh:=FileCreate(filename);
 147   if dh=-1 then begin
 148    Writeln('Store1: create failed for file ',filename,', ioresult=',IOResult);
 149    rc:=3; exit end;
 150   {init length and segments}
 151   length:=0;
 152   segi:=GetSegInfo(fid);
 153  end;
 154  if dh<>-1 then begin
 155   {file was open, close and reopen rw}
 156   FileClose(dh);
 157   dh:=FileOpen(filename,fmOpenReadWrite or fmShareDenyWrite);
 158  end;
 159  if dh=-1 then rc:=2 else rc:=0;
 160 end;
 161 procedure tStoreObjectInfo.SetFLength(len:LongWord);
 162  begin
 163  assert(not final);
 164  writeln('Store1: SetFLength ',len);
 165  length:=len;
 166  {todo: errors!!!}
 167  FileSeek(dh,len,fsFromBeginning);
 168  FileSeek(dh,0,fsFromBeginning);
 169 end;
 170 procedure tSegInfo.SetSeg(ofs,len:LongWord; state:boolean);
 171  var cp:^tSeg;
 172  var pcp:^pointer;
 173  var after:LongWord;
 174  var op:boolean;
 175  procedure Dump(c:char);
 176   begin
 177   cp:=cache;
 178   writeln('Store1: dumpCache ',c,' ',LongWord(@self));
 179   while assigned(cp) do begin
 180    writeln(cp^.first,'-',cp^.after);
 181    cp:=cp^.next;
 182   end;
 183  end;
 184  begin
 185  assert(state);
 186  after:=ofs+len;
 187  //Dump('a');
 188  pcp:=@cache;
 189  cp:=cache;
 190  //writeln('Store1: Add: ',ofs,'-',after);
 191  while assigned(cp) do begin
 192   op:=false;
 193   if (ofs<=cp^.first)and(after>=cp^.after) then begin
 194    {merge complete-encase}
 195    pcp^:=cp^.next;
 196    dispose(cp);
 197    cp:=pcp^;
 198    continue;
 199   end;
 200   if cp^.after=ofs then begin
 201    {merge left-matching}
 202    pcp^:=cp^.next;
 203    ofs:=cp^.first;
 204    dispose(cp);
 205    cp:=pcp^;
 206    continue;
 207   end;
 208   if cp^.first=after then begin
 209    {merge right-matching}
 210    pcp^:=cp^.next;
 211    after:=cp^.after;
 212    dispose(cp);
 213    cp:=pcp^;
 214    continue;
 215   end;
 216   if (after>cp^.first)and(ofs<=cp^.first)and(after<=cp^.after) then begin writeln('k'); after:=cp^.first; end;
 217   if (ofs<cp^.after)and(after>=cp^.after)and(ofs>=cp^.first) then begin writeln('l');  ofs:=cp^.after;end;
 218   if not op then pcp:=@cp^.next;
 219   cp:=pcp^;
 220  end;
 221  //Dump('b');
 222  {add the merged seg}
 223  if ofs<>after then begin
 224  new(cp);
 225  cp^.first:=ofs;
 226  cp^.after:=after;
 227  cp^.next:=cache;
 228  cache:=cp;
 229  end;
 230  //Dump('c');
 231 end;
 232 procedure tStoreObjectInfo.WriteSeg(ofs:LongWord;len:word;data:pointer);
 233  begin
 234  {todo: errors!!!}
 235  FileSeek(dh,ofs,fsFromBeginning);
 236  FileWrite(dh,data^,len);
 237  tSegInfo(segi^).SetSeg(ofs,len,true);
 238 end;
 239 procedure tStoreObjectInfo.GetMiss(out ofs:LongWord; out len:LongWord; var state:pointer);
 240  var cp,cp1,cp2:^tSeg;
 241  begin with tSegInfo(segi^) do begin
 242  assert(state=nil);
 243  {find seg with lowest base, return 0..base-1}
 244  cp1:=nil; cp2:=nil;
 245  len:=0;
 246  ofs:=0;
 247  cp:=cache; while assigned(cp) do begin
 248   if (cp1=nil)or(cp^.first<cp1^.first) then cp1:=cp;
 249  cp:=cp^.next; end;
 250  if assigned(cp1) then begin
 251   cp:=cache; while assigned(cp) do begin
 252    if ((cp2=nil)or(cp^.first<cp2^.first))and(cp^.first>cp1^.first) then cp2:=cp;
 253   cp:=cp^.next; end;
 254   if assigned(cp2) then begin
 255    ofs:=cp1^.after;
 256    len:=cp2^.first-ofs;
 257   end else begin
 258    ofs:=cp1^.after;
 259    len:=self.length-ofs;
 260   end;
 261  end else len:=self.length;
 262  writeln('Store1: report miss ',ofs,'+',len);
 263 end;end;
 264 procedure tStoreObjectInfo.GetMiss(out ofs:LongWord; out len:LongWord);
 265  var state:pointer;
 266  begin
 267  state:=nil;
 268  GetMiss(ofs,len,state);
 269 end;
 270
 271
 272 procedure tStoreObjectInfo.ReadAhead(cnt:Word; into:pointer);
 273  var red:LongWord;
 274  begin
 275  //todo, do real async read
 276  assert(seglen>=cnt);
 277  red:=FileRead(dh,into^,cnt);
 278  seglen:=seglen-red;
 279  offset:=offset+red;
 280  if red=cnt then rc:=0 else begin
 281   //todo
 282   writeln('Store1: read ',red,' out of ',cnt,' requested bytes');
 283   rc:=2;
 284  end;
 285 end;
 286 procedure tStoreObjectInfo.WaitRead; {wait for read to finish, rc}
 287  begin
 288  //todo
 289 end;
 290 procedure tSegInfo.Free;
 291  var fn:string;
 292  var fh:file of tSegStatic;
 293  var cp:^tSeg;
 294  begin
 295  Dec(refc); if refc>0 then exit;
 296  {save segs, free segs, free}
 297  mkfilen(fn,'i',name);
 298  Assign(fh,fn);
 299  ReWrite(fh);
 300  while assigned(cache) do begin
 301   cp:=cache;
 302   write(fh,cp^);
 303   cache:=cp^.next;
 304   dispose(cp);
 305  end;
 306  FreeMem(@self,sizeof(self));
 307 end;
 308 procedure tStoreObjectInfo.Close;
 309  begin
 310  if assigned(segi) then tSegInfo(segi^).Free;
 311  FileClose(dh);
 312 end;
 313
 314 function tSegInfo.GetSegLen(ofs:LongWord):LongWord;
 315  var cp:^tSeg;
 316  begin
 317  cp:=cache;
 318  while assigned(cp) do begin
 319   if (cp^.first<=ofs)and(cp^.after>ofs) then begin
 320    GetSegLen:=cp^.after-ofs;
 321   exit end;
 322   cp:=cp^.next;
 323  end;
 324  GetSegLen:=0;
 325 end;
 326 procedure tStoreObjectInfo.SegSeek(ofs:longword);
 327  begin
 328  if final then begin
 329   if ofs<=length then begin
 330    seglen:=length-ofs;
 331    if FileSeek(dh,ofs,fsFromBeginning)=ofs then begin
 332     offset:=ofs;
 333     rc:=0;
 334    end else rc:=3;
 335   end else rc:=5;
 336  end else if assigned(segi) then begin
 337   seglen:=tSegInfo(segi^).GetSegLen(ofs);
 338   if seglen=0 then rc:=4 else if FileSeek(dh,ofs,fsFromBeginning)<>ofs then rc:=3 else rc:=0;
 339   offset:=ofs;
 340  end else rc:=7;
 341 end;
 342
 343 BEGIN
 344  SegInfoChain:=nil;
 345 END.