home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / strings.swg / 0112_Strnig Patterns.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-26  |  5.0 KB  |  133 lines
  1. Unit USPat; {String pattern a-la Messy-DOS}
  2. { (C) 1994 William Arthur Barath.   Permission granted for free use in
  3.   Commercial and Non-Commercial software. }
  4.  
  5. { written oct 17/94 for TOMMY by WSEM at the request of Weird Al}
  6. { For use in UFO's text/file scanner.  Fast enough? }
  7.  
  8. Interface
  9.  
  10. Type pString = ^String;
  11. Var SpatStr:pString;
  12.  
  13. Procedure UpCaseStr(Var s:String);
  14. {call to convert a VAR ARG string to upper case.  Don't use w/ PCHAR!}
  15. Procedure SetSPat(Var s:String);
  16. {call to set the pattern to test against with each following call to
  17.  Spat.  This sets a global pointer to the given string and converts that
  18.  string to a format that can be read optimally fast, which saves passing
  19.  the pattern arguement to the SPat PROC via the stack, which saves many
  20.  many clock cycles and memory R\W accesses. 'S' *must* be a string of at
  21.  least 12 characters, or a typecast region of memory of at least 13 bytes
  22.  formatted as a Pascal-style STRING or ugly things may happen.}
  23. Function SPat(Var s:String):Boolean;
  24. {tests the given VAR ARG string against the string pattern pointed to by
  25.  the Public SpatStr global pointer.  Passing a VAR ARG takes much less
  26.  time since only a 4-byte pointer is pushed onto the stack prior to calling
  27.  this PROC, as opposed to a full STRING, which may be 256 bytes and would 
  28. be
  29.  pushed a single char at a time... yawn...}
  30. Function UCSPat(Var s:String):Boolean;
  31. {tests the given VAR ARG string against the string pattern pointed to by
  32.  the Public SpatStr global pointer.  Passing a VAR ARG takes much less
  33.  time since only a 4-byte pointer is pushed onto the stack prior to calling
  34.  this PROC, as opposed to a full STRING, which may be 256 bytes and would 
  35. be
  36.  pushed a single char at a time... yawn... Works with UPCASE'd data}
  37.  
  38. Implementation
  39.  
  40. Procedure UpCaseStr(Var s:String);assembler;
  41. {up to 15 times faster than Borland's ASM demo code}
  42. asm Push ds;Lds si,s;Xor ch,ch;Lodsb;Mov cl,al;Jcxz @Done;Mov dx,'az';
  43. Mov ah,'a'-'A';Mov bx,-1;@Loop: Lodsb;Cmp al,dh;Jb @Upper;Cmp al,dl;
  44. ja @Upper;Sub al,ah;Mov [si+bx],al;@Upper: Loop @Loop;@Done: Pop ds;end;
  45.  
  46. Procedure SetSPat(Var s:String);
  47. {I'd write this in ASM as well, but it isn't likely to enter a loop so
  48.  speed isn't really critical, and it may be useful to edit this to alter
  49.  the personality of the pattern matching algorhythm.}
  50. Type str12 = String[12];
  51. Var l,p:Word;pat:Str12;
  52. Begin
  53.   If s[0]=#0 then s:='*.*';
  54.    UpCaseStr(s);p:=1;
  55.    For l:=1 to 12 do Case s[p] of
  56.      '*':If l=9 then Begin Dec(l);Inc(p);end else pat[l]:='?';
  57.      '.':If l=9 then Begin pat[l]:='.';Inc (p);end else pat[l]:=' ';
  58.      Else Begin pat[l]:=s[p];If Char(p)<s[0] then Inc(p);end;
  59.    end;
  60.   Pat[0]:=Char(l);
  61.   s:=pat;SPatStr:=@s;
  62. end;
  63.  
  64. Function SPat(Var s:String):Boolean;assembler;
  65. asm
  66.   Push ds           {do this or die... :-) }
  67.     Lds si,SpatStr  {location of the pattern string}
  68.     Les di,s        {location of the test string}
  69.     Lodsb
  70.     Mov cl,es:[di]  {length of the test string}
  71.     xor ch,ch
  72.     Jcxz @BadMatch  {if the test string is NULL then never match}
  73.     Inc di
  74. @Search:
  75.     Mov ah,es:[di]
  76.     Cmp ah,'a'
  77.     Jb  @Search2
  78.     Cmp ah,'z'
  79.     Ja  @Search2
  80.     Sub ah,'a'-'A'  {convert the test string char to CAPS}
  81. @Search2:
  82.     Lodsb           {read and advance a char in pattern}
  83.     Cmp ah,al
  84.     Jz  @Match2     {if the characters are = }
  85.     Cmp al,'?'
  86.     Jnz @BadMatch   {pattern didn't match}
  87. @Match:
  88.     Cmp ah,'.'      {if '?' tries to match a dot, we try the next}
  89.     jz  @search2    {char, which should be either '.' or '?'}
  90. @Match2:
  91.     Inc di          {advance to the next test string char}
  92.     Loop @Search    {test for # of chars in test string}
  93.     Mov al,True
  94.     Jnz @Done       {return 'True'}
  95. @BadMatch:
  96.     xor ax,ax       {return 'False'}
  97. @Done:
  98.   Pop ds            {do this or die... :-) }
  99. end;
  100. Function UCSPat(Var s:String):Boolean;assembler;
  101. asm
  102.   Push ds           {do this or die... :-) }
  103.     Lds si,SpatStr  {location of the pattern string}
  104.     Les di,s        {location of the test string}
  105.     Mov cl,[di]     {length of the test string}
  106.     xor ch,ch
  107.     Jcxz @Bad       {if the test string is NULL then never match}
  108.     Inc cx          {use length+1, so when we hit 0 we know we're done}
  109.     CMPSB           {sneaky way to INC DI and INC SI with one byte :-) }
  110.     Mov dx,'?.'
  111.     Mov bx,-1       {offset to last character.  faster than using immed. 
  112. data}
  113. @Search:
  114.     REPZ CMPSB      {compare bytes until one doesn't match or CX = 0}
  115.     Jcxz @Good      {when we hit 0, we're done.  Last comparison was 
  116. garbage}
  117.     cmp dh,[si+bx]  {If last pattern byte <> '?' then match is bad}
  118.     Jnz @Bad
  119.     cmp dl,[di+bx]  {If last test byte <> '.' then check next chars}
  120.     Jnz @Search
  121.     Dec di          {otherwise, make sure remaining pattern chars}
  122.     Inc cx          {are '?'.  Otherwise, pattern should fail}
  123.     Jmp @Search
  124. @Good:
  125.     Inc ch          {change the exit condition in ch from 0 to 1}
  126. @Bad:
  127.     Mov al,ch
  128.   Pop ds            {do this or die... :-) }
  129. end;
  130. end.
  131.  
  132.  
  133.