Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.1 | \ dynamic string handling 10aug99py |
| 2 : | |||
| 3 : | anton | 1.12 | \ Copyright (C) 2000,2005,2007,2010 Free Software Foundation, Inc. |
| 4 : | anton | 1.3 | |
| 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 : | anton | 1.7 | \ as published by the Free Software Foundation, either version 3 |
| 10 : | anton | 1.3 | \ 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 : | anton | 1.7 | \ along with this program. If not, see http://www.gnu.org/licenses/. |
| 19 : | anton | 1.3 | |
| 20 : | pazsan | 1.13 | : delete ( buffer size n -- ) \ gforth-string |
| 21 : | \G deletes the first @var{n} bytes from a buffer and fills the | ||
| 22 : | \G rest at the end with blanks. | ||
| 23 : | over min >r r@ - ( left over ) dup 0> | ||
| 24 : | IF 2dup swap dup r@ + -rot swap move THEN + r> bl fill ; | ||
| 25 : | pazsan | 1.1 | |
| 26 : | pazsan | 1.13 | : insert ( string length buffer size -- ) \ gforth-string |
| 27 : | \G inserts a string at the front of a buffer. The remaining | ||
| 28 : | \G bytes are moved on. | ||
| 29 : | rot over min >r r@ - ( left over ) | ||
| 30 : | over dup r@ + rot move r> move ; | ||
| 31 : | pazsan | 1.1 | |
| 32 : | pazsan | 1.13 | : $padding ( n -- n' ) \ gforth-string |
| 33 : | [ 6 cells ] Literal + [ -4 cells ] Literal and ; | ||
| 34 : | : $! ( addr1 u addr2 -- ) \ gforth-string string-store | ||
| 35 : | \G stores a string at an address, If there was a string there | ||
| 36 : | \G already, that string will be lost. | ||
| 37 : | dup @ IF dup @ free throw THEN | ||
| 38 : | over $padding allocate throw over ! @ | ||
| 39 : | over >r rot over cell+ r> move 2dup ! + cell+ bl swap c! ; | ||
| 40 : | : $@len ( addr -- u ) \ gforth-string string-fetch-len | ||
| 41 : | \G returns the length of the stored string. | ||
| 42 : | @ @ ; | ||
| 43 : | : $@ ( addr1 -- addr2 u ) \ gforth-string string-fetch | ||
| 44 : | \G returns the stored string. | ||
| 45 : | @ dup cell+ swap @ ; | ||
| 46 : | : $!len ( u addr -- ) \ gforth-string string-store-len | ||
| 47 : | \G changes the length of the stored string. Therefore we must | ||
| 48 : | \G change the memory area and adjust address and count cell as | ||
| 49 : | \G well. | ||
| 50 : | over $padding over @ swap resize throw over ! @ ! ; | ||
| 51 : | : $del ( addr off u -- ) \ gforth-string string-del | ||
| 52 : | \G deletes @var{u} bytes from a string with offset @var{off}. | ||
| 53 : | >r >r dup $@ r> /string r@ delete | ||
| 54 : | dup $@len r> - swap $!len ; | ||
| 55 : | : $ins ( addr1 u addr2 off -- ) \ gforth-string string-ins | ||
| 56 : | \G inserts a string at offset @var{off}. | ||
| 57 : | >r 2dup dup $@len rot + swap $!len $@ 1+ r> /string insert ; | ||
| 58 : | : $+! ( addr1 u addr2 -- ) \ gforth-string string-plus-store | ||
| 59 : | \G appends a string to another. | ||
| 60 : | dup $@len $ins ; | ||
| 61 : | : $off ( addr -- ) \ gforth-string string-off | ||
| 62 : | \G releases a string. | ||
| 63 : | dup @ dup IF free throw off ELSE 2drop THEN ; | ||
| 64 : | : $init ( addr -- ) \ gforth-string string-init | ||
| 65 : | \G initializes a string to empty (doesn't look at what was there before). | ||
| 66 : | >r r@ off s" " r> $! ; | ||
| 67 : | pazsan | 1.1 | |
| 68 : | \ dynamic string handling 12dec99py | ||
| 69 : | |||
| 70 : | pazsan | 1.13 | : $split ( addr u char -- addr1 u1 addr2 u2 ) \ gforth-string string-split |
| 71 : | \G divides a string into two, with one char as separator (e.g. '?' | ||
| 72 : | \G for arguments in an HTML query) | ||
| 73 : | >r 2dup r> scan dup >r dup IF 1 /string THEN | ||
| 74 : | 2swap r> - 2swap ; | ||
| 75 : | pazsan | 1.1 | |
| 76 : | pazsan | 1.13 | : $iter ( .. $addr char xt -- .. ) \ gforth-string string-iter |
| 77 : | \G takes a string apart piece for piece, also with a character as | ||
| 78 : | \G separator. For each part a passed token will be called. With | ||
| 79 : | \G this you can take apart arguments -- separated with '&' -- at | ||
| 80 : | \G ease. | ||
| 81 : | >r >r | ||
| 82 : | $@ BEGIN dup WHILE r@ $split i' -rot >r >r execute r> r> | ||
| 83 : | REPEAT 2drop rdrop rdrop ; |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |