home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPA22.ZIP / TPA_FIND.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-22  |  6.7 KB  |  184 lines
  1. {═════════════════════════════ FIND.PAS ═════════════════════════════}
  2. { Usage:  Find                 (From Editor, just Run)               }
  3. {═════════════════════════════ FIND.PAS ═════════════════════════════}
  4.  
  5. {- This demonstration illustrates the advantage of using assembly    }
  6. {- language to improve execution speed of time consuming operations. }
  7. {- Searches about 30,000 bytes of memory for the string FindString   }
  8. {- and repeats 10 times.  On my 8MHz 8086 based machine this takes   }
  9. {- 0.7 seconds in assembly language and about 10 times that long in  }
  10. {- Pascal.  You can dramatically improve operations on large text    }
  11. {- files by using BlockRead (into a Buffer), Find(BufPtr,256,CrLf)   }
  12. {- (to find line ends), and Move (into a standard String variable)   }
  13. {- in place of repeated calls to ReadLn.                             }
  14.  
  15.  
  16. {═══════════════════════════════ Find ═══════════════════════════════}
  17. { Search memory (case sensitive) for string FindStr.  Return number  }
  18. { of characters skipped to find a match, or SearchLimit if no match  }
  19. { Checks entire FindStr even if end of FindStr is beyond SearchLimit }
  20. { Thus: Find(StartAddr,1,FindStr)=0 only if FindStr is at StartAddr  }
  21. {═══════════════════════════════ Find ═══════════════════════════════}
  22. FUNCTION Find( VAR StartAddr; SearchLimit:WORD; FindStr:STRING ): WORD;
  23. BEGIN
  24. ASSEMBLE
  25. ;- NOTE that the [Bp] specification required to reference parameters
  26. ;-  and local variables is supplied automatically by TP&Asm.
  27. ;-  You may code the [Bp]'s explicitly if you prefer ( StartAddr[Bp] ),
  28. ;-  and you may disable presumptions for "WYSIWYG" assembly.
  29. ;- Remember - TP&Asm knows how to find all your Pascal variables because
  30. ;-  it assembles during the compile step!
  31.  
  32.    Cld                ; Set forward direction for Lodsb/w and Cmpsb
  33.    Mov Cx,SearchLimit ; Maximum bytes to search
  34.    Mov Dx,Cx          ; Save in Dx
  35.    Les Di,StartAddr   ; point Es:[Di] to StartAddr
  36.  
  37.    Lea Si,FindStr     ; NOTE: String Value is located in Stack Segment
  38.    Lodsw              ; Al <-- Ss:[Si], Ah <-- Ss:[Si+1], Si <-- Si+2
  39.  
  40. ;- Lodsw normally loads from Ds:[Si], however TP&Asm correctly presumes
  41. ;-  and supplies the Ss override necessary to obtain access to FindStr.
  42. ;-  You may code the override explicitly if you prefer ( Ss LodsW ),
  43. ;-  and you may disable presumptions for "WYSIWYG" assembly.
  44.  
  45.    Xchg Ah,Al         ; Now FindStrLen is in Ah, FindStr[1] is in Al
  46.  
  47. ScanLoop:
  48.    RepNE Scasb        ; Fast Scan Es:[Di] for Al; Di <-- [match]+1
  49.    jNE Finish         ; If no match found, return SearchLimit saved in Dx
  50.    Push Cx,Di         ; Save Cx & Di in case this 'Find' is premature
  51.    Xor Ch,Ch          ; Clear Ch
  52.    Mov Cl,Ah          ; Load FindStrLen
  53.    Dec Cl             ; FindStr[1] has already been checked
  54. L1:
  55.    CmpsB              ; Compare Ss:[Si] =? Es:[Di], Inc Di, Inc Si
  56.    LoopE L1           ; Repeat while equal, Dec Cx
  57.    Pop Di,Cx          ; Restore Cx & Di, Find NEXT occurrance of Al
  58.    jNE ScanLoop       ; - Jmp only if exitted LoopE with NE (miscompare)
  59.    Inc Cx             ; Arrive here if string found
  60.    Sub Dx,Cx          ; Find number of bytes skipped
  61. Finish:
  62.    Mov Find,Dx        ; Put in function result
  63. END; {Assemble}
  64. END; {FUNCTION Find}
  65.  
  66.  
  67. {═════════════════════════════ PasFind ══════════════════════════════}
  68. { Same as FUNCTION Find but written in Pascal rather than Assembly   }
  69. {═════════════════════════════ PasFind ══════════════════════════════}
  70. FUNCTION PasFind(VAR StartAddr; SearchLimit:WORD; FindStr:STRING):WORD;
  71. VAR m,n:WORD;
  72.   FindArray: ARRAY[0..$7FF0] OF CHAR Absolute StartAddr;
  73. BEGIN
  74.   m := 0;
  75.   FOR n := 0 TO SearchLimit DO BEGIN
  76.     IF FindArray[n] = FindStr[1] THEN BEGIN
  77.       WHILE FindArray[n+m]=FindStr[1+m] DO m:=m+1;
  78.       IF m >= Length(FindStr) THEN BEGIN
  79.         PasFind := n; Exit;
  80.       END; {IF m >= Length(FindStr) THEN }
  81.       m := 0;
  82.     END; {IF FindArray[n] = FindStr[1] THEN }
  83.   END; {FOR n := 0 TO SearchLimit DO }
  84.   PasFind := SearchLimit;
  85. END; {FUNCTION PasFind}
  86.  
  87.  
  88. {═════════════════════════════ GetTime ══════════════════════════════}
  89. { Compatible with Version 4.0 to 5.5 DOS Unit Procedure.             }
  90. {═════════════════════════════ GetTime ══════════════════════════════}
  91. PROCEDURE GetTime( VAR Hour, Minute, Second, Hundredth: WORD);
  92. VAR HrMin, SecHn: WORD;
  93. BEGIN
  94.   Assembly
  95.     Mov Ah,2Ch
  96.     Int 21h        ; Get System time into Cx:Dx
  97.     Xor Ah,Ah
  98.     Mov Al,Ch      ; Now Ax = System hour
  99.  
  100.  ;- Use the parameter pointers to store VAR results in assembly language ..
  101.     Les Di,Hour    ; Es:[Di] points to Hour
  102.     Es Mov [Di],Ax ; Save Hour value in Es:[Di]
  103.  
  104.  ;- .. or save into local variables ..
  105.     Mov HrMin,Cx
  106.     Mov SecHn,Dx
  107.   End; {Assembly}
  108.  
  109.  {- .. and let the compiler do the work: -}
  110.   Minute := Lo(HrMin);
  111.   Second := Hi(SecHn);
  112.   Hundredth := Lo(SecHn);
  113. END; {PROCEDURE GetTime}
  114.  
  115.  
  116. {══════════════════ A couple of Display Functions ═══════════════════}
  117. TYPE Str2 = STRING[2];
  118. FUNCTION TwoDgt(N: WORD): Str2; VAR Tmp: Str2;
  119. BEGIN
  120.   Str(N:2,Tmp); IF N<10 THEN Tmp[1] := '0'; TwoDgt := Tmp;
  121. END; {FUNCTION TwoDgt}
  122.  
  123. TYPE Str12 = STRING[12];
  124. FUNCTION TimeDisplay: Str12;
  125. VAR  Hour, Minute, Second, Hundredth: WORD;
  126. BEGIN
  127.   GetTime( Hour, Minute, Second, Hundredth );
  128.   TimeDisplay := TwoDgt(Hour) +':' +TwoDgt(Minute) +':' +TwoDgt(Second)
  129.                +'.' +TwoDgt(Hundredth);
  130. END; {TimeDisplay}
  131.  
  132.  
  133. {════════════════════════════ WaitForKey ════════════════════════════}
  134. PROCEDURE WaitForKey;  {- Assembly/Inline Directive -}
  135. Assembly
  136.   Mov Ah,0
  137.   Int 16h
  138. END; {Assembly WaitForKey}
  139.  
  140.  
  141. VAR
  142.   BigArray: ARRAY[1..30000] OF BYTE;
  143.   FindString: String[80];
  144.   FindLoc,n : WORD;
  145.  
  146. CONST
  147.   MaxSearch = 32000;
  148.   Repeats = 10;
  149.  
  150. BEGIN
  151.  
  152.   FillChar(BigArray,SizeOf(BigArray),' ');
  153.   FindString := 'Find This String';
  154.  
  155.  
  156.   WRITELN(#13#10'Press a key to begin Assembly Find Test:'#13#10);
  157.   WaitForKey;
  158.   WRITELN('Started  search at ',TimeDisplay);
  159.  
  160.   FOR n := 1 TO Repeats DO FindLoc := Find(BigArray,MaxSearch,FindString);
  161.  
  162.   IF FindLoc = MaxSearch THEN WRITE('String NOT FOUND!')
  163.                          ELSE WRITE('Found at ',FindLoc);
  164.   WRITELN('   Should Find at: ', 1+ SizeOf(BigArray));
  165.   WRITELN('Finished search at ',TimeDisplay,#13#10);
  166.  
  167.  
  168.   WRITELN('Press a key to begin Pascal Find Test:'#13#10);
  169.   WaitForKey;
  170.   WRITELN('Started  search at ',TimeDisplay);
  171.  
  172.   FOR n := 1 TO Repeats DO FindLoc := PasFind(BigArray,MaxSearch,FindString);
  173.  
  174.   IF FindLoc = MaxSearch THEN WRITE('String NOT FOUND!')
  175.                          ELSE WRITE('Found at ',FindLoc);
  176.   WRITELN('   Should Find at: ', 1+ SizeOf(BigArray));
  177.   WRITELN('Finished search at ',TimeDisplay,#13#10);
  178.  
  179.  
  180.   WRITELN('Press a key to exit'#13#10);
  181.   WaitForKey;
  182.  
  183. END.
  184.