| : u8len ( u8 -- n ) |
: u8len ( u8 -- n ) |
| dup max-single-byte u< IF drop 1 EXIT THEN \ special case ASCII |
dup max-single-byte u< IF drop 1 EXIT THEN \ special case ASCII |
| $800 2 >r |
$800 2 >r |
| BEGIN 2dup u>= WHILE 5 lshift r> 1+ >r REPEAT |
BEGIN 2dup u>= WHILE 5 lshift r> 1+ >r dup 0= UNTIL THEN |
| 2drop r> ; |
2drop r> ; |
| |
|
| : u8@+ ( u8addr -- u8addr' u ) |
: u8@+ ( u8addr -- u8addr' u ) |
| count dup max-single-byte u< ?EXIT \ special case ASCII |
count dup max-single-byte u< ?EXIT \ special case ASCII |
| |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
| $7F and $40 >r |
$7F and $40 >r |
| BEGIN dup r@ and WHILE r@ xor |
BEGIN dup r@ and WHILE r@ xor |
| 6 lshift r> 5 lshift >r >r count |
6 lshift r> 5 lshift >r >r count |
| |
|
| : u8key ( -- u ) |
: u8key ( -- u ) |
| defers key dup max-single-byte u< ?EXIT \ special case ASCII |
defers key dup max-single-byte u< ?EXIT \ special case ASCII |
| |
dup $C2 u< IF UTF-8-err throw THEN \ malformed character |
| $7F and $40 >r |
$7F and $40 >r |
| BEGIN dup r@ and WHILE r@ xor |
BEGIN dup r@ and WHILE r@ xor |
| 6 lshift r> 5 lshift >r >r defers key |
6 lshift r> 5 lshift >r >r defers key |