home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbopas / bmsearch.zip / SEARCHES.PAS < prev   
Pascal/Delphi Source File  |  1987-10-26  |  7KB  |  175 lines

  1. {$R-,S+,I-,D-,T-,F-,V-,B-,N-}
  2.  
  3. unit Searches;
  4.  
  5. { A unit for rapidly searching a buffer for a string.
  6.  
  7.   Version 1.00 - 10/26/1987 - First general release
  8.  
  9.   Scott Bussinger
  10.   Professional Practice Systems
  11.   110 South 131st Street
  12.   Tacoma, WA  98444
  13.   (206)531-8944
  14.   Compuserve 72247,2671
  15.  
  16.   BlockPos was originally written by Randy Forgaard for use with Turbo
  17.   Pascal version 3.0.
  18.  
  19.   The Boyer-Moore routines were originally written by Van Hall for Turbo
  20.   Pascal version 3.0 and have been extensively rearranged for optimum use
  21.   with Turbo Pascal 4.0.  Note that the Boyer-Moore routines are MUCH, MUCH
  22.   slower than using BlockPos (which is written with inline code). }
  23.  
  24.  
  25. interface
  26.  
  27. function BlockPos(var Buffer;Size: word;S: string): integer;
  28.   { Search in Buffer of Size bytes for the string S }
  29.  
  30. type BoyerTable = record
  31.        Match: string;
  32.        MatchLength: byte;
  33.        Table: array[char] of byte
  34.        end;
  35.  
  36. procedure MakeBoyerTable(MatchString: string;var Table: BoyerTable);
  37.   { Generate the necessary table for doing a Boyer-Moore search }
  38.  
  39. function BoyerMoore(var BufferAddr;Size: word;Start: word;var Table: BoyerTable): word;
  40.   { Search a Buffer of Size characters beginning at Start for the match string defined in Table }
  41.  
  42.  
  43. implementation
  44.  
  45. function BlockPos(var Buffer;Size: word;S: string): integer;
  46.   { Search in Buffer of Size bytes for the string S }
  47.   begin
  48.   { Load "buffer" address into ES:DI, "buffer" offset into BX, Length(s) -
  49.     1 into DX, contents of "s[1]" into AL, offset of "s[2]" into SI, and
  50.     "size" - Length(s) + 1 into CX.  If "size" < Length(s), or if
  51.     Length(s) = 0, return zero. }
  52.  
  53.   Inline($1E/               {        PUSH    DS           }
  54.          $16/               {        PUSH    SS           }
  55.          $1F/               {        POP     DS           }
  56.          $C4/$BE/>buffer/   {        LES     DI,buffer[BP]}
  57.          $89/$FB/           {        MOV     BX,DI        }
  58.          $8B/$8E/>size/     {        MOV     CX,size[bp]  }
  59.          $8D/$B6/>s+2/      {        LEA     SI,s+2[bp]   }
  60.          $8A/$86/>s+1/      {        MOV     AL,s+1[bp]   }
  61.          $8A/$96/>s/        {        MOV     DL,s[bp]     }
  62.          $84/$D2/           {        TEST    DL,DL        }
  63.          $74/$23/           {        JZ      ERROR        }
  64.          $FE/$CA/           {        DEC     DL           }
  65.          $30/$F6/           {        XOR     DH,DH        }
  66.          $29/$D1/           {        SUB     CX,DX        }
  67.          $76/$1B/           {        JBE     ERROR        }
  68.  
  69.   { Scan the ES:DI buffer, looking for the first occurrence of "s[1]."  If
  70.     not found prior to reaching Length(s) characters before the end of the
  71.     buffer, return zero.  If Length(s) = 1, the entire string has been
  72.     found, so report success. }
  73.  
  74.        $FC/               {        CLD                  }
  75.        $F2/               {NEXT:   REPNE                }
  76.        $AE/               {        SCASB                }
  77.        $75/$16/           {        JNE     ERROR        }
  78.        $85/$D2/           {        TEST    DX,DX        }
  79.        $74/$0C/           {        JZ      FOUND        }
  80.  
  81.   { Compare "s" (which is at SS:SI) with the ES:DI buffer, in both cases
  82.     starting with the first byte just past the length byte of the string.
  83.     If "s" does not match what is at the DI position of the buffer, reset
  84.     the registers to the values they had just prior to the comparison, and
  85.     look again for the next occurrence of the length byte. }
  86.  
  87.          $51/               {        PUSH    CX           }
  88.          $57/               {        PUSH    DI           }
  89.          $56/               {        PUSH    SI           }
  90.          $89/$D1/           {        MOV     CX,DX        }
  91.          $F3/               {        REPE                 }
  92.          $A6/               {        CMPSB                }
  93.          $5E/               {        POP     SI           }
  94.          $5F/               {        POP     DI           }
  95.          $59/               {        POP     CX           }
  96.          $75/$EC/           {        JNE     NEXT         }
  97.  
  98.   { String found in buffer.  Set AX to the offset, within buffer, of the
  99.     first byte of the string (the length byte), assuming that the first
  100.     byte of the buffer is at offset 1. }
  101.  
  102.          $89/$F8/           {FOUND:  MOV     AX,DI        }
  103.          $29/$D8/           {        SUB     AX,BX        }
  104.          $EB/$02/           {        JMP     SHORT RETURN }
  105.  
  106.   { An "error" condition.  Return zero. }
  107.  
  108.          $31/$C0/           {ERROR:  XOR     AX,AX        }
  109.          $89/$46/$FE/       {RETURN: MOV     [BP-2],AX    }
  110.          $1F)               {        POP     DS           }
  111.   end;
  112.  
  113. procedure MakeBoyerTable(MatchString: string;var Table: BoyerTable);
  114.   { Generate the necessary table for doing a Boyer-Moore search }
  115.   var Counter: byte;
  116.   begin
  117.   with Table do
  118.     begin
  119.     Match := MatchString;
  120.     MatchLength := length(MatchString);
  121.     fillChar(Table,sizeof(Table),MatchLength);
  122.     if MatchLength > 0 then
  123.       for Counter := pred(MatchLength) downto 1 do
  124.         if Table[Match[Counter]] = MatchLength then
  125.             Table[Match[Counter]] := MatchLength-Counter
  126.     end
  127.   end;
  128.  
  129. function BoyerMoore(var BufferAddr;Size: word;Start: word;var Table: BoyerTable): word;
  130.   { Search a Buffer of Size characters beginning at Start for the match string defined in Table }
  131.   type Ptr = record
  132.          case integer of
  133.            0: (Ptr: ^char);
  134.            1: (Offset: word;
  135.                Segment: word)
  136.          end;
  137.   var Buffer: array[1..$FFF1] of char absolute BufferAddr;
  138.       BufferPtr: Ptr;
  139.       BufferEndOfs: word;
  140.       MatchPtr: Ptr;
  141.       MatchEndPtr: Ptr;
  142.   begin
  143.   with Table do
  144.     if MatchLength = 0                           { Are we looking for an empty string? }
  145.      then
  146.       BoyerMoore := 0
  147.      else
  148.       begin
  149.       MatchEndPtr.Ptr := @Match[MatchLength];
  150.       MatchPtr := MatchEndPtr;
  151.       BufferPtr.Ptr := @Buffer[pred(Start+MatchLength)];
  152.       BufferEndOfs := ofs(Buffer[Size]);
  153.       repeat
  154.         if BufferPtr.Ptr^ = MatchPtr.Ptr^
  155.          then
  156.           begin
  157.           dec(BufferPtr.Offset);
  158.           dec(MatchPtr.Offset)
  159.           end
  160.          else
  161.           begin
  162.           MatchPtr := MatchEndPtr;
  163.           inc(BufferPtr.Offset,Table[BufferPtr.Ptr^])
  164.           end
  165.       until (MatchPtr.Ptr=@Match) or (ofs(BufferPtr.Ptr^)>=BufferEndOfs);
  166.       if MatchPtr.Ptr = @Match
  167.        then
  168.         BoyerMoore := ofs(BufferPtr.Ptr^) - ofs(Buffer) + 2
  169.        else
  170.         BoyerMoore := 0
  171.       end
  172.   end;
  173.  
  174. end.
  175.