home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / searches.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-14  |  8.4 KB  |  226 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. A Turbo Pascal 4.0 unit for rapidly searching a buffer for a string.
  37. Version 1.0. Author Scott Bussinger.
  38.  
  39. * ASSOCIATED FILES
  40. SEARCHES.PAS
  41. BOYER.DOC
  42. SEARCHES.DOC
  43.  
  44. * CHECKED BY
  45. DRM - 08/14/88
  46.  
  47. * KEYWORDS
  48. TURBO PASCAL V4.0 SEARCH INLINE
  49.  
  50. ==========================================================================
  51. }
  52. {$R-,S+,I-,D-,T-,F-,V-,B-,N-}
  53.  
  54. unit Searches;
  55.  
  56. { A unit for rapidly searching a buffer for a string.
  57.  
  58.   Version 1.00 - 10/26/1987 - First general release
  59.  
  60.   Scott Bussinger
  61.   Professional Practice Systems
  62.   110 South 131st Street
  63.   Tacoma, WA  98444
  64.   (206)531-8944
  65.   Compuserve 72247,2671
  66.  
  67.   BlockPos was originally written by Randy Forgaard for use with Turbo
  68.   Pascal version 3.0.
  69.  
  70.   The Boyer-Moore routines were originally written by Van Hall for Turbo
  71.   Pascal version 3.0 and have been extensively rearranged for optimum use
  72.   with Turbo Pascal 4.0.  Note that the Boyer-Moore routines are MUCH, MUCH
  73.   slower than using BlockPos (which is written with inline code). }
  74.  
  75.  
  76. interface
  77.  
  78. function BlockPos(var Buffer;Size: word;S: string): integer;
  79.   { Search in Buffer of Size bytes for the string S }
  80.  
  81. type BoyerTable = record
  82.        Match: string;
  83.        MatchLength: byte;
  84.        Table: array[char] of byte
  85.        end;
  86.  
  87. procedure MakeBoyerTable(MatchString: string;var Table: BoyerTable);
  88.   { Generate the necessary table for doing a Boyer-Moore search }
  89.  
  90. function BoyerMoore(var BufferAddr;Size: word;Start: word;var Table: BoyerTable): word;
  91.   { Search a Buffer of Size characters beginning at Start for the match string defined in Table }
  92.  
  93.  
  94. implementation
  95.  
  96. function BlockPos(var Buffer;Size: word;S: string): integer;
  97.   { Search in Buffer of Size bytes for the string S }
  98.   begin
  99.   { Load "buffer" address into ES:DI, "buffer" offset into BX, Length(s) -
  100.     1 into DX, contents of "s[1]" into AL, offset of "s[2]" into SI, and
  101.     "size" - Length(s) + 1 into CX.  If "size" < Length(s), or if
  102.     Length(s) = 0, return zero. }
  103.  
  104.   Inline($1E/               {        PUSH    DS           }
  105.          $16/               {        PUSH    SS           }
  106.          $1F/               {        POP     DS           }
  107.          $C4/$BE/>buffer/   {        LES     DI,buffer[BP]}
  108.          $89/$FB/           {        MOV     BX,DI        }
  109.          $8B/$8E/>size/     {        MOV     CX,size[bp]  }
  110.          $8D/$B6/>s+2/      {        LEA     SI,s+2[bp]   }
  111.          $8A/$86/>s+1/      {        MOV     AL,s+1[bp]   }
  112.          $8A/$96/>s/        {        MOV     DL,s[bp]     }
  113.          $84/$D2/           {        TEST    DL,DL        }
  114.          $74/$23/           {        JZ      ERROR        }
  115.          $FE/$CA/           {        DEC     DL           }
  116.          $30/$F6/           {        XOR     DH,DH        }
  117.          $29/$D1/           {        SUB     CX,DX        }
  118.          $76/$1B/           {        JBE     ERROR        }
  119.  
  120.   { Scan the ES:DI buffer, looking for the first occurrence of "s[1]."  If
  121.     not found prior to reaching Length(s) characters before the end of the
  122.     buffer, return zero.  If Length(s) = 1, the entire string has been
  123.     found, so report success. }
  124.  
  125.        $FC/               {        CLD                  }
  126.        $F2/               {NEXT:   REPNE                }
  127.        $AE/               {        SCASB                }
  128.        $75/$16/           {        JNE     ERROR        }
  129.        $85/$D2/           {        TEST    DX,DX        }
  130.        $74/$0C/           {        JZ      FOUND        }
  131.  
  132.   { Compare "s" (which is at SS:SI) with the ES:DI buffer, in both cases
  133.     starting with the first byte just past the length byte of the string.
  134.     If "s" does not match what is at the DI position of the buffer, reset
  135.     the registers to the values they had just prior to the comparison, and
  136.     look again for the next occurrence of the length byte. }
  137.  
  138.          $51/               {        PUSH    CX           }
  139.          $57/               {        PUSH    DI           }
  140.          $56/               {        PUSH    SI           }
  141.          $89/$D1/           {        MOV     CX,DX        }
  142.          $F3/               {        REPE                 }
  143.          $A6/               {        CMPSB                }
  144.          $5E/               {        POP     SI           }
  145.          $5F/               {        POP     DI           }
  146.          $59/               {        POP     CX           }
  147.          $75/$EC/           {        JNE     NEXT         }
  148.  
  149.   { String found in buffer.  Set AX to the offset, within buffer, of the
  150.     first byte of the string (the length byte), assuming that the first
  151.     byte of the buffer is at offset 1. }
  152.  
  153.          $89/$F8/           {FOUND:  MOV     AX,DI        }
  154.          $29/$D8/           {        SUB     AX,BX        }
  155.          $EB/$02/           {        JMP     SHORT RETURN }
  156.  
  157.   { An "error" condition.  Return zero. }
  158.  
  159.          $31/$C0/           {ERROR:  XOR     AX,AX        }
  160.          $89/$46/$FE/       {RETURN: MOV     [BP-2],AX    }
  161.          $1F)               {        POP     DS           }
  162.   end;
  163.  
  164. procedure MakeBoyerTable(MatchString: string;var Table: BoyerTable);
  165.   { Generate the necessary table for doing a Boyer-Moore search }
  166.   var Counter: byte;
  167.   begin
  168.   with Table do
  169.     begin
  170.     Match := MatchString;
  171.     MatchLength := length(MatchString);
  172.     fillChar(Table,sizeof(Table),MatchLength);
  173.     if MatchLength > 0 then
  174.       for Counter := pred(MatchLength) downto 1 do
  175.         if Table[Match[Counter]] = MatchLength then
  176.             Table[Match[Counter]] := MatchLength-Counter
  177.     end
  178.   end;
  179.  
  180. function BoyerMoore(var BufferAddr;Size: word;Start: word;var Table: BoyerTable): word;
  181.   { Search a Buffer of Size characters beginning at Start for the match string defined in Table }
  182.   type Ptr = record
  183.          case integer of
  184.            0: (Ptr: ^char);
  185.            1: (Offset: word;
  186.                Segment: word)
  187.          end;
  188.   var Buffer: array[1..$FFF1] of char absolute BufferAddr;
  189.       BufferPtr: Ptr;
  190.       BufferEndOfs: word;
  191.       MatchPtr: Ptr;
  192.       MatchEndPtr: Ptr;
  193.   begin
  194.   with Table do
  195.     if MatchLength = 0                           { Are we looking for an empty string? }
  196.      then
  197.       BoyerMoore := 0
  198.      else
  199.       begin
  200.       MatchEndPtr.Ptr := @Match[MatchLength];
  201.       MatchPtr := MatchEndPtr;
  202.       BufferPtr.Ptr := @Buffer[pred(Start+MatchLength)];
  203.       BufferEndOfs := ofs(Buffer[Size]);
  204.       repeat
  205.         if BufferPtr.Ptr^ = MatchPtr.Ptr^
  206.          then
  207.           begin
  208.           dec(BufferPtr.Offset);
  209.           dec(MatchPtr.Offset)
  210.           end
  211.          else
  212.           begin
  213.           MatchPtr := MatchEndPtr;
  214.           inc(BufferPtr.Offset,Table[BufferPtr.Ptr^])
  215.           end
  216.       until (MatchPtr.Ptr=@Match) or (ofs(BufferPtr.Ptr^)>=BufferEndOfs);
  217.       if MatchPtr.Ptr = @Match
  218.        then
  219.         BoyerMoore := ofs(BufferPtr.Ptr^) - ofs(Buffer) + 2
  220.        else
  221.         BoyerMoore := 0
  222.       end
  223.   end;
  224.  
  225. end.
  226.