--- gforth/kernel/xchars.fs 2007/10/17 16:05:22 1.11 +++ gforth/kernel/xchars.fs 2012/08/09 23:58:53 1.18 @@ -1,13 +1,13 @@ \ extended characters (either 8bit or UTF-8, possibly other encodings) \ and their fixed-size variant -\ Copyright (C) 2005,2006 Free Software Foundation, Inc. +\ Copyright (C) 2005,2006,2007,2008,2011 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 2 +\ 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, @@ -16,8 +16,7 @@ \ 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, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ We can do some of these (and possibly faster) by just using the \ utf-8 words with an appropriate setting of max-single-byte, but I @@ -48,6 +47,9 @@ Defer x\string- ( xc-addr1 u1 -- xc-addr \G last xchar in the buffer. Defer xc@ ( xc-addr -- xc ) \ xchar-ext xc-fetch \G Fetchs the xchar @var{xc} at @var{xc-addr1}. +Defer xc!+ ( xc xc-addr1 -- xc-addr2 ) \ xchar-ext xc-store +\G Stores the xchar @var{xc} at @var{xc-addr1}. @var{xc-addr2} is the next +\G unused address in the buffer. Defer xc!+? ( xc xc-addr1 u1 -- xc-addr2 u2 f ) \ xchar-ext xc-store-plus-query \G Stores the xchar @var{xc} into the buffer starting at address \G @var{xc-addr1}, @var{u1} pchars large. @var{xc-addr2} points to the @@ -89,6 +91,8 @@ Defer -trailing-garbage ( xc-addr u1 -- holdptr @ dup holdbuf u< -&17 and throw 8 xc!+? 2drop drop ; +: xc, ( xchar -- ) here unused xc!+? 2drop dp ! ; + \ fixed-size versions of these words : char- ( c-addr1 -- c-addr2 ) @@ -99,6 +103,9 @@ Defer -trailing-garbage ( xc-addr u1 -- : string- ( c-addr1 u1 -- c-addr1 u2 ) 1- ; +: c!+ ( c c-addr1 -- c-addr2 ) + dup 1+ >r c! r> ; + : c!+? ( c c-addr1 u1 -- c-addr2 u2 f ) dup 1 chars u< if \ or use < ? rot drop false @@ -118,6 +125,7 @@ Defer -trailing-garbage ( xc-addr u1 -- ['] +string is +x/string ['] string- is x\string- ['] c@ is xc@ + ['] c!+ is xc!+ ['] c!+? is xc!+? ['] count is xc@+ ['] c-size is xc-size