home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / zen / strings.src < prev    next >
Text File  |  1989-12-29  |  4KB  |  194 lines
  1. \*
  2.  *   ZEN 1.10  String operators
  3.  *     C 1990  by Martin Tracy
  4.  *             Last modified  1.1.90
  5.  *\
  6.  
  7. \ Transform counted string into text string
  8. CODE COUNT ( a - a2 u) \ CORE
  9.         mov   ax,bx
  10.         inc   ax
  11.         mov   bl,[bx]
  12.         sub   bh,bh
  13.         push  ax
  14.         NEXT
  15. END-CODE
  16.  
  17. \ Store packed string at address a2.
  18. : PLACE ( a n a2)
  19.    2DUP C!  1+ SWAP MOVE ;
  20.  
  21.  
  22. \ Truncate leftmost n chars of string.
  23. \ n may be negative
  24. CODE /STRING ( a u n - a2 u2) \ STRING
  25.         pop   cx
  26.         pop   ax
  27.         add   ax,bx
  28.         sub   cx,bx
  29.         mov   bx,cx
  30.         push  ax
  31.         NEXT
  32. END-CODE
  33.  
  34. \ Return shorter string from first position unequal to byte
  35. CODE SKIP ( a u b - a2 u2) \ STRING
  36.         mov   ax,bx
  37.         pop   cx
  38.         pop   di
  39.         jcxz  Ski1
  40.         mov   bx,ds
  41.         mov   es,bx
  42.         repe scasb
  43.         jz    Ski1
  44.         inc   cx
  45.         dec   di
  46. Ski1:   push  di
  47.         mov   bx,cx
  48.         NEXT
  49. END-CODE
  50.  
  51. \ Return shorter string from first position equal to byte
  52. CODE SCAN ( a u b - a2 u2) \ STRING
  53.         mov   ax,bx
  54.         pop   cx
  55.         pop   di
  56.         jcxz  Sca1
  57.         mov   bx,ds
  58.         mov   es,bx
  59.         repne scasb
  60.         jnz   Sca1
  61.         inc   cx
  62.         dec   di
  63. Sca1:   push  di
  64.         mov   bx,cx
  65.         NEXT
  66. END-CODE
  67.  
  68. \ Return string from first trailing position unequal to byte
  69. \ Used by -TRAILING
  70. | CODE SKIP> ( a u b - a2 u2) \ STRING
  71.         pop   cx
  72.         pop   di
  73.         push  di
  74.         jcxz  Skb2
  75.         mov   ax,ds
  76.         mov   es,ax
  77.         add   di,cx
  78.         dec   di
  79. Skb1:   mov   al,[di]
  80.         cmp   al,bl
  81.         jnz   Skb2
  82.         dec   di
  83.         loop  Skb1
  84. Skb2:   mov   bx,cx
  85.         NEXT
  86. END-CODE
  87.  
  88.  
  89. \ Move u bytes from a to a2, leftmost byte first
  90. CODE CMOVE ( a a2 u) \ EXT CORE
  91.         mov   cx,bx
  92.         mov   bx,si
  93.         pop   di
  94.         pop   si
  95.         jcxz  Cmo1
  96.         mov   ax,ds
  97.         mov   es,ax
  98.         rep movsb
  99. Cmo1:   mov   si,bx
  100.         pop   bx
  101.         NEXT
  102. END-CODE
  103.  
  104. \ Move u bytes from a to a2, rightmost byte first
  105. CODE CMOVE> ( a a2 u) \ EXT CORE
  106.         mov   cx,bx
  107.         mov   bx,si
  108.         pop   di
  109.         pop   si
  110.         mov   ax,cx
  111.         dec   ax
  112.         add   di,ax
  113.         add   si,ax
  114.         jcxz  Cmu1
  115.         mov   ax,ds
  116.         mov   es,ax
  117.         std
  118.         rep movsb
  119.         cld
  120. Cmu1:   mov   si,bx
  121.         pop   bx
  122.         NEXT
  123. END-CODE
  124.  
  125. \ Move u bytes from a to a2 without overlap
  126. : MOVE ( a a2 u) \ CORE
  127.    >R  2DUP U< IF  R> CMOVE>  ELSE  R> CMOVE  THEN ;
  128.  
  129.  
  130. \ Store u bytes, starting at address a
  131. CODE FILL ( a u b) \ CORE
  132.         mov   ax,bx
  133.         pop   cx
  134.         pop   di
  135.         jcxz  Fil1
  136.         mov   dx,ds
  137.         mov   es,dx
  138.         rep stosb
  139. Fil1:   pop   bx
  140.         NEXT
  141. END-CODE
  142.  
  143. \ Store u zeroes, starting at address a.
  144. : ERASE ( a u) \ EXT CORE
  145.    0 FILL ;
  146.  
  147. \ Store u blanks, starting at address a.
  148. : BLANK ( a u) \ EXT CORE
  149.    BL FILL ;
  150.  
  151. \*
  152. \ Transform counted string into text string.
  153. : COUNT ( a - a2 u) \ CORE
  154.    DUP C@ SWAP 1+ ;
  155.  
  156. \ Truncate leftmost n chars of string.
  157. \ n may be negative
  158. : /STRING ( a u n - a2 u2) \ STRING
  159.    ROT OVER + ROT ROT - ;
  160.  
  161. \ Return shorter string from first position unequal to byte
  162. : SKIP ( a u b - a2 u2) \ STRING
  163.    >R  BEGIN  DUP
  164.        WHILE  OVER C@ R@ - IF  R> DROP  EXIT  THEN  1 /STRING
  165.        REPEAT   R> DROP ;
  166.  
  167. \ Return shorter string from first position equal to byte
  168. : SCAN ( a u b - a2 u2) \ STRING
  169.    >R  BEGIN  DUP
  170.        WHILE  OVER C@ R@ =  IF  R> DROP  EXIT  THEN  1 /STRING
  171.        REPEAT   R> DROP ;
  172.  
  173. \ Return string from first trailing position unequal to byte
  174. : SKIP> ( a u b - a2 u2) \ STRING
  175.    >R  BEGIN  DUP
  176.        WHILE  1-  2DUP + C@ R@ - IF  R> DROP  1+ EXIT THEN
  177.        REPEAT  R> DROP ;
  178.  
  179. \ Move u bytes from a to a2, leftmost byte first.
  180. : CMOVE ( a a2 u) \ EXT CORE
  181.    ?DO  OVER C@ OVER C!  1+ SWAP 1+ SWAP  LOOP  2DROP ;
  182.  
  183. \ Move u bytes from a to a2, rightmost byte first.
  184. : CMOVE> ( a a2 u) \ EXT CORE
  185.    >R  SWAP R@ + SWAP R@ +  R> 0
  186.    ?DO  1- SWAP 1- SWAP  OVER C@ OVER C!  LOOP  2DROP ;
  187.  
  188. \ Store u bytes, starting at address a.
  189. : FILL ( a u b) \ CORE
  190.    SWAP ?DUP 0= IF  2DROP EXIT  THEN
  191.    >R OVER C!  DUP 1+ R> 1- CMOVE ;
  192. *\
  193.  
  194.