Category : Pascal Source Code
Archive   : BMSEARCH.ZIP
Filename : OBM.PAS

{$R-,S-}
Unit OBM; {Object Boyer-Moore searching}

Interface

Uses
Country;

TYPE
CaseTable = ARRAY [CHAR] OF CHAR;

pBoyer_Moore = ^Boyer_Moore;
Boyer_Moore = Object
SkipTable : ARRAY [CHAR] OF BYTE;
CaseTab : CaseTable;
Pat_End,
Save_Len,
guard : WORD;
IgnoreCase : BOOLEAN;
pattern : STRING;

Constructor Init(pat : STRING; iCase : BOOLEAN);
Destructor Done;
Function Search(VAR buf; buflen : WORD): WORD; Virtual;
END;

VAR
LwrCaseTab : CaseTable;

Implementation

CONST
UNROLL_FACTOR = 8;

Function Boyer_Moore.Search(VAR buf;buflen:WORD):WORD;
Assembler;
VAR
Restart,
Buf_Ptr : WORD;
ASM
push ds
les di,[self]
mov dx,di
mov ax,[buflen]
cmp ax,Boyer_Moore([es:di]).Save_Len
jbe @NoMatch
std
lds si,[buf]
add ax,si { Guard pos after buffer }

add si,Boyer_Moore([es:di]).Save_Len { Last pos in buffer }
xor bx,bx
xor cx,cx
sub ax,Boyer_Moore([es:di]).guard { Guard distance }
jc @StartSingle
mov [Restart], offset @TestMulti

@TestMulti:
cmp si,ax
jae @StartSingle
@Top:
mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
add si,cx

mov bl,[si]
mov cl,[es:di+bx]
jcxz @FullCompare
add si,cx

cmp si,ax
jb @Top

@StartSingle:
add ax,Boyer_Moore([es:di]).guard { Guard distance }
mov [Restart], offset @TestSingle

@TestSingle:
cmp si,ax
jae @NoMatch
@SingleTop:
mov bl,[si]
mov cl,[es:di+bx]
jcxz @FullCompare
add si,cx
cmp si,ax
jb @SingleTop
@NoMatch:
mov ax,$FFFF
jmp @done

@FullCompare:
mov [Buf_Ptr],si
mov cx,Boyer_Moore([es:di]).Save_Len
jcxz @Match { In case of one-byte patttern }
dec si
mov di,Boyer_Moore([es:di]).Pat_End
@TestRest:
repe cmpsb
xchg dx,di { ES:DI -> Self }
je @Match
mov bl,[si+1]
mov bl,[es:di+bx+256] { CaseTable }
xchg dx,di { DI -> pattern, DX -> Self }
cmp bl,[es:di+1]
je @TestRest

mov bl,[si+1]
mov di,dx { ES:DI -> Self }
mov bl,[es:di+bx] { SkipTable }
neg cx
add cx,Boyer_Moore([es:di]).Save_Len { Distance from end }
sub bx,cx
mov cx,1
jbe @skip_ok
mov cx,bx
@skip_ok:
mov si,[Buf_Ptr]
add si,cx
xor bx,bx
jmp [Restart]
@Match:
mov ax,[Buf_Ptr]
sub ax,Boyer_Moore([es:di]).Save_Len
sub ax,word ptr [buf]
@Done:
cld
pop ds
END;

Constructor Boyer_Moore.Init(pat : STRING; iCase : BOOLEAN);
VAR
i, s, l : WORD;
BEGIN
l := Length(pat);
IF l = 0 THEN Fail;

IF iCase THEN BEGIN
pattern[0] := pat[0];
FOR i := 1 TO l DO
pattern[i] := LwrCaseTab[pat[i]];
END
ELSE
pattern := pat;

FillChar(SkipTable,SizeOf(SkipTable),l);
s := l;
FOR i := 1 TO l DO BEGIN
Dec(s);
SkipTable[pattern[i]] := s;
END;

Save_Len := l-1;
Pat_End := Ofs(pattern[Save_Len]);
guard := UNROLL_FACTOR * l;
{ guard := $F000; }
ignoreCase := iCase;

IF iCase THEN BEGIN
CaseTab := LwrCaseTab;
s := l;
FOR i := 1 TO l DO BEGIN
Dec(s);
SkipTable[DOS_Upcase(pattern[i])] := s;
END;
END
ELSE BEGIN
FOR i := 0 TO 255 DO
CaseTab[Chr(i)] := Chr(i);
END;
END;

Destructor Boyer_Moore.Done;
BEGIN
END;

Procedure InitLowerCase;
VAR
ch, uch : CHAR;
BEGIN
FOR ch := #0 TO #255 DO
LwrCaseTab[ch] := ch;
FOR ch := 'A' TO 'Z' DO
LwrCaseTab[ch] := Chr(Ord(ch) + 32);
FOR ch := #128 TO #255 DO BEGIN
uch := DOS_Upcase(ch);
IF (uch <> ch) AND (uch >= #128) THEN
LwrCaseTab[uch] := ch;
END;
END;

BEGIN
InitLowerCase;
END.