[gforth] / gforth / string.fs

gforth: gforth/string.fs

1 :	pazsan	1.1	\ dynamic string handling 10aug99py
2 :
3 :			: delete ( buffer size count -- )
4 :			over min >r r@ - ( left over ) dup 0>
5 :			IF 2dup swap dup r@ + -rot swap move THEN + r> bl fill ;
6 :
7 :			: insert ( string length buffer size -- )
8 :			rot over min >r r@ - ( left over )
9 :			over dup r@ + rot move r> move ;
10 :
11 :			: $padding ( n -- n' )
12 :			[ 6 cells ] Literal + [ -4 cells ] Literal and ;
13 :			: $! ( addr1 u addr2 -- )
14 :			dup @ IF dup @ free throw THEN
15 :			over $padding allocate throw over ! @
16 :			over >r rot over cell+ r> move 2dup ! + cell+ bl swap c! ;
17 :			: $@len ( addr -- u ) @ @ ;
18 :			: $@ ( addr1 -- addr2 u ) @ dup cell+ swap @ ;
19 :			: $!len ( u addr -- )
20 :			over $padding over @ swap resize throw over ! @ ! ;
21 :			: $del ( addr off u -- ) >r >r dup $@ r> /string r@ delete
22 :			dup $@len r> - swap $!len ;
23 :			: $ins ( addr1 u addr2 off -- ) >r
24 :			2dup dup $@len rot + swap $!len $@ 1+ r> /string insert ;
25 :			: $+! ( addr1 u addr2 -- ) dup $@len $ins ;
26 :			: $off ( addr -- ) dup @ free throw off ;
27 :
28 :			\ dynamic string handling 12dec99py
29 :
30 :			: $split ( addr u char -- addr1 u1 addr2 u2 )
31 :			>r 2dup r> scan dup >r 1 /string 2swap r> - 2swap ;
32 :
33 :			: $iter ( .. $addr char xt -- .. ) { char xt }
34 :			$@ BEGIN dup WHILE char $split >r >r xt execute r> r>
35 :			REPEAT 2drop ;