home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STRNFST2.ZIP / STRNFST2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-01-20  |  48.5 KB  |  848 lines
  1. (*
  2. STRNFST2.PAS                 January 19, 1987
  3.  
  4.           This is an updated version of the file Strngfst.Pas.
  5. It adds eight new routines, flipcount, posafter, poscafter,
  6. stripcountl, count, equal-structures, howmany, and stringup.  
  7. StripR has been slightly modified.  The documentation that 
  8. appears below is basically the original documentation from 
  9. February 3, 1986, with indications of what is new.  
  10.  
  11.           This is a collection of Inline string manipulation
  12. routines intended for use with Turbo Pascal Version 3.  They may
  13. work in Turbo Version 2, but I'm not sure.  I wrote most of 
  14. these, and I am a complete novice with assembly language -- 
  15. errors are possible.  In addition, there are two routines, 
  16. Flipchar and Stripchar, written by Mitch Lazarus and one routine 
  17. taken almost directly from the Turbo manual.  In all cases, the 
  18. invaluable Inline.Com, by Dave Baldwin, created the Inline 
  19. statements.  
  20.  
  21.           These routines do nothing that you could not do
  22. perfectly well without them.  The reason to use them is that
  23. Inline code is faster than the same things done without Inline
  24. code.  How much faster?  It depends on which routine, the nature
  25. of the strings you are using the routine on, and how you would
  26. otherwise code the procedure.  In some cases, the increase in
  27. speed is very substantial; in others it is not.  I get a little 
  28. more specific in a few places below, but not much.  
  29.  
  30.           The string you are manipulating is passed as an untyped
  31. variable parameter; it can be any string type.  SwapSubstring has
  32. two other string parameters of type Longstring.  You have to
  33. declare Longstring as some string type, but you can pass the
  34. parameters as string literals.  I could not figure out how to
  35. pass string literals without typing the formal parameter.  The 
  36. functions generally require that Longstring be declared as 
  37. String[255].  
  38.  
  39.           Comments and suggestions are welcome.  Leave a message 
  40. on Robert Blacher's board,  202-547-2008.  
  41.  
  42.  
  43.                                    David Seidman
  44.                                    2737 Devonshire Pl. NW
  45.                                    Washington, DC 20008
  46.  
  47. The Routines:
  48.  
  49. (In what follows, where I say a routine is significantly faster
  50. than another way of performing the function, it probably means
  51. you gain roughly a second or more on a thousand uses of the
  52. procedure, but you may gain more than that.  Very significantly
  53. faster is better than that -- in tests on some routines, I have
  54. found differences of a factor of nearly 30 between the Inline
  55. routine and perhaps non-optimal Turbo coding.)
  56.  
  57. NEW FUNCTION:
  58. Function PosAfter(find:longstring; var tline; after:integer):integer;
  59.  
  60.          This is like the Turbo POS function, except that it
  61. begins looking for the object string after position "after" in
  62. the target string "tline".  If you set After to 0, PosAfter is
  63. identical to Pos.  You can nest calls. Thus
  64. PosAfter('cat',tline, PosAfter('cat',tline,0) returns the
  65. starting position of the second instance of 'cat' in string
  66. Tline.
  67.  
  68. Function Posc (find:char; var tst);Integer;
  69.  
  70.     This is just like the Turbo POS function, except that the
  71. Object is a character rather than a string.  It is very slightly
  72. faster than POS used with a character object.  Useful only if
  73. your program uses it an enormous amount.
  74.  
  75. NEW FUNCTION:
  76. Function PosCAfter(FIND:Char; Var TST; N:Integer):Integer;
  77.  
  78.           PosCAfter is to PosAfter as PosC is to Pos.
  79.  
  80. Procedure StripL (var tst; strp:char);
  81.  
  82.     Strips all leading characters strp from string tst.  Probably
  83. significantly faster than non-Inline versions.
  84.  
  85. NEW FUNCTION:
  86. Function StripCountL(var tst;strp:char):integer;
  87.  
  88.           StripCountL is just like StripL, except that it
  89. returns the number of characters stripped.
  90.  
  91. Procedure StripR (var tst; strp:char);
  92.  
  93.    Strips all trailing characters strp from string tst.  Slightly
  94. faster than optimal non-Inline coding, significantly faster than
  95. non-optimal coding. MODIFIED: apparently did not work well with
  96. strings not declared globally.  Now should handle them.
  97.  
  98. Procedure StripThrough (var tst; strp:char);
  99.  
  100.    Strips string tst from the left up to and including the first
  101. instance of character strp.  Significantly faster than non-
  102. Inline.
  103.  
  104. Procedure SwapSubstring (var tline; find, repl:longstring; var
  105.                          enough:boolean; limit:byte);
  106.  
  107.    Replaces all instances of substring Find in string Tline with
  108. substring Repl (except as described below).  Find and Repl may be
  109. string literals.  Repl may be shorter than, longer than, or the
  110. same length as Find.  If Repl is null, Find is simply stripped
  111. from the string.  Where Repl is longer than Find, the routine
  112. will stop replacing when the next replacement would make the
  113. string longer than Limit bytes.  Enough returns True unless the
  114. routine stopped replacing for that reason, in which case it
  115. returns False.  Longstring may be any string type.
  116.  
  117.    SwapSubstring is likely to be very significantly faster than
  118. non-Inline coding (except where Find and Repl are of equal
  119. length, where awkward Turbo coding will be almost as fast).  The
  120. improvement may be largest where Repl contains Find as a
  121. substring, as in replacing "dog" by "doggie".  SwapSubstring will
  122. do everything that FlipChar and StripChar (described below) will
  123. do, but they are slightly faster at what they do.
  124.  
  125. Procedure Stupcase (var tline);
  126.  
  127.   String UpCase -- makes all lowercase characters in string tline
  128. uppercase.  A very slight modification of the routine in the
  129. Turbo manual.  Slightly faster than non-Inline coding.
  130.  
  131. NEW FUNCTION:
  132.  
  133. Function Stringup(var tline):longstring;
  134.  
  135.          StringUp is just like Stupcase, except that it returns
  136. the upper cased string as the function result and leaves the
  137. parameter unaltered.
  138.  
  139. Procedure LowCase (var tline);
  140.  
  141.   Makes all uppercase characters in string Tline lowercase.  An
  142. obvious modification of Stupcase.  Depending on how you would do
  143. this in Turbo, could be very significantly faster.  (For i := 1
  144. to length(tline) do if tline[i] in [A..Z] is very slow, but if
  145. tline[i] >= 'A' and tline[i] <='Z' is faster.)
  146.  
  147. Procedure FlipChar (var tst; srch, repl:char);
  148.  
  149.   Replaces all instances of character scrch in string tst with
  150. char repl.  May be very significantly faster than alternative
  151. coding; slightly faster than SwapSubstring.
  152.  
  153. NEW FUNCTION:
  154. Function FlipCount(var tst;srch,repl:char):integer;
  155.  
  156.   Just like FlipChar, except that it returns as the function
  157. result the number of times it did the replacement.
  158.  
  159. Procedure StripChar(var tst; strp:char);
  160.  
  161.   Strips out all instances of character Strp from string tst.
  162. Very significantly faster than non-Inline coding, slightly faster
  163. than SwapSubstring.
  164.  
  165. NEW FUNCTION:
  166. Function Count (var tst; srch:char):integer;
  167.  
  168.      Returns the number of instances of srch in string tst.  Does 
  169. not alter the string.
  170.  
  171. NEW FUNCTION
  172. Function HowMany(var str1,str2):integer;
  173.  
  174.      Compares two strings character by character up to the length 
  175. of the shorter one.  Returns the number of characters before the 
  176. first time the characters are different.
  177.  
  178. NEW FUNCTION:
  179. Function Equal_Structures(var a,b;size:integer):boolean;
  180.  
  181.    This is not exactly a string function.  It compares two 
  182.  structures of size bytes.  Returns true of they are equal, false 
  183.  if they are not.  Useful for comparing parts of strings.  For 
  184. example, if you are reading strings of length >3 and want to 
  185. see if they begins with 'cat', set str1 := 'cat'; and then 
  186. compare for equality with str2 this way:
  187.    equal_structures(str1[1],str2[1],length(str1))
  188.  
  189.    A slightly incorrect version of this function was included in
  190. Longint.arc, I collection of routines for manipulating long 
  191. integers.  That one words only if size is one more than the 
  192. number of bytes to compare.
  193.  
  194.  
  195. *)
  196. Function PosAfter(find:longstring; var tline; after:integer):integer;
  197. begin
  198. Inline(
  199.                               {;INLINE code for Function}
  200.                               {; PosAfter(find:longstring;var tline; after:integer):integer;}
  201.                               {;tline is a string of any type.  Find is string of}
  202.                               {;type longstring, but may be literal (e.g., 'abc','').}
  203.                               {;Longstring must be string[255].}
  204.                               {;Find may be any string type if compiler set appropriately}
  205.                               {;finds first instance of find after tline[after] }
  206.                               {;Returns zero if not found, otherwise the position find starts in}
  207.   $1E                         {          push      ds}
  208.   /$8A/$96/>FIND              {          mov       dl, [>find[bp]]     ;store length of find}
  209.   /$8A/$86/>FIND+$0001        {          mov       al,[>find[bp]+1]    ;store first find character in al}
  210.   /$C7/$86/$0A/$01/$00/$00    {          mov       wo[bp+266],0         ;result of no match}
  211.   /$C4/$BE/>TLINE             {          les       di, >tline[BP]      ;address of string to modify}
  212.   /$8C/$C3                    {          mov       bx,es               ;match segments}
  213.   /$8E/$DB                    {          mov       ds,bx}
  214.   /$31/$C9                    {          xor       cx,cx               ;zero out cx}
  215.   /$8A/$0D                    {          mov       cl,[di]             ;length tline to cl}
  216.   /$E3/$2E                    {          jcxz      quit                ;exit if tline null}
  217.   /$89/$CB                    {          mov       bx,cx               ;save length}
  218.   /$2B/$8E/>AFTER             {          sub       cx, >after[bp]}
  219.   /$7E/$26                    {          jle       quit}
  220.   /$03/$BE/>AFTER             {          add       di, >after[bp]      ;move to char to begin after}
  221.   /$47                        {j2:       inc       di                  ;to after it}
  222.   /$38/$D1                    {scan:     cmp       cl, dl              ;is remaining string>find?}
  223.   /$72/$1D                    {          jb        quit                ;exit if not enough left for a match}
  224.   /$FC                        {          cld                           ;move forwards}
  225.   /$F2/$AE                    {repne     scasb                         ;search for first char}
  226.   /$75/$18                    {          jne       quit                ;exit if not found}
  227.   /$51                        {          push      cx                  ;save no. of bytes left after match}
  228.   /$4F                        {          dec       di                  ;to match position}
  229.   /$57                        {          push      di                  ;save position after match}
  230.   /$8D/$B6/>FIND+$0001        {          lea       si, >find[bp]+1}
  231.   /$88/$D1                    {          mov       cl, dl              ;get length of find string}
  232.   /$F3/$36/$A6                {repe   ss:cmpsb                         ;match on find string?}
  233.   /$5F                        {          pop       di                  ;start of match test}
  234.   /$59                        {          pop       cx                  ;bytes then remaining}
  235.   /$75/$E6                    {          jne       j2                  ;cycle if no match}
  236.                               {;gets here if you found a match. }
  237.   /$F7/$D9                    {          neg       cx                 ;negative start}
  238.   /$01/$D9                    {          add       cx,bx              ;add new and old length}
  239.   /$89/$8E/$0A/$01            {          mov       [bp+266],cx         ;}
  240.   /$1F                        {quit:     pop       ds}
  241. );
  242. end;
  243.  
  244. (*--------------------------------------------------*)
  245. function posc(find:char;var tst):integer;
  246. begin
  247. Inline(
  248.                               {;code for posc -- a single character version of pos}
  249.   $1E                         {          push      ds   ;initialize}
  250.   /$C4/$BE/>TST               {          les       di,>tst[bp]    ;get string length}
  251.   /$8C/$C0                    {          mov       ax,es}
  252.   /$8E/$D8                    {          mov       ds,ax}
  253.   /$C7/$46/$0A/$00/$00        {          mov       wo [bp+10],0    ;result if nothing found or }
  254.                               {                                   ; length 0}
  255.   /$8A/$86/>FIND              {          mov       al,>find[bp]   ;get the character}
  256.   /$29/$C9                    {          sub       cx,cx}
  257.   /$8A/$0D                    {          mov       cl,[di]        ;get length}
  258.   /$E3/$0D                    {          jcxz      quit           ;stop if zero length}
  259.   /$89/$CB                    {          mov       bx,cx          ;save length}
  260.   /$47                        {          inc       di             ;start at first char}
  261.   /$FC                        {          cld                      ;moveforward}
  262.   /$F2/$AE                    {repne     scasb}
  263.   /$75/$05                    {          jne       quit           ;stop if not found}
  264.   /$29/$CB                    {          sub       bx,cx          ;add new and old length}
  265.   /$89/$5E/$0A                {          mov       [bp+10],bx      ;save result}
  266.   /$1F                        {quit:     pop       ds}
  267. );
  268. end;
  269.  
  270. (*--------------------------------------------------*)
  271. Function PosCAfter(FIND:Char; Var TST; N:Integer):Integer;
  272.    {returns the location of the first character Find in string Tst
  273.    after position N in the string.  Returns zero if not found.
  274.    To find, e.g., the second instance of Find, replace N by another
  275.    call to the function, with N = 0
  276.    Written by D. Seidman, 6/28/86}
  277.  
  278. begin
  279. Inline(
  280.   $1E                         {          push      ds             ;initialize}
  281.   /$C4/$BE/>TST               {          les       di,>tst[bp]    ;load string}
  282.   /$C7/$46/$0C/$00/$00        {          mov       wo [bp+12],0    ;result if nothing found or }
  283.                               {                                   ; start beyond length}
  284.   /$8A/$86/>FIND              {          mov       al,>find[bp]   ;get the character}
  285.   /$31/$C9                    {          xor       cx,cx}
  286.   /$8A/$0D                    {          mov       cl,[di]        ;get length}
  287.   /$E3/$19                    {          jcxz      quit           ;stop if zero length}
  288.   /$89/$CB                    {          mov       bx,cx          ;save length}
  289.   /$2B/$8E/>N                 {          sub       cx,>N[bp]      ;length after start}
  290.   /$7E/$11                    {          jle       quit           ;quit if nowhere to search}
  291.   /$03/$BE/>N                 {          add       di,>N[bp]      ;moves to the char to begin after}
  292.   /$47                        {          inc       di             ;to after it}
  293.   /$FC                        {          cld                      ;moveforward}
  294.   /$F2/$AE                    {repne     scasb                    ;search}
  295.   /$75/$07                    {          jne       quit           ;stop if not found}
  296.   /$F7/$D9                    {          neg       cx}
  297.   /$01/$D9                    {          add       cx,bx          ;add new and old length}
  298.   /$89/$4E/$0C                {          mov       [bp+12],cx      ;save result}
  299.   /$1F                        {quit:     pop       ds}
  300. );
  301. end;
  302. (*--------------------------------------------------*)
  303.  
  304. Procedure StripL (Var tst; strp:char);
  305. Begin
  306. Inline(
  307.                               {;procedure StripL (var tst; strp:char)}
  308.                               {;Code for inline, Turbo 3.}
  309.                               {;deletes leading character strp from string tst}
  310.                               {;tst may be of any string type.}
  311.                               {;modified 1/30/86}
  312.                               {;written by  D. Seidman}
  313.   $1E                         {          push      ds           ; save for exit}
  314.   /$C4/$BE/>TST               {          les       di,>tst[bp]  ; ES:DI to start}
  315.   /$8C/$C0                    {          mov       ax,es        ; match segments}
  316.   /$8E/$D8                    {          mov       ds,ax}
  317.   /$89/$FB                    {          mov       bx,di        ; save start}
  318.   /$8A/$86/>STRP              {          mov       al,>strp[bp] ; char to strip}
  319.   /$29/$C9                    {          sub       cx,cx        ; zero in CX}
  320.   /$8A/$0D                    {          mov       cl,[di]      ; length in CX}
  321.   /$E3/$17                    {          jcxz      quit         ; exit if null}
  322.   /$47                        {          inc       di}
  323.   /$3A/$05                    {          cmp       al,[di]      ; check first char}
  324.   /$75/$12                    {          jne       quit         ; exit if no match}
  325.   /$47                        {          inc       di           ; next char}
  326.   /$49                        {          dec       cx           ; already checked first one}
  327.   /$FC                        {          cld                    ; frontwards}
  328.   /$F3/$AE                    {repe      scasb                  ; do search after first}
  329.   /$74/$07                    {          je        null         ; if stripping whole line}
  330.   /$89/$FE                    {          mov       si,di        ; char after last match}
  331.   /$89/$DF                    {          mov       di,bx        ; to start of string}
  332.   /$47                        {          inc       di}
  333.   /$4E                        {          dec       si           ; }
  334.   /$41                        {          inc       cx}
  335.   /$89/$0F                    {null:     mov       [bx],cx      ; to get length right}
  336.   /$F2/$A4                    {rep       movsb                  ; delete}
  337.   /$1F                        {quit:     pop       ds}
  338. );
  339. end;
  340.  
  341. (*------------------------------------------------*)
  342. function StripCountL(var tst;strp:char):integer;
  343. begin
  344. Inline(
  345.                               {;Function StripCountL (var tst; strp:char):integer;}
  346.                               {;Code for inline, Turbo 3.}
  347.                               {;deletes leading character strp from string tst}
  348.                               {;tst may be of any string type.}
  349.                               {;returns the number of characters stripped}
  350.                               {;written by  D. Seidman, 2/16/86}
  351.   $1E                         {          push      ds           ; save for exit}
  352.   /$C4/$BE/>TST               {          les       di,>tst[bp]  ; ES:DI to start}
  353.   /$8C/$C0                    {          mov       ax,es        ; match segments}
  354.   /$8E/$D8                    {          mov       ds,ax}
  355.   /$89/$FB                    {          mov       bx,di        ; save start}
  356.   /$8A/$86/>STRP              {          mov       al,>strp[bp] ; char to strip}
  357.   /$29/$C9                    {          sub       cx,cx        ; zero in CX}
  358.   /$8A/$0D                    {          mov       cl,[di]      ; length in CX}
  359.   /$89/$CA                    {          mov       dx,cx        ; save original length}
  360.   /$C7/$46/$0A/$00/$00        {          mov       wo [bp+10],0 ; set result of zero}
  361.   /$E3/$1C                    {          jcxz      quit         ; exit if null}
  362.   /$47                        {          inc       di}
  363.   /$3A/$05                    {          cmp       al,[di]      ; check first char}
  364.   /$75/$17                    {          jne       quit         ; exit if no match}
  365.   /$47                        {          inc       di           ; next char}
  366.   /$49                        {          dec       cx           ; already checked first one}
  367.   /$FC                        {          cld                    ; frontwards}
  368.   /$F3/$AE                    {repe      scasb                  ; do search after first}
  369.   /$74/$07                    {          je        null         ; if stripping whole line}
  370.   /$89/$FE                    {          mov       si,di        ; char after last match}
  371.   /$89/$DF                    {          mov       di,bx        ; to start of string}
  372.   /$47                        {          inc       di}
  373.   /$4E                        {          dec       si           ; }
  374.   /$41                        {          inc       cx}
  375.   /$89/$0F                    {null:     mov       [bx],cx      ; to get length right}
  376.   /$29/$CA                    {          sub       dx,cx        ;number of bytes stripped}
  377.   /$89/$56/$0A                {          mov       [bp+10],dx   ;move that to function result}
  378.   /$F2/$A4                    {rep       movsb                  ; delete}
  379.   /$1F                        {quit:     pop       ds}
  380. );
  381. end;
  382.  
  383. (*------------------------------------------------*)
  384. Procedure StripR(Var tst; strp:char);
  385. begin
  386. Inline(
  387.                               {;Creates procedure StripR (var tst;strp:char)}
  388.                               {;Strips trailing characters strp from string tst.}
  389.                               {;tst may be any string type.}
  390.                               {;modified 2/16/86.  D. Seidman}
  391.   $1E                         {          push      ds}
  392.   /$C4/$BE/>TST               {          les       di,>tst[bp] ; ES:DI to start}
  393.   /$8C/$C0                    {          mov       ax,es}
  394.   /$8E/$D8                    {          mov       ds,ax}
  395.   /$89/$FB                    {          mov       bx,di       ; save start}
  396.   /$8A/$86/>STRP              {          mov       al,>strp[bp]; char to strip}
  397.   /$29/$C9                    {          sub       cx,cx       ; zero  CX}
  398.   /$8A/$0D                    {          mov       cl,[di]     ; length in CX}
  399.   /$E3/$0E                    {          jcxz      quit        ; exit if null}
  400.   /$01/$CF                    {          add       di,cx       ;start at far end of string}
  401.   /$3A/$05                    {          cmp       al,[di]     ;check last character}
  402.   /$75/$08                    {          jne       quit        ;exit if no match}
  403.   /$FD                        {          std                   ;scan backwards}
  404.   /$F3/$AE                    {repe      scasb                 ;search for first non-matching byte}
  405.   /$74/$01                    {          je        null        ;if you are stripping all characters}
  406.   /$41                        {          inc       cx          ;fix length}
  407.   /$88/$0F                    {null:     mov       [bx],cl     ;new length}
  408.   /$1F                        {quit:     pop       ds}
  409. );
  410.  
  411. end;
  412.  
  413.  
  414. (*----------------------------------------------*)
  415.  
  416. Procedure StripThrough (Var tst; strp:char);
  417. Begin
  418. Inline(
  419.                               {;Creates Procedure StripThrough (var tst;strp:char)}
  420.                               {;With string tst and char strp, it}
  421.                               {;strips from the left up to and including}
  422.                               {;the first instance of char strp}
  423.                               {;modified 1/30/86.  D. Seidman}
  424.   $1E                         {          push      ds}
  425.   /$C4/$BE/>TST               {          LES       DI,>TST[BP]   ; ES:DI to start}
  426.   /$89/$FB                    {          MOV       BX,DI         ; save start}
  427.   /$8C/$C0                    {          mov       ax,es}
  428.   /$8E/$D8                    {          mov       ds,ax}
  429.   /$8A/$86/>STRP              {          MOV       AL,>STRP[BP]   ; char to strip through}
  430.   /$29/$C9                    {          SUB       CX,CX          ; zero in CX}
  431.   /$8A/$0D                    {          MOV       CL,[DI]        ; length in CX}
  432.   /$E3/$0F                    {          JCXZ      QUIT           ; exit if null}
  433.   /$47                        {          INC       DI             ; first char}
  434.   /$FC                        {          CLD                      ; frontwards}
  435.   /$F2/$AE                    {REPNE     SCASB                    ; do search}
  436.   /$75/$09                    {          JNE       QUIT           ; not found}
  437.   /$89/$FE                    {          MOV       SI,DI          ; char after, start move here}
  438.   /$89/$DF                    {          MOV       DI,BX}
  439.   /$47                        {          INC       DI  }
  440.   /$89/$0F                    {          MOV       [BX],cx        ; to get length right}
  441.   /$F2/$A4                    {REP       MOVSB                    ; delete leading characters}
  442.   /$1F                        {QUIT:     pop       ds}
  443. );
  444. end;
  445.  
  446. (*----------------------------------------------*)
  447.  
  448. Procedure SwapSubstring (Var tline; find, repl:longstring;
  449.                          Var enough:boolean; limit:byte);
  450. begin
  451. Inline(
  452.                               {;tline is a string of any type.  Find and replace are strings of}
  453.                               {;type longstring, but may be literals (e.g., 'abc','').}
  454.                               {;Longstring may be any string type.}
  455.                               {;Replaces all instances of substring find with substring repl in tline.}
  456.                               {;Limit is the maximum permissible length of the string Tline}
  457.                               {;after the replacements.  It should be no greater than the}
  458.                               {;size of tline's type, but it may be shorter.}
  459.                               {;Enough returns FALSE if not all swaps are accomplished}
  460.                               {;because limit length exceeded.}
  461.                               {;If limit is less than the actual length of tline and repl is longer}
  462.                               {;than find, no replacements are done.  If limit is longer than}
  463.                               {;length tline and repl is longer than find, replaces are done up to}
  464.                               {;the point where the next replace would leave tline longer than limit.}
  465.                               {;If repl is not longer than find, limit has no effect.}
  466.   $1E                         {          push      ds}
  467.   /$8A/$96/>FIND              {          mov       dl, [>find[bp]]     ;store length of find}
  468.   /$8A/$86/>FIND+$0001        {          mov       al,[>find[bp]+1]    ;store first find character in al}
  469.   /$8A/$B6/>REPL              {          mov       dh,[>repl[bp]]      ;store length of repl}
  470.   /$88/$D4                    {          mov       ah, dl}
  471.   /$28/$F4                    {          sub       ah,dh               ;find difference in length of strings}
  472.   /$C4/$BE/>ENOUGH            {          les       di,>enough[bp]      ;initialize flag}
  473.   /$C6/$05/$01                {          mov       by [di],1}
  474.   /$C4/$BE/>TLINE             {          les       di, >tline[BP]      ;address of string to modify}
  475.   /$8C/$C3                    {          mov       bx,es               ;match segments}
  476.   /$8E/$DB                    {          mov       ds,bx}
  477.   /$89/$FB                    {          mov       bx,di               ;save tline address}
  478.   /$31/$C9                    {          xor       cx,cx               ;zero out cx}
  479.   /$8A/$0D                    {          mov       cl,[di]             ;length tline to cl}
  480.   /$E3/$03                    {          jcxz      j1                  ;exit if tline null}
  481.   /$E9/$03/$00                {          jmp       j2}
  482.   /$E9/$8E/$00                {j1:       jmp       quit}
  483.   /$47                        {j2:       inc       di                  ;to start of string}
  484.   /$38/$D1                    {scan:     cmp       cl, dl              ;is remaining string>find?}
  485.   /$72/$F8                    {          jb        j1                  ;exit if not enough left for a match}
  486.   /$FC                        {          cld                           ;move forwards}
  487.   /$F2/$AE                    {repne     scasb                         ;search for first char}
  488.   /$75/$F3                    {          jne       j1                  ;exit if not found}
  489.   /$51                        {          push      cx                  ;save no. of bytes left after match}
  490.   /$4F                        {          dec       di                  ;to match position}
  491.   /$57                        {          push      di                  ;save position after match}
  492.   /$8D/$B6/>FIND+$0001        {          lea       si, >find[bp]+1}
  493.   /$88/$D1                    {          mov       cl, dl              ;get length of find string}
  494.   /$F3/$36/$A6                {repe   ss:cmpsb                         ;match on find string?}
  495.   /$5F                        {          pop       di                  ;start of match test}
  496.   /$59                        {          pop       cx                  ;bytes then remaining}
  497.   /$75/$E6                    {          jne       j2                  ;cycle if no match}
  498.                               {;gets here if you found a match. Now compare find and replace strings}
  499.   /$FE/$C1                    {          inc       cl                  ;bytes from beginning of match}
  500.   /$80/$FC/$00                {          cmp       ah,0               ;test which branch to follow}
  501.   /$74/$52                    {          je        moveq               ;skip string adjust if find=repl}
  502.   /$7C/$1B                    {          jl        longrep             ;jump if repl >find}
  503.                               {;if find > repl, need to close up the gap resulting from replacing}
  504.   /$28/$D1                    {          sub       cl,dl               ;no of bytes from end of find string}
  505.   /$51                        {          push      cx                  ;save it}
  506.   /$57                        {          push      di                  ;save beginning of match}
  507.   /$89/$FE                    {          mov       si, di              ;make both start of match}
  508.   /$53                        {          push      bx                  ;clear some workspace}
  509.   /$31/$DB                    {          xor       bx, bx              ; "                   }
  510.   /$88/$F3                    {          mov       bl, dh              ;len(repl) }
  511.   /$01/$DF                    {          add       di, bx              ;add to get destination address}
  512.   /$88/$D3                    {          mov       bl, dl              ;len(find)}
  513.   /$01/$DE                    {          add       si, bx              ;add to get source address}
  514.   /$5B                        {          pop       bx                  ;restore}
  515.   /$28/$27                    {          sub       [bx],ah             ;shrink tline[0]}
  516.   /$F2/$A4                    {rep       movsb                         ;close the gap}
  517.   /$5F                        {          pop       di                  ;get back start of match}
  518.   /$59                        {          pop       cx                  ;get back bytes after replacing}
  519.   /$E9/$37/$00                {          jmp       movr                ;go do the replacement}
  520.                               {;if repl> find, increase the gap }
  521.   /$57                        {longrep:  push      di }
  522.                               {;test whether this would make string too long}
  523.   /$F6/$DC                    {          neg       ah}
  524.   /$52                        {          push      dx                  ;get some workspace}
  525.                               {;if you do not like using the parameter limit, you can fix }
  526.                               {;the limit by replacing the following line with the commented}
  527.                               {;line after it.  Then you can replace 255 with whatever length less}
  528.                               {;than that you want.}
  529.   /$8A/$B6/>LIMIT             {          mov       dh,[>limit[bp]]     ;get maximum string length}
  530.                               {;         mov       dh,255              ;get max string length}
  531.   /$28/$E6                    {          sub       dh,ah               ;find longest string you can add to}
  532.   /$8A/$17                    {          mov       dl,[bx]             ;get actual current length}
  533.   /$38/$F2                    {          cmp       dl,dh               ;compare them}
  534.   /$77/$37                    {          ja        j5                  ;stop if max<actual, but pop first}
  535.   /$5A                        {          pop       dx                  ;restore}
  536.   /$00/$27                    {          add       by [bx],ah          ;increase string length}
  537.                               {;now need to make room for the replace}
  538.   /$53                        {          push      bx                  ;save tline address}
  539.   /$02/$1F                    {          add       bl,[bx]             ;get end of tline}
  540.   /$73/$02                    {          jnc       j4}
  541.   /$FE/$C7                    {          inc       bh                  ;add one if a carry}
  542.   /$89/$DF                    {j4:       mov       di,bx               ;move to end of lengthened string}
  543.                               {;now need where you are moving it too}
  544.   /$31/$DB                    {          xor       bx,bx               ;clear some space}
  545.   /$88/$E3                    {          mov       bl,ah               ;get the increment}
  546.   /$89/$FE                    {          mov       si,di               ;move the address}
  547.   /$29/$DE                    {          sub       si,bx               ;get end of string before increment}
  548.   /$5B                        {          pop       bx                  ;restore}
  549.   /$51                        {          push      cx                  ;save bytes after first match}
  550.   /$28/$D1                    {          sub       cl,dl               ;don't move bytes in find}
  551.   /$FD                        {          std                           ;change direction}
  552.   /$F2/$A4                    {rep       movsb                         ;move the string down}
  553.   /$FC                        {          cld                           ;get the direction again}
  554.   /$59                        {          pop       cx                  ;restore}
  555.   /$5F                        {          pop       di                  ;restore.}
  556.   /$28/$D1                    {          sub       cl,dl               ;subtract find from remaining bytes}
  557.   /$F6/$DC                    {          neg       ah}
  558.   /$E9/$02/$00                {          jmp       movr                ;go get the replace}
  559.                               {;now fix up cx for equal strings}
  560.   /$28/$F1                    {moveq:    sub       cl,dh               ;bytes remaining after repl}
  561.                               {;now move repl into place}
  562.   /$51                        {movr:     push      cx                  ;save bytes remaining}
  563.   /$8D/$B6/>REPL+$0001        {          lea       si, [>repl[bp]+1]         ;get replace string}
  564.   /$31/$C9                    {          xor       cx,cx               ;clear it out}
  565.   /$88/$F1                    {          mov       cl,dh               ;get bytes to move- len(repl)}
  566.   /$F2/$36/$A4                {rep    ss:movsb                         ;move replacement string}
  567.   /$59                        {          pop       cx                  ;bytes remaining.di should be ok}
  568.   /$E9/$7C/$FF                {          jmp       near scan           ;look for next match}
  569.   /$5A                        {j5:       pop       dx                  ;clean up stack}
  570.   /$C4/$BE/>ENOUGH            {          les       di, >enough[bp]     ;not enough to make all swaps}
  571.   /$C6/$05/$00                {          mov       by [di],0}
  572.   /$5F                        {          pop       di}
  573.   /$1F                        {quit:     pop       ds}
  574. );
  575. end;
  576.  
  577. (*----------------------------------------------*)
  578.  
  579. procedure stupcase(var tline);
  580. {uppercases the lower case letters in tline.
  581. based on routine in Turbo manual, slightly modified}
  582.  
  583. begin
  584. Inline(
  585.   $1E                         {          push ds}
  586.   /$C4/$BE/>TLINE             {          les  di, >tline[bp]}
  587.   /$8C/$C0                    {          mov  ax,es}
  588.   /$8E/$D8                    {          mov  ds,ax}
  589.   /$8A/$0D                    {          mov  cl,[di]}
  590.   /$FE/$C1                    {          inc  cl}
  591.   /$FE/$C9                    {l1:       dec  cl}
  592.   /$74/$10                    {          jz   l2}
  593.   /$47                        {          inc  di}
  594.   /$80/$3D/$61                {          cmp  by[di],'a'}
  595.   /$72/$F6                    {          jb   l1}
  596.   /$80/$3D/$7A                {          cmp  by[di],'z'}
  597.   /$77/$F1                    {          ja   l1}
  598.   /$80/$2D/$20                {          sub  by[di],$20}
  599.   /$EB/$EC                    {          jmp  short l1}
  600.   /$1F                        {l2:       pop  ds}
  601. );
  602. end;
  603.  
  604. (*---------------------------------------*)
  605. Function Stringup(var tline):longstring;
  606.  
  607.     (*--------------------------*)
  608.     {
  609.     Function result is all-uppercase
  610.     version of string tline.  Written
  611.     by D. Seidman, 1/5/87.  Longstring is
  612.     any string type.
  613.     }
  614.     (*--------------------------*)
  615.  
  616. Begin
  617. Inline(
  618.                               {;Function stringup(var tline):longstring;}
  619.   $1E                         {          push ds               ;save things for later}
  620.   /$C5/$B6/>TLINE             {          lds  si, >tline[bp]   ;addressing of the string}
  621.   /$8C/$D0                    {          mov  ax,ss            ;addessing of the destination}
  622.   /$FC                        {          cld                   ;move forward}
  623.   /$8E/$C0                    {          mov  es,ax}
  624.   /$31/$C9                    {          xor  cx,cx}
  625.   /$8A/$0C                    {          mov  cl,[si]          ;string length to cl}
  626.   /$8D/$7E/$08                {          lea di, [bp+8]        ;point di to function result}
  627.   /$26/$88/$0D                {     es:  mov [di],cl           ;and move length to function result}
  628.   /$46                        {          inc  si               ;point to start of string}
  629.   /$47                        {          inc  di               ;and where it goes}
  630.   /$AC                        {l1:       lodsb                 ;get byte from string}
  631.   /$3C/$61                    {          cmp  al,'a'           ;tests from Turbo manual}
  632.   /$72/$06                    {          jb   l3}
  633.   /$3C/$7A                    {          cmp  al,'z'}
  634.   /$77/$02                    {          ja   l3}
  635.   /$2C/$20                    {          sub  al,$20}
  636.   /$AA                        {l3:       stosb                 ;store result}
  637.   /$E2/$F2                    {          loop l1}
  638.   /$1F                        {l2:       pop ds}
  639. );
  640. end;
  641. (*----------------------------------------------*)
  642.  
  643. procedure lowcase(var tline);
  644. {converts all upper case letters in tline to lowercase
  645. slightly modified from routine in Turbo manual}
  646.  
  647. begin
  648. Inline(
  649.   $1E                         {          push ds}
  650.   /$C4/$BE/>TLINE             {          les  di, >tline[bp]}
  651.   /$8C/$C0                    {          mov  ax,es}
  652.   /$8E/$D8                    {          mov  ds,ax}
  653.   /$8A/$0D                    {          mov  cl,[di]}
  654.   /$FE/$C1                    {          inc  cl}
  655.   /$FE/$C9                    {l1:       dec  cl}
  656.   /$74/$10                    {          jz   l2}
  657.   /$47                        {          inc  di}
  658.   /$80/$3D/$41                {          cmp  by[di],'A'}
  659.   /$72/$F6                    {          jb   l1}
  660.   /$80/$3D/$5A                {          cmp  by[di],'Z'}
  661.   /$77/$F1                    {          ja   l1}
  662.   /$80/$05/$20                {          add  by[di],$20}
  663.   /$EB/$EC                    {          jmp  short l1}
  664.   /$1F                        {l2:       pop  ds}
  665. );
  666. end;
  667.  
  668. (*----------------------------------------------*)
  669.  
  670.  
  671. procedure flipchar(var tst; srch, repl: char);
  672. (*
  673. CALL AS FLIPCHAR(VAR INSTRING; CH1, CH2: CHAR),
  674. CHANGES EACH OCCURRENCE OF CH1 IN INSTRING TO CH2.
  675. *)
  676. begin;
  677. Inline(
  678.    $C4/$BE/>TST               {          LES       DI,>TST[BP] ; ES:DI to start}
  679.   /$8A/$86/>SRCH              {          MOV       AL,>SRCH[BP] ; search char}
  680.   /$8A/$A6/>REPL              {          MOV       AH,>REPL[BP] ; repl. char}
  681.   /$29/$C9                    {          SUB       CX,CX     ; zero in CX}
  682.   /$8A/$0D                    {          MOV       CL,[DI]   ; length in CX}
  683.   /$E3/$0D                    {          JCXZ      QUIT      ; exit if null}
  684.   /$47                        {          INC       DI        ; first char}
  685.   /$FC                        {          CLD                 ; frontwards}
  686.   /$E3/$09                    {MORE:     JCXZ      QUIT      ; no more}
  687.   /$F2/$AE                    {REPNE     SCASB               ; do search}
  688.   /$75/$05                    {          JNE       QUIT      ; not found}
  689.   /$88/$65/$FF                {          MOV       [DI-1],AH ; replace}
  690.   /$EB/$F5                    {          JMP       MORE      ; try for more}
  691.   /$90                        {QUIT:     NOP                 ; exit}
  692. );
  693. end;
  694.  
  695. (*----------------------------------------------*)
  696. function flipcount(var tst;srch,repl:char):integer;
  697.  
  698. (*  Tst is a string.  This is identical to the procedure
  699.  Flipchar except that the function returns the number of
  700.  times the search character was replaced by the find character.
  701.  Written 2/16/86 by D. Seidman, based on Flipchar by M. Lazarus*)
  702.  
  703. begin
  704. Inline(
  705.   $1E                         {          PUSH      ds}
  706.   /$C4/$BE/>TST               {          LES       DI,>TST[BP] ; ES:DI to start}
  707.   /$8C/$C0                    {          mov       ax,es}
  708.   /$8E/$D8                    {          mov       ds,ax}
  709.   /$8A/$86/>SRCH              {          MOV       AL,>SRCH[BP] ; search char}
  710.   /$8A/$A6/>REPL              {          MOV       AH,>REPL[BP] ; repl. char}
  711.   /$29/$DB                    {          sub       bx,bx     ;zero in bx -- for counting}
  712.   /$29/$C9                    {          SUB       CX,CX     ; zero in CX}
  713.   /$8A/$0D                    {          MOV       CL,[DI]   ; length in CX}
  714.   /$E3/$0E                    {          JCXZ      QUIT      ; exit if null}
  715.   /$47                        {          INC       DI        ; first char}
  716.   /$FC                        {          CLD                 ; frontwards}
  717.   /$E3/$0A                    {MORE:     JCXZ      QUIT      ; no more}
  718.   /$F2/$AE                    {REPNE     SCASB               ; do search}
  719.   /$75/$06                    {          JNE       QUIT      ; not found}
  720.   /$43                        {          inc       bx        ;count it}
  721.   /$88/$65/$FF                {          MOV       [DI-1],AH ; replace}
  722.   /$EB/$F4                    {          JMP       MORE      ; try for more}
  723.   /$89/$5E/$0C                {QUIT:     mov       [bp+12],bx ;get function result}
  724.   /$1F                        {          pop       ds}
  725. );
  726. end;
  727.  
  728. (*----------------------------------------------*)
  729.  
  730. procedure stripchar(var tst; strp: char);
  731. (*
  732. CALL AS STRIPCHAR(VAR INSTRING; CH: CHAR),
  733. REMOVES EACH OCCURRENCE OF CH IN INSTRING.
  734. *)
  735. begin;
  736. Inline(
  737.    $1E                        {          PUSH      DS        ; save for exit}
  738.   /$C4/$BE/>TST               {          LES       DI,>TST[BP] ; ES:DI to start}
  739.   /$89/$FB                    {          MOV       BX,DI     ; save start}
  740.   /$8C/$C0                    {          MOV       AX,ES     ; match segments}
  741.   /$8E/$D8                    {          MOV       DS,AX     ;   (same)}
  742.   /$8A/$86/>STRP              {          MOV       AL,>STRP[BP] ; char to strip}
  743.   /$29/$C9                    {          SUB       CX,CX     ; zero in CX}
  744.   /$8A/$0D                    {          MOV       CL,[DI]   ; length in CX}
  745.   /$E3/$16                    {          JCXZ      QUIT      ; exit if null}
  746.   /$47                        {          INC       DI        ; first char}
  747.   /$FC                        {          CLD                 ; frontwards}
  748.                               {MORE:}
  749.   /$F2/$AE                    {REPNE     SCASB               ; do search}
  750.   /$75/$10                    {          JNE       QUIT      ; not found}
  751.   /$57                        {          PUSH      DI        ; save locn}
  752.   /$51                        {          PUSH      CX        ; bytes to go}
  753.   /$89/$FE                    {          MOV       SI,DI     ; char after}
  754.   /$4F                        {          DEC       DI        ; destination}
  755.   /$F2/$A4                    {REP       MOVSB               ; delete}
  756.   /$FE/$0F                    {          DEC       BY [BX]   ; decr length}
  757.   /$59                        {          POP       CX        ; bytes to go}
  758.   /$5F                        {          POP       DI        ; last locn}
  759.   /$4F                        {          DEC DI              ; char gone}
  760.   /$E3/$02                    {          JCXZ      QUIT      ; no more}
  761.   /$EB/$EC                    {          JMP       MORE      ; try again}
  762.   /$1F                        {QUIT:     POP       DS        ; restore for exit}
  763. );
  764. end;
  765. (*----------------------------------------------*)
  766. Function Count (var tst; srch:char):integer;
  767. begin
  768. Inline(
  769.                     {;Function Count(var tst; srch:char):integer}
  770.                     {;Returns count of instances of srch in string tst}
  771.   $1E               {          PUSH      ds}
  772.   /$C4/$BE/>TST     {          LES       DI,>TST[BP] ; ES:DI to start}
  773.   /$8C/$C0          {          mov       ax,es}
  774.   /$8E/$D8          {          mov       ds,ax}
  775.   /$8A/$86/>SRCH    {          MOV       AL,>SRCH[BP] ; search char}
  776.   /$29/$DB          {          sub       bx,bx     ;zero in bx -- for counting}
  777.   /$29/$C9          {          SUB       CX,CX     ; zero in CX}
  778.   /$8A/$0D          {          MOV       CL,[DI]   ; length in CX}
  779.   /$E3/$0B          {          JCXZ      QUIT      ; exit if null}
  780.   /$47              {          INC       DI        ; first char}
  781.   /$FC              {          CLD                 ; frontwards}
  782.   /$E3/$07          {MORE:     JCXZ      QUIT      ; no more}
  783.   /$F2/$AE          {REPNE     SCASB               ; do search}
  784.   /$75/$03          {          JNE       QUIT      ; not found}
  785.   /$43              {          inc       bx        ;count it}
  786.   /$EB/$F7          {          JMP       MORE      ; try for more}
  787.   /$89/$5E/$0A      {QUIT:     mov       [bp+10],bx ;get function result}
  788.   /$1F              {          pop       ds}
  789. );
  790. end;
  791. (*----------------------------------------------*)
  792. Function HowMany (var str1,str2): integer;
  793. begin
  794. Inline(
  795.                               {;Function HowMany(var str1,str2):integer;}
  796.                               {;str1 and str2 are strings of any type.}
  797.                               {;function compares them character by}
  798.                               {;character for up to min(length(str1),length(str2))}
  799.                               {;characters.  Function is the number of consecutive}
  800.                               {;characters (starting with string 1) for which the}
  801.                               {;two strings are equal. e.g., if str1 is cats and}
  802.                               {;str2 is catchup, function result is 3.  If str1 is}
  803.                               {;cat and str2 is dog, function result is 0.}
  804.   $1E                         {        push    ds}
  805.   /$C5/$B6/>STR1              {        lds     si, >str1[bp]   ;addressing str1}
  806.   /$C4/$BE/>STR2              {        les     di, >str2[bp]   ;addressing str2}
  807.   /$31/$C9                    {        xor     cx,cx           ;zero cx}
  808.   /$8A/$0D                    {        mov     cl,[di]         ;get length str2}
  809.   /$3A/$0C                    {        cmp     cl,[si]         ;compare lengths}
  810.   /$72/$02                    {        jb      diless}
  811.   /$8A/$0C                    {siless: mov     cl, [si]}
  812.   /$89/$CB                    {diless: mov     bx, cx          ;save length}
  813.   /$FC                        {        cld                     ;move forward}
  814.   /$46                        {        inc     si              ;to start of string}
  815.   /$47                        {        inc     di              ; "}
  816.   /$F3/$A6                    {repe    cmpsb                   ;string compare}
  817.   /$74/$01                    {        je      j1              ;equal for full length}
  818.   /$41                        {        inc     cx              ;correct, last byte ne}
  819.   /$29/$CB                    {j1:     sub     bx,cx           ;# matching bytes}
  820.   /$89/$5E/$0C                {        mov     [bp+12],bx       ;function result}
  821.   /$1F                        {        pop     ds}
  822. );
  823. end;
  824.  
  825. (*----------------------------------------------*)
  826. Function Equal_Structures(var a,b;size:integer):boolean;
  827.  
  828.  {compares two structures of size bytes.  Returns
  829.  true of they are equal, false if they are not.
  830.  Written by D. Seidman.  This revision 12/27/86}
  831.  
  832.  
  833. begin
  834. Inline(
  835.   $1E                         {       push   ds}
  836.   /$C6/$46/$0E/$01            {       mov    by [bp+14],1  ;set up a true result}
  837.   /$C4/$BE/>A                 {       les    di,>a[bp]     ;get first structure, es:di}
  838.   /$C5/$B6/>B                 {       lds    si,>b[bp]     ;get second structure, ds:si}
  839.   /$8B/$8E/>SIZE              {       mov    cx,>size[bp]  ;get length of structures}
  840.   /$F3/$A6                    {repe   cmpsb                ;compare, byte by byte}
  841.   /$74/$04                    {       je     quit          ;if still equal, done}
  842.   /$C6/$46/$0E/$00            {       mov    by [bp+14],0  ;set result for unequal}
  843.   /$1F                        {quit:  pop    ds}
  844. );
  845. end;
  846. (*----------------------------------------------*)
  847.  
  848.