Return to string.fs CVS log | Up to [gforth] / gforth |
Got SHARC port to comile again (untested yet) Added GCC patch for SHARC port
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 dup IF 1 /string THEN 32: 2swap r> - 2swap ; 33: 34: : $iter ( .. $addr char xt -- .. ) { char xt } 35: $@ BEGIN dup WHILE char $split >r >r xt execute r> r> 36: REPEAT 2drop ;