home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / bix / scan.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-08-04  |  2.7 KB  |  74 lines
  1. {Turbo version of UCSD 'scan' function}
  2. program tscan;
  3. const alpha:array[0..25] of char=
  4. ('a','b','c','d','e','f','g','h','i','j','k','l','m',
  5.  'n','o','p','q','r','s','t','u','v','w','x','y','z');
  6.  
  7. function scan(count,match:integer;var where):integer;
  8. {scans until match test is true}
  9. {returns count of bytes scanned, with sign indicating direction}
  10. var result,ans:integer;
  11.     equal,up:boolean;
  12. begin
  13. equal:=hi(match)=0;
  14. up:=count>=0;
  15. if not up then count:=-count;
  16. if not equal then match:=not match;
  17. if up then
  18. if equal then
  19. Inline($C4/$7E/<where/    {les  di,where[bp]}
  20.        $8B/$4E/<count/    {mov  cx,count[bp]}
  21.        $8A/$46/<match/    {mov  al,match[bp]}
  22.        $FC/               {cld}
  23.        $F2/$AE/           {repne  scasb}
  24.        $89/$4E/<result)    {mov  result,cx}
  25. else
  26. Inline($C4/$7E/<where/    {les  di,where[bp]}
  27.        $8B/$4E/<count/    {mov  cx,count[bp]}
  28.        $FC/               {cld}
  29.        $8A/$46/<match/    {mov  al,match[bp]}
  30.        $F3/$AE/           {rep  scasb}
  31.        $89/$4E/<result)   {mov  result,cx}
  32. else {not up}
  33. if equal then
  34. Inline($C4/$7E/<where/    {les  di,where[bp]}
  35.        $8B/$4E/<count/    {mov  cx,count[bp]}
  36.        $8A/$46/<match/    {mov  al,match[bp]}
  37.        $FD/               {std}
  38.        $F2/$AE/           {repne  scasb}
  39.        $89/$4E/<result)    {mov  result,cx}
  40. else
  41. Inline($C4/$7E/<where/    {les  di,where[bp]}
  42.        $8B/$4E/<count/    {mov  cx,count[bp]}
  43.        $FD/               {std}
  44.        $8A/$46/<match/    {mov  al,match[bp]}
  45.        $F3/$AE/           {rep  scasb}
  46.        $89/$4E/<result);  {mov  result,cx}
  47. if up then
  48.  if result=0 then ans:= count else ans:=pred(count-result)
  49. else
  50.  if result=0 then ans:=result-count else ans:=succ(result-count);
  51. scan:=ans;
  52. if result=0 then
  53.  if (mem[seg(where):ofs(where)+ans]<>match) xor equal then
  54.  if up then scan:=pred(ans) else scan:=succ(ans)
  55. end;
  56.  
  57. begin
  58. writeln('"',alpha,'"');
  59. writeln('scan(26,ord(''h''),alpha) = ',scan(26,ord('h'),alpha));
  60. writeln('scan(-26,ord(''t''),alpha[25]) = ',scan(-26,ord('t'),alpha[25]));
  61. writeln('scan(26,ord(''?''),alpha) = ',scan(26,ord('?'),alpha));
  62. writeln('scan(-26,ord(''?''),alpha[25]) = ',scan(-26,ord('?'),alpha[25]));
  63. writeln('scan(26,ord(''a''),alpha) = ',scan(26,ord('a'),alpha));
  64. writeln('scan(-26,ord(''z''),alpha[25]) = ',scan(-26,ord('z'),alpha[25]));
  65. fillchar(alpha,25,'a');writeln('"',alpha,'"');
  66. writeln('scan(26,not ord(''a''),alpha) = ',scan(26,not ord('a'),alpha));
  67. writeln('scan(26,not ord(''z''),alpha) = ',scan(26,not ord('z'),alpha));
  68. fillchar(alpha[1],25,'z');writeln('"',alpha,'"');
  69. writeln('scan(-26,not ord(''z''),alpha[25]) = ',scan(-26,not ord('z'),alpha[25]
  70. ));
  71. writeln('scan(-6,not ord(''z''),alpha[5]) = ',scan(-6,not ord('z'),alpha[5]));
  72. readln
  73. end.
  74.