Annotation of gforth/string.fs, revision 1.1
1.1 ! pazsan 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 ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>