Return to string.fs CVS log

Up to [gforth] / gforth

updated copyright years

    1: \ dynamic string handling                              10aug99py
    2: 
    3: \ Copyright (C) 2000,2005,2007,2010,2011 Free Software Foundation, Inc.
    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
    9: \ as published by the Free Software Foundation, either version 3
   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
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: [IFUNDEF] $!
   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 ;
   26: 
   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  ;
   32: 
   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> $! ;
   68: 
   69: \ dynamic string handling                              12dec99py
   70: 
   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 ;
   76: 
   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 ;
   85: [THEN]