--- gforth/string.fs 2000/03/26 21:53:16 1.1 +++ gforth/string.fs 2010/12/31 18:09:02 1.12 @@ -1,12 +1,31 @@ \ dynamic string handling 10aug99py +\ Copyright (C) 2000,2005,2007,2010 Free Software Foundation, Inc. + +\ This file is part of Gforth. + +\ Gforth is free software; you can redistribute it and/or +\ modify it under the terms of the GNU General Public License +\ as published by the Free Software Foundation, either version 3 +\ of the License, or (at your option) any later version. + +\ This program is distributed in the hope that it will be useful, +\ but WITHOUT ANY WARRANTY; without even the implied warranty of +\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +\ GNU General Public License for more details. + +\ You should have received a copy of the GNU General Public License +\ along with this program. If not, see http://www.gnu.org/licenses/. + : delete ( buffer size count -- ) over min >r r@ - ( left over ) dup 0> IF 2dup swap dup r@ + -rot swap move THEN + r> bl fill ; +[IFUNDEF] insert : insert ( string length buffer size -- ) rot over min >r r@ - ( left over ) over dup r@ + rot move r> move ; +[THEN] : $padding ( n -- n' ) [ 6 cells ] Literal + [ -4 cells ] Literal and ; @@ -23,13 +42,15 @@ : $ins ( addr1 u addr2 off -- ) >r 2dup dup $@len rot + swap $!len $@ 1+ r> /string insert ; : $+! ( addr1 u addr2 -- ) dup $@len $ins ; -: $off ( addr -- ) dup @ free throw off ; +: $off ( addr -- ) dup @ dup IF free throw off ELSE 2drop THEN ; +: $init ( addr -- ) >r r@ off s" " r> $! ; \ dynamic string handling 12dec99py : $split ( addr u char -- addr1 u1 addr2 u2 ) - >r 2dup r> scan dup >r 1 /string 2swap r> - 2swap ; + >r 2dup r> scan dup >r dup IF 1 /string THEN + 2swap r> - 2swap ; -: $iter ( .. $addr char xt -- .. ) { char xt } - $@ BEGIN dup WHILE char $split >r >r xt execute r> r> - REPEAT 2drop ; +: $iter ( .. $addr char xt -- .. ) >r >r + $@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r> + REPEAT 2drop rdrop rdrop ;