unit uHashIndexFile;

uses uIndexFile, uStmt, uGlobal, uGlobalDef, uPage, uTuple, IdTCPConnection{debug only};

THashIndexFileDirSize=sizeof(pageId);

//note: if we make HashIndexFileDirPerBlock a multiple of 2, then we can use SHR to DIV and get MOD faster...

HashIndexFileDirPerBlock=BlockSize div THashIndexFileDirSize;

THashSlotSize=sizeof(cardinal)+sizeof(Trid); //Note: sizeof(Trid) currently wastes 2 bytes

//note: if we make HashSlotPerBlock a multiple of 2, then we can use SHR to DIV and get MOD faster...

HashSlotPerBlock=BlockSize div THashSlotSize;

{TODO:

{Within 1st page (chain) - hash bucket index}

ThashIndexFileDir=record //note: see THashIndexFileDirSize above - keep in sync!!

pid:PageId;

end; {TfileDir}

{ThashIndexFileDir[0]=hash-bucket-dir header, 1..N = buckets available

HashBucketId=word;

{Within a page - hash key + RID}

THashSlot=record //note: see THashSlotSize above - keep in sync!!

HashValue:cardinal;//hash value (1st few bits give bucket)

RID:Trid; //record pointer

//note: in future, may add timestamp/full-key here to save false reads...

end; {TSlot}

{HashSlot[0]=hash-slot header, 1..N = used hash-slots hashSlot[0].hashValue=N i.e. count

HashSlotId=cardinal; //limits max per overflow chain

THashIndexFile=class(TIndexFile)

private

fHashValue:cardinal; //current hash value from last findStart

fPid:PageId; //current hash scan page

//note: uses TDBfile.fCurrentPage for current page storage

fhsId:HashSlotId; //current hash scan hash slot

fhsHeader:THashSlot; //current hash scan root page header (contains page-chain count for findNext)

fdirpage:TPage; //current hash dir page for duplicate scan

fhashBucket:cardinal;//current bucket for duplicate scan

fHashPrevious:THashSlot; //previous duplicate hash slot for duplicate scan & normal scan

fglobalDepth:pageId; //global depth for duplicate scan (read from 1st dir page during start)

function extendDirectory(st:TStmt;var id:PageId):integer;

function allocateBucket(st:TStmt;localDepth:pageId;var id:PageId):integer;

function Hash(t:TTuple):cardinal;

function slotCompare(ahashvalue:cardinal;arid:Trid;b:THashSlot):integer;

public

statHashClash:integer; //count number of misses due to hash clash (i.e. found tuple does not match)

statVersionMiss:integer; //count number of misses due to wrong version (e.g. found to be too old/young/deleted/uncommitted etc.)

function Dump(st:TStmt;connection:TIdTCPConnection;summary:boolean):integer;

function createFile(st:TStmt;const fname:string):integer; override;

function deleteFile(st:TStmt):integer; override;

function openFile(st:TStmt;const filename:string;startPage:PageId):integer; override;

function freeSpace(st:TStmt;page:TPage):integer; override;

function AddKeyPtr(st:TStmt;t:TTuple;rid:Trid):integer; override;

{DeleteKey notes (may be out of date)

function FindStart(st:TStmt;FindData:TTuple):integer; override;

function FindNext(st:TStmt;var noMore:boolean;var RID:Trid):integer; override;

function FindStop(st:TStmt):integer; override;

function FindStartDuplicate(st:TStmt):integer; override;

function FindNextDuplicate(st:TStmt;var noMore:boolean;var RID1,RID2:TRid):integer; override;

function FindStopDuplicate(st:TStmt):integer; override;

end; {THashIndexFile}

uLog,

{$ENDIF}

SysUtils, Math {for power}, uServer, uTransaction,

uMarshalGlobal {in '..\Odbc\uMarshalGlobal.pas'} {for date/time structures}

,uEvsHelpers;

who='';

where='uHashIndexFile';

function THashIndexFile.createFile(st:TStmt;const fname:string):integer;

routine=':createFile';

InitialGlobalDepth=1; //i.e. allocate 2^1 bucket pages & set bucket directory size=2^1

//note: make 2+ to prevent early duplicate-overflow dead-end

//todo: pass initialGlobalDepth from caller!

page:Tpage;

pid,bucketPid:PageId;

hashIndexFileDir:THashIndexFileDir;

dirSlot:DirSlotId;

dirPageId,prevDirSlotPageId:PageId;

i:integer;

result:=inherited CreateFile(st,fname);

if result<>ok then exit; //abort

result:=Fail; //default

//todo: assert 2^InitialGlobalDepth <= HashIndexFileDirPerBlock

// otherwise we would need extra bucket-dir-pages & currently assume 1

// - also add this assumption to routine header comments!

//todo write hash bucket directory page

//todo call extendDirectory instead of below...

{No page with room was found, so we allocate and add a new one}

if Ttransaction(st.owner).db.allocatePage(st,pid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new page',vError);

{$ELSE}

;

{$ENDIF}

exit;

end;

{Initialise this new page as a hashIndexFile directory page}

with (Ttransaction(st.owner).db.owner as TDBserver) do

begin

if buffer.pinPage(st,pid,page)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading new page to initialise it, %d',[pid]),vError);

{$ELSE}

;

{$ENDIF}

exit; //abort

end;

try

{Ok, add the page to the file's directory}

{Note: we do this now because this must be the 1st data page added to this file, because

if DirPageAdd(st,pid,freespace(st,page),prevDirSlotPageId,dirPageId,dirSlot)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new bucket directory page to page dir',vError);

{$ENDIF}

exit;

end;

//todo: assert dirSlot=0!

{Initialise blank directory page}

if page.latch(st)=ok then //note: no real need since newpage=local/new?

begin

try

page.block.pageType:=ptIndexData; //todo: use new type, e.g. ptHashIndexFileDir?

{Write zeroised bucket pointers}

hashIndexFileDir.pid:=InvalidPageId;

for i:=0 to HashIndexFileDirPerBlock-1 do

begin

page.SetBlock(st,i*sizeof(hashIndexFileDir),sizeof(hashIndexFileDir),@hashIndexFileDir);

end;

{Create initial hash-directory}

{Write hash-directory header}

hashIndexFileDir.pid:=InitialGlobalDepth; //global-depth => # buckets = 2^global-depth

page.SetBlock(st,0*sizeof(hashIndexFileDir),sizeof(hashIndexFileDir),@hashIndexFileDir);

{Write allocate initial bucket pages and set bucket directory pointers}

for i:=0 to trunc(power(2,InitialGlobalDepth))-1 do

begin

if allocateBucket(st,InitialGlobalDepth,bucketPid)<>ok then

exit; //abort

//Note: we don't set the new page's prevPage to itself here (maybe we should?) - no point until we have a proper chain

hashIndexFileDir.pid:=bucketPid;

page.SetBlock(st,(i+1){0 is reserved for dir-header}*sizeof(hashIndexFileDir),sizeof(hashIndexFileDir),@hashIndexFileDir);

end;

finally

page.unlatch(st);

end; {try}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Initialised hash file with bucket directory global depth=%d',[InitialGlobalDepth]),vDebugLow);

{$ELSE}

;

{$ENDIF}

page.dirty:=True;

result:=ok;

end

else

exit; //abort

finally

buffer.unpinPage(st,pid);

end; {try}

end; {with}

if result=ok then

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Hash-index-file %s created',[fname]),vDebug);

{$ELSE}

;

{$ENDIF}

end; {createFile}

function slotToPageSlot(slot:HashSlotId):HashSlotId;

result:=slot MOD (HashSlotPerBlock-1);

if result=0 then result:=(HashSlotPerBlock-1);

end; {slotToPageSlot}

function bucketToDirBucket(bucket:HashBucketId):HashBucketId;

result:=bucket MOD (HashIndexFileDirPerBlock-1);

if result=0 then result:=(HashIndexFileDirPerBlock-1);

end; {bucketToDirBucket}

function THashIndexFile.deleteFile(st:TStmt):integer;

routine=':deleteFile';

page:Tpage;

pid,bucketPid,nextfPid:PageId;

dirSlot:DirSlotId;

dirPageId:PageId;

i:integer;

hashMap:cardinal;

dirpid:pageId;

space:word;

dirpage:TPage;

hashIndexFileDir,hd:THashIndexFileDir;

globalDepth,localDepth:pageId;

hsHeader,hs:THashSlot;

overflowCount:cardinal;

noMoreOverflow:boolean;

lastPid:PageId;

result:=Fail; //default

{Structure summary:

result:=self.DirPage(st,InvalidPageId,0,dirpid,space); //get 1st dir slot page = 1st bucket dir page

if result<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed reading first dir slot',vDebugError);

{$ENDIF}

exit; //abort

end;

if dirpid<>InvalidPageId then //only if we have the bucket dir

begin

if (Ttransaction(st.owner).db.owner as TDBserver).buffer.pinPage(st,dirpid,dirpage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading bucket directory page %d',[dirpid]),vError);

{$ENDIF}

exit; //abort

end;

try

{Read hash-directory header}

dirpage.AsBlock(st,0*sizeof(hashIndexFileDir),sizeof(hashIndexFileDir),@hashIndexFileDir);

globalDepth:=hashIndexFileDir.pid; //global-depth => # buckets = 2^global-depth

{$IFDEF DEBUGDETAIL11}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Global depth: %d (%d entries)',[globalDepth,trunc(power(2,globalDepth))]),vDebugMedium);

{$ENDIF}

{$ENDIF}

{Go through the bucket directory and zap each bucket page chain}

for hashMap:=0 to trunc(power(2,globalDepth))-1 do

begin

overflowCount:=0; //indent level

if (((hashMap+1) MOD (HashIndexFileDirPerBlock-1))=1) and ((hashMap+1)<>1) then

begin //need next dir page

if dirpage.block.nextPage=InvalidPageId then

begin //error - not enough pages for count! Possibly crashed during last attempt so ignore...

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('No more directory pages after %d, but count says there should be %d slot entries & we have only read %d so far - continuing with the deletion...',[dirpage.block.thispage,trunc(power(2,globalDepth)),hashMap+1]),vDebugError);

{$ENDIF}

break; //continue with the deallocation... just abandon any further bucket slot reading...

end;

dirpid:=dirpage.block.nextPage;

(Ttransaction(st.owner).db.owner as TDBServer).buffer.unpinPage(st,dirpage.block.thisPage);

{Now we can deallocate this directory page}

if self.DirPageRemove(st,dirpage.block.thisPage,0)<>ok then exit; //reset 1st dir slot - we will move the next dir page here

//note: temporarily lost the rest of the index directory! But can be sure that no-one else will flush our garbage startpage before we do: (at least when transaction flushing is implemented)

if Ttransaction(st.owner).db.deAllocatePage(st,dirpage.block.thisPage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed de-allocating index file page',vError);

{$ENDIF}

exit;

end;

if (Ttransaction(st.owner).db.owner as TDBserver).buffer.pinPage(st,dirpid,dirpage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading bucket directory page %d [next]',[dirpid]),vError);

{$ENDIF}

exit; //abort

end;

{Now re-point the directory start to this directory page (in case we crash & restart)}

//Note: this next bit is a bit dodgy: we should use a file.dirPageSwap routine(?)

if self.DirPageSet(st,InvalidPageId,0,dirpid,freespace(st,dirpage),True{don't check})<>ok then exit; //set 1st dir slot page = new 1st bucket dir page

if self.DirPageFindFromPID(st,dirpage.block.thisPage,dirPageId,dirSlot)<>ok then exit; //find previous slot for this new dir page

if self.DirPageRemove(st,dirpage.block.thisPage,dirSlot)<>ok then exit; //reset the previous slot - we have moved it to slot 0 //Note: currently if this is 1st slot on an extended file directory page, the page will be deleted!

(Ttransaction(st.owner).db.owner as TDBServer).buffer.flushPage(st,startPage,nil);

//note: also should flush the dirpage containing dirSlot: if we can't find it out, flush all!

// - worst case=double entry for same page: de-allocation will remove 1st one, so file dir-page won't be empty...

end;

dirpage.AsBlock(st,bucketToDirBucket(hashMap+1)*sizeof(hd),sizeof(hd),@hd);

fpid:=hd.pid;

{Now pin the bucket page}

if (Ttransaction(st.owner).db.owner as TDBserver).buffer.pinPage(st,fpid,fCurrentPage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading bucket page %d',[fpid]),vError);

{$ENDIF}

exit; //abort

end;

{Zap this page and any overflow pages}

{Read hash-slot header}

fCurrentPage.AsBlock(st,0*sizeof(hsHeader),sizeof(hsHeader),@hsHeader);

localDepth:=hsHeader.RID.pid;

{Note: we've no need to go through the slots: just remove pages from the chain

begin

fhsId:=1; //start at 1st hash slot

//while fhsId<=hsHeader.hashValue do

while fCurrentPage.block.nextPage<>InvalidPageId do

begin

//fCurrentPage.AsBlock(st,slotToPageSlot(fhsId)*sizeof(hs),sizeof(hs),@hs);

//inc(fhsId);

//if ((fhsId MOD (HashSlotPerBlock-1))=1) and (fhsId<>1) then

begin //end of this read page, move to next one

//if fCurrentPage.block.nextPage<>InvalidPageId then

begin //get and pin next overflow page in this chain

inc(overflowCount);

lastPid:=fCurrentPage.block.prevPage; //i.e. save root page's prev pointer to end of chain

nextfPid:=fCurrentPage.block.nextPage; //save before we unpin

(Ttransaction(st.owner).db.owner as TDBServer).buffer.unpinPage(st,fpid); //un-pin current page

{Now we can deallocate this page}

if dirpage.latch(st)<>ok then //would be faster to latch once at start of routine

exit; //abort - todo make more resiliant?

try

{Re-point the bucket page to the next in the chain, i.e. skip this one before it's de-allocated}

hd.pid:=nextfPid;

dirpage.SetBlock(st,bucketToDirBucket(hashMap+1)*sizeof(hd),sizeof(hd),@hd);

{$IFDEF DEBUGDETAIL11}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Linking root to page (%d) to skip page (%d)',[hd.pid,fpid]),vDebugLow);

{$ENDIF}

{$ENDIF}

dirPage.dirty:=True;

finally

dirpage.unlatch(st);

end; {try}

if self.DirPageFindFromPID(st,fPid,dirPageId,dirSlot)<>ok then exit; //find slot for this page

if self.DirPageRemove(st,fPid,dirSlot)<>ok then exit; //reset the slot //Note: currently if this is 1st slot on an extended file directory page, the page will be deleted!

if Ttransaction(st.owner).db.deAllocatePage(st,fPid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed de-allocating index file page',vError);

{$ENDIF}

exit;

end;

fpid:=nextfPid;

if (Ttransaction(st.owner).db.owner as TDBserver).buffer.pinPage(st,fpid,fCurrentPage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading bucket page %d',[fpid]),vError);

{$ENDIF}

exit; //abort

end;

if fCurrentPage.latch(st)<>ok then

exit; //abort - todo make more resiliant?

try

{Re-point the new root page to the last in the chain}

fCurrentPage.block.prevPage:=lastPid;

{$IFDEF DEBUGDETAIL11}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Linking end-of-chain-page (%d) to new root(%d).prevPage',[lastPid,fpid]),vDebugLow);

{$ENDIF}

{$ENDIF}

fCurrentPage.dirty:=True;

finally

fCurrentPage.unlatch(st);

end; {try}

(Ttransaction(st.owner).db.owner as TDBServer).buffer.flushPage(st,dirpid,nil);

(Ttransaction(st.owner).db.owner as TDBServer).buffer.flushPage(st,fpid,nil);

end

end;

end;

end;

//else skip detail

(Ttransaction(st.owner).db.owner as TDBServer).buffer.unpinPage(st,fpid); //un-pin current page

{Now we can deallocate this page}

if self.DirPageFindFromPID(st,fPid,dirPageId,dirSlot)<>ok then exit; //find slot for this page

if self.DirPageRemove(st,fPid,dirSlot)<>ok then exit; //reset the slot //Note: currently if this is 1st slot on an extended file directory page, the page will be deleted!

if Ttransaction(st.owner).db.deAllocatePage(st,fPid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed de-allocating index file page',vError);

{$ENDIF}

exit;

end;

if dirpage.latch(st)<>ok then //would be faster to latch once at start of routine

exit; //abort - todo make more resiliant?

try

{Reset the bucket page}

hd.pid:=InvalidPageId;

dirpage.SetBlock(st,bucketToDirBucket(hashMap+1)*sizeof(hd),sizeof(hd),@hd);

{$IFDEF DEBUGDETAIL11}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Resetting bucket slot %d',[(hashMap+1)]),vDebugLow);

{$ENDIF}

{$ENDIF}

dirPage.dirty:=True;

finally

dirpage.unlatch(st);

end; {try}

(Ttransaction(st.owner).db.owner as TDBServer).buffer.flushPage(st,dirpid,nil);

end;

result:=ok;

finally

(Ttransaction(st.owner).db.owner as TDBServer).buffer.unpinPage(st,dirpid);

end; {try}

if result=ok then

begin

{Now we can deallocate this directory page}

if self.DirPageFindFromPID(st,dirPid,dirPageId,dirSlot)<>ok then exit; //find slot for this directory page

{Note: this is the last directory page so it should be at dirSlot=0, so assert! (we will have moved it there if there was originally more than 1 dir page)}

if self.DirPageRemove(st,dirPid,dirSlot)<>ok then exit; //reset the slot //Note: currently if this is 1st slot on an extended file directory page, the page will be deleted!

if Ttransaction(st.owner).db.deAllocatePage(st,dirpid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed de-allocating index file page',vError);

{$ENDIF}

exit;

end;

{The above should have re-set the directory start}

end;

end

else

{there are no data pages for this file (yet) - should never happen for this type of file

;

result:=inherited DeleteFile(st);

if result=ok then

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Hash-index-file %s deleted',[fname]),vDebug);

{$ELSE}

;

{$ENDIF}

end; {deleteFile}

function THashIndexFile.extendDirectory(st:TStmt;var id:PageId):integer;

const routine=':extendDirectory';

newpid:PageId;

newPage:TPage;

hashIndexFileDir:THashIndexFileDir;

dirSlot:DirSlotId;

dirPageId,prevDirSlotPageId:PageId;

i:integer;

id:=InvalidPageId; //note not required, but safer

result:=Fail;

{Allocate and add a new page}

if Ttransaction(st.owner).db.allocatePage(st,newpid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new page',vError);

{$ELSE}

;

{$ENDIF}

exit;

end;

{Initialise this new page as a hashIndexFile directory page}

with (Ttransaction(st.owner).db.owner as TDBserver) do

begin

if buffer.pinPage(st,newpid,newpage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading new page to initialise it, %d',[newpid]),vError);

{$ELSE}

;

{$ENDIF}

exit; //abort

end;

try

{Ok, add the page to the file's directory}

if DirPageAdd(st,newpid,freespace(st,newpage),prevDirSlotPageId,dirPageId,dirSlot)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new bucket directory page to page dir',vError);

{$ENDIF}

exit;

end;

{Initialise blank directory page}

if newpage.latch(st)=ok then //note: no real need since newpage=local/new?

begin

try

newpage.block.pageType:=ptIndexData; //todo: use new type, e.g. ptHashIndexFileDir?

{Write zeroised bucket pointers}

hashIndexFileDir.pid:=InvalidPageId;

for i:=0 to HashIndexFileDirPerBlock-1 do

begin

newpage.SetBlock(st,i*sizeof(hashIndexFileDir),sizeof(hashIndexFileDir),@hashIndexFileDir);

end;

newpage.dirty:=True;

finally

newpage.unlatch(st);

end; {try}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Extended hash file with directory page %d',[newpid]),vDebugLow);

{$ENDIF}

id:=newpid;

result:=ok;

end

else

exit; //abort

finally

buffer.unpinPage(st,newpid);

end; {try}

end; {with}

end; {extendDirectory}

function THashIndexFile.openFile(st:TStmt;const filename:string;startPage:PageId):integer;

const routine=':openFile';

result:=inherited openFile(st,filename,startPage);

if result=ok then

begin

//goto first record?

//goto bucket directory page? always = dirSlot=0

{$IFDEF DEBUGDETAIL4}

{$IFDEF DEBUG_LOG}

self.dump(st,nil);

{$ENDIF}

{$ENDIF}

end;

end; {openFile}

function THashIndexFile.freeSpace(st:TStmt;page:TPage):integer;

const routine=':freeSpace';

parentFreeSpace:integer;

parentFreeSpace:=inherited freeSpace(st,page); //starting point

result:=parentFreeSpace;

result:=0; //for now... i.e. better for client to fail if it calls this than to assume space is available

//note if page[1] then n/a? or return free buckets?

end; {FreeSpace}

function THashIndexFile.allocateBucket(st:TStmt;localDepth:pageId;var id:PageId):integer;

const routine=':allocateBucket';

newpid:PageId;

newPage:TPage;

dirSlot:DirSlotId;

dirPageId,prevDirSlotPageId:PageId;

hsHeader:THashSlot;

id:=InvalidPageId; //not required, but safer

result:=Fail;

{Todo move!}

if THashSlotSize<>sizeof(hsHeader) then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('THashSlotSize[%d]<>sizeof(hsHeader)[%d]',[THashSlotSize,sizeof(hsHeader)]),vAssertion);

{$ELSE}

;

{$ENDIF}

exit; //abort

end;

if Ttransaction(st.owner).db.allocatePage(st,newpid)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new file page',vError);

{$ELSE}

;

{$ENDIF}

exit;

end;

{Initialise this new page as a bucket page}

with (Ttransaction(st.owner).db.owner as TDBserver) do

begin

if buffer.pinPage(st,newpid,Newpage)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Failed reading new file page to initialise it, %d',[newpid]),vError);

{$ELSE}

;

{$ENDIF}

exit; //abort

end;

try

//todo remove: debug only!

{$IFDEF SAFETY}

{$IFDEF DEBUG_LOG} //todo: what if live?

if (Newpage.block.nextPage<>InvalidPageId) or (Newpage.block.prevPage<>InvalidPageId) then

log.add(st.who,where+routine,format('...newly allocated bucket page %d still has page links %d and %d (type=%d)! - continuing with risk of corruption...',[newpid,Newpage.block.prevPage,Newpage.block.nextPage,Newpage.block.pageType]),vAssertion);

{$ENDIF}

{$ENDIF}

{Initialise blank bucket page}

if newpage.latch(st)=ok then //note: no real need since newpage=local/new?

begin

try

newpage.block.pageType:=ptIndexData;

{Write blank hash-slot header}

hsHeader.hashValue:=0; //hash-slot count

hsHeader.RID.pid:=localDepth;

hsHeader.RID.sid:=InvalidSlotId; //unused

newpage.SetBlock(st,0,sizeof(hsHeader),@hsHeader);

//rest of page is left zeroised

newpage.dirty:=True;

finally

newpage.unlatch(st);

end; {try}

{Ok, add the page to the file's directory}

if DirPageAdd(st,newpid,freespace(st,newpage),prevDirSlotPageId,dirPageId,dirSlot)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,'Failed allocating new page to page dir',vError);

{$ENDIF}

exit;

end;

id:=newpid;

result:=ok;

end

else

exit; //abort

//Note: the prev/next page links are not used in this file's data pages

// (except bucket directory header if it grows past initial 1 page

// and except overflow pages needed when bucket is full of same hashvalue)

finally

buffer.unpinPage(st,newpid);

end; {try}

end; {with}

{$IFDEF DEBUG_LOG}

log.add(st.who,where+routine,format('Extended hash file with bucket page %d, local depth %d',[newpid,localDepth]),vDebugLow);

{$ENDIF}

end; {allocateBucket}

function THashIndexFile.Hash(t:TTuple):cardinal;

const routine=':Hash';

i:integer;

pv:char;

p:pchar;

len,j:ColOffset;

isnull:boolean;

isString:boolean;

//todo remove need for these: speed

dt:TsqlDate;

tm:TsqlTime;

ts:TsqlTimestamp;

dayCarry:shortint;

s:string;

result:=5381;

for i:=1 to colCount do

begin

isString:=(DataTypeDef[t.fColDef[colMap[i].cref].dataType] in [stString])

or (t.fColDef[colMap[i].cref].dataType in [ctClob]);

if DataTypeDef[t.fColDef[colMap[i].cref].dataType] in [stDate,stTime,stTimestamp] then

begin //we need to hash the string representation (else got different answers each time! -not sure why...)

case DataTypeDef[t.fColDef[colMap[i].cref].dataType] of

stDate: begin t.GetDate(colMap[i].cref,dt,isnull); s:=format(DATE_FORMAT,[dt.year,dt.month,dt.day]); end;

stTime: begin t.GetTime(colMap[i].cref,tm,isnull); s:=sqlTimeToStr(TIMEZONE_ZERO,tm,t.fColDef[colMap[i].cref].scale,dayCarry); end;

stTimestamp: begin t.GetTimestamp(colMap[i].cref,ts,isnull); s:=sqlTimestampToStr(TIMEZONE_ZERO,ts,t.fColDef[colMap[i].cref].scale); end;

end; {case}

t.colIsNull(colMap[i].cref,isnull);

len:=length(s);

p:=pchar(s);

end

else //get direct pointer to raw data

if t.GetDataPointer(colMap[i].cref,pointer(p),len,isnull)<>ok then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('Failed reading column data %d',[i]),vDebugError);

{$ELSE}

;

{$ENDIF}

result:=0; //=don't use

exit; //abort, pointer is unsafe to use

end;

if not isnull then

for j:=0 to len-1 do

begin

pv:=p^;

{Note: we uppercase any text characters to ensure index searches ignore case}

if isString then pv:={byte(}upcase(char(pv)){)}; //todo assembly=speed

//todo: should also ignore trailing spaces, i.e. NO PAD, so that user passed values will match properly

//todo: ensure/check that caller converts comparand type to match the index type, e.g. date & string don't directly hash-compare this way here...

{$IFDEF DEBUGDETAIL10}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('Hashing byte %d %s',[j,char(pv)]),vDebugLow); //assertion?

{$ENDIF}

{$ENDIF}

//pvi:=ord(pv); //copy to 4-byte integer because assembly ADD wouldn't accept DWORD cast in Kylix beta //todo re-instate:speed

{We use assembly here because:

{$IFDEF CPU64}

//todo remove once assembly code is working...

try

{$IFDEF FPC}

{$Push}

{$ENDIF}

{$OverflowChecks off}

Result := Result + (Result shl 5) + integer(p^); //hash * 33 + c

{$IFDEF FPC}

{$Pop}

{$ELSE}

{$ENDIF}

except //todo: maybe we need $Q+ to be able to trap this correctly?

;//continue, even if we have overflow...

end;

{$ELSE}

asm //result:=result + (result shl 5) + p^; //hash * 33 + c

MOV EAX,result

MOV ECX,result

SHL ECX,5

ADD ECX,DWORD(pv)

//todo remove: no need after Kylix released: ADD ECX,pvi

ADD EAX,ECX

MOV @result,EAX

end; {asm}

{$ENDIF}

inc(p);

end;

end;

if result=0 then result:=1; //avoid returning 0 = failure!

{$IFDEF DEBUGDETAIL10}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('Hash result=%d',[result]),vDebugLow); //assertion?

{$ENDIF}

{$ENDIF}

end; {Hash}

function THashIndexFile.slotCompare(ahashvalue:cardinal;arid:Trid;b:THashSlot):integer;

const routine=':slotCompare';

result:=0;

if ahashvalue>b.HashValue then

result:=+1

else

if ahashvalue<b.HashValue then

result:=-1

else //result=0

if arid.pid>b.rid.pid then

result:=+1

else

if arid.pid<b.rid.pid then

result:=-1

else //result=0

if arid.sid>b.rid.sid then

result:=+1

else

if arid.sid<b.rid.sid then

result:=-1;

end; {slotCompare}

function THashIndexFile.AddKeyPtr(st:TStmt;t:TTuple;rid:Trid):integer;

const routine=':AddKeyPtr';

function worthSplitting(rPid:PageId;newDepth:pageId;var lastP:Tpage):boolean;

{Checks whether it's worth splitting this page/chain