version 1.9, 2007/10/03 16:58:15
|
version 1.19, 2012/12/31 15:25:19
|
Line 1
|
Line 1
|
\ extended characters (either 8bit or UTF-8, possibly other encodings) |
\ extended characters (either 8bit or UTF-8, possibly other encodings) |
\ and their fixed-size variant |
\ and their fixed-size variant |
|
|
\ Copyright (C) 2005,2006 Free Software Foundation, Inc. |
\ Copyright (C) 2005,2006,2007,2008,2011,2012 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ 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. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 16
|
Line 16
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
\ We can do some of these (and possibly faster) by just using the |
\ 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 |
\ utf-8 words with an appropriate setting of max-single-byte, but I |
Line 48 Defer x\string- ( xc-addr1 u1 -- xc-addr
|
Line 47 Defer x\string- ( xc-addr1 u1 -- xc-addr
|
\G last xchar in the buffer. |
\G last xchar in the buffer. |
Defer xc@ ( xc-addr -- xc ) \ xchar-ext xc-fetch |
Defer xc@ ( xc-addr -- xc ) \ xchar-ext xc-fetch |
\G Fetchs the xchar @var{xc} at @var{xc-addr1}. |
\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 |
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 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 |
\G @var{xc-addr1}, @var{u1} pchars large. @var{xc-addr2} points to the |
Line 83 Defer -trailing-garbage ( xc-addr u1 --
|
Line 85 Defer -trailing-garbage ( xc-addr u1 --
|
over >r +x/string |
over >r +x/string |
r> xc@ ; |
r> xc@ ; |
|
|
|
: xhold ( xc -- ) |
|
\G Put xc into the pictured numeric output |
|
dup xc-size negate chars holdptr +! |
|
holdptr @ dup holdbuf u< -&17 and throw |
|
8 xc!+? 2drop drop ; |
|
|
|
: xc, ( xchar -- ) here unused xc!+? 2drop dp ! ; |
|
|
\ fixed-size versions of these words |
\ fixed-size versions of these words |
|
|
: char- ( c-addr1 -- c-addr2 ) |
: char- ( c-addr1 -- c-addr2 ) |
Line 93 Defer -trailing-garbage ( xc-addr u1 --
|
Line 103 Defer -trailing-garbage ( xc-addr u1 --
|
: string- ( c-addr1 u1 -- c-addr1 u2 ) |
: string- ( c-addr1 u1 -- c-addr1 u2 ) |
1- ; |
1- ; |
|
|
|
: c!+ ( c c-addr1 -- c-addr2 ) |
|
dup 1+ >r c! r> ; |
|
|
: c!+? ( c c-addr1 u1 -- c-addr2 u2 f ) |
: c!+? ( c c-addr1 u1 -- c-addr2 u2 f ) |
dup 1 chars u< if \ or use < ? |
dup 1 chars u< if \ or use < ? |
rot drop false |
rot drop false |
Line 112 Defer -trailing-garbage ( xc-addr u1 --
|
Line 125 Defer -trailing-garbage ( xc-addr u1 --
|
['] +string is +x/string |
['] +string is +x/string |
['] string- is x\string- |
['] string- is x\string- |
['] c@ is xc@ |
['] c@ is xc@ |
|
['] c!+ is xc!+ |
['] c!+? is xc!+? |
['] c!+? is xc!+? |
['] count is xc@+ |
['] count is xc@+ |
['] c-size is xc-size |
['] c-size is xc-size |