Annotation of gforth/string.fs, revision 1.18

1.1       pazsan      1: \ dynamic string handling                              10aug99py
                      2: 
1.15      anton       3: \ Copyright (C) 2000,2005,2007,2010,2011 Free Software Foundation, Inc.
1.3       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.7       anton       9: \ as published by the Free Software Foundation, either version 3
1.3       anton      10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.7       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.3       anton      19: 
1.14      pazsan     20: [IFUNDEF] $!
1.13      pazsan     21: : delete   ( buffer size n -- ) \ gforth-string
                     22:     \G deletes the first @var{n} bytes from a buffer and fills the
                     23:     \G rest at the end with blanks.
                     24:     over min >r  r@ - ( left over )  dup 0>
                     25:     IF  2dup swap dup  r@ +  -rot swap move  THEN  + r> bl fill ;
1.1       pazsan     26: 
1.13      pazsan     27: : insert   ( string length buffer size -- ) \ gforth-string
                     28:     \G inserts a string at the front of a buffer. The remaining
                     29:     \G bytes are moved on.
                     30:     rot over min >r  r@ - ( left over )
                     31:     over dup r@ +  rot move   r> move  ;
1.1       pazsan     32: 
1.13      pazsan     33: : $padding ( n -- n' ) \ gforth-string
                     34:     [ 6 cells ] Literal + [ -4 cells ] Literal and ;
                     35: : $! ( addr1 u addr2 -- ) \ gforth-string string-store
                     36:     \G stores a string at an address, If there was a string there
                     37:     \G already, that string will be lost.
                     38:     dup @ IF  dup @ free throw  THEN
                     39:     over $padding allocate throw over ! @
                     40:     over >r  rot over cell+  r> move 2dup ! + cell+ bl swap c! ;
                     41: : $@len ( addr -- u ) \ gforth-string string-fetch-len
                     42:     \G returns the length of the stored string.
                     43:     @ @ ;
                     44: : $@ ( addr1 -- addr2 u ) \ gforth-string string-fetch
                     45:     \G returns the stored string.
                     46:     @ dup cell+ swap @ ;
                     47: : $!len ( u addr -- ) \ gforth-string string-store-len
                     48:     \G changes the length of the stored string.  Therefore we must
                     49:     \G change the memory area and adjust address and count cell as
                     50:     \G well.
                     51:     over $padding over @ swap resize throw over ! @ ! ;
                     52: : $del ( addr off u -- ) \ gforth-string string-del
                     53:     \G deletes @var{u} bytes from a string with offset @var{off}.
                     54:     >r >r dup $@ r> /string r@ delete
                     55:     dup $@len r> - swap $!len ;
                     56: : $ins ( addr1 u addr2 off -- ) \ gforth-string string-ins
                     57:     \G inserts a string at offset @var{off}.
                     58:     >r 2dup dup $@len rot + swap $!len  $@ 1+ r> /string insert ;
                     59: : $+! ( addr1 u addr2 -- ) \ gforth-string string-plus-store
                     60:     \G appends a string to another.
                     61:     dup $@len $ins ;
                     62: : $off ( addr -- ) \ gforth-string string-off
                     63:     \G releases a string.
                     64:     dup @ dup IF  free throw off  ELSE  2drop  THEN ;
                     65: : $init ( addr -- ) \ gforth-string string-init
                     66:     \G initializes a string to empty (doesn't look at what was there before).
                     67:     >r r@ off s" " r> $! ;
1.1       pazsan     68: 
                     69: \ dynamic string handling                              12dec99py
                     70: 
1.13      pazsan     71: : $split ( addr u char -- addr1 u1 addr2 u2 ) \ gforth-string string-split
                     72:     \G divides a string into two, with one char as separator (e.g. '?'
                     73:     \G for arguments in an HTML query)
                     74:     >r 2dup r> scan dup >r dup IF  1 /string  THEN
                     75:     2swap r> - 2swap ;
1.1       pazsan     76: 
1.13      pazsan     77: : $iter ( .. $addr char xt -- .. ) \ gforth-string string-iter
                     78:     \G takes a string apart piece for piece, also with a character as
                     79:     \G separator. For each part a passed token will be called. With
                     80:     \G this you can take apart arguments -- separated with '&' -- at
                     81:     \G ease.
                     82:     >r >r
                     83:     $@ BEGIN  dup  WHILE  r@ $split i' -rot >r >r execute r> r>
                     84:     REPEAT  2drop rdrop rdrop ;
1.16      pazsan     85: 
                     86: \ string array words
                     87: 
1.17      pazsan     88: : $[] ( n addr -- addr' ) >r
                     89:     r@ @ 0= IF  s" " r@ $!  THEN
                     90:     r@ $@ 2 pick cells /string
1.16      pazsan     91:     dup cell < IF
1.17      pazsan     92:        2drop r@ $@len
                     93:        over 1+ cells r@ $!len
                     94:        r@ $@ rot /string 0 fill
                     95:        r@ $@ 2 pick cells /string
                     96:     THEN  drop nip rdrop ;
1.16      pazsan     97: 
                     98: : $[]! ( addr u n $addr -- )  $[] $! ;
                     99: : $[]+! ( addr u n $addr -- )  $[] $+! ;
                    100: : $[]@ ( n $addr -- addr u )  $[] dup @ IF $@ ELSE drop s" " THEN ;
                    101: 
1.17      pazsan    102: : $over ( addr u $addr off -- )
1.16      pazsan    103:     \G overwrite string at offset off with addr u
1.17      pazsan    104:     swap >r
                    105:     r@ @ 0= IF  s" " r@ $!  THEN
                    106:     2dup + r@ $@len > IF
                    107:        2dup + r@ $@len tuck max r@ $!len
                    108:        r@ $@ rot /string bl fill
1.16      pazsan    109:     THEN
1.18    ! pazsan    110:     r> $@ rot /string rot umin move ;
1.14      pazsan    111: [THEN]

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>