version 1.16, 2012/08/17 22:24:27
|
version 1.20, 2012/12/31 15:25:18
|
Line 1
|
Line 1
|
\ dynamic string handling 10aug99py |
\ dynamic string handling 10aug99py |
|
|
\ Copyright (C) 2000,2005,2007,2010,2011 Free Software Foundation, Inc. |
\ Copyright (C) 2000,2005,2007,2010,2011,2012 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 83
|
Line 83
|
$@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r> |
$@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r> |
REPEAT 2drop rdrop rdrop ; |
REPEAT 2drop rdrop rdrop ; |
|
|
|
: $over ( addr u $addr off -- ) |
|
\G overwrite string at offset off with addr u |
|
swap >r |
|
r@ @ 0= IF s" " r@ $! THEN |
|
2dup + r@ $@len > IF |
|
2dup + r@ $@len tuck max r@ $!len |
|
r@ $@ rot /string bl fill |
|
THEN |
|
r> $@ rot /string rot umin move ; |
|
|
\ string array words |
\ string array words |
|
|
: $[] { n addr -- addr' } |
: $[] ( n addr -- addr' ) >r |
addr @ 0= IF s" " addr $! THEN |
\G index into the string array and return the address at index n |
addr $@ n cells /string |
r@ @ 0= IF s" " r@ $! THEN |
|
r@ $@ 2 pick cells /string |
dup cell < IF |
dup cell < IF |
2drop addr $@len |
2drop r@ $@len |
n 1+ cells addr $!len |
over 1+ cells r@ $!len |
addr $@ rot /string erase |
r@ $@ rot /string 0 fill |
addr $@ n cells /string |
r@ $@ 2 pick cells /string |
THEN drop ; |
THEN drop nip rdrop ; |
|
|
: $[]! ( addr u n $addr -- ) $[] $! ; |
: $[]! ( addr u n $[]addr -- ) $[] $! ; |
: $[]+! ( addr u n $addr -- ) $[] $+! ; |
\G store a string into an array at index n |
: $[]@ ( n $addr -- addr u ) $[] dup @ IF $@ ELSE drop s" " THEN ; |
: $[]+! ( addr u n $[]addr -- ) $[] $+! ; |
|
\G add a string to the string at addr n |
: $over { addr u $addr off -- } |
: $[]@ ( n $[]addr -- addr u ) $[] dup @ IF $@ ELSE drop s" " THEN ; |
\G overwrite string at offset off with addr u |
\G fetch a string from array index n -- return the zero string if empty |
$addr @ 0= IF s" " $addr $! THEN |
|
$addr $@len u off + < IF |
|
$addr $@len dup |
|
u off + max $addr $!len |
|
$addr $@ rot /string bl fill |
|
THEN |
|
addr $addr $@ off /string u min move ; |
|
[THEN] |
[THEN] |
|
|