Commit 8e5ee8bf authored by bp's avatar bp
Browse files

xchar compliant with reference implementation again

git-svn-id: https://forth-ev.de/repos/bigforth@1762 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 67e24b0a
...@@ -3,6 +3,10 @@ ...@@ -3,6 +3,10 @@
\ environmental dependency: characters are stored as bytes \ environmental dependency: characters are stored as bytes
\ environmental dependency: lower case words accepted \ environmental dependency: lower case words accepted
\ doesn't implement set-source-encoding and set-file-encoding
-77 Constant mal-xchar
base @ hex base @ hex
80 Value maxascii 80 Value maxascii
...@@ -18,10 +22,12 @@ base @ hex ...@@ -18,10 +22,12 @@ base @ hex
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
\ dup C0 and 80 <> abort" malformed character" \ dup C0 and 80 <> mal-xchar and throw
3F and r> or 3F and r> or
REPEAT r> drop ; REPEAT r> drop ;
: xc, ( xchar -- ) here xc!+ dp ! ;
: xc!+ ( xc xcaddr -- xcaddr' ) : xc!+ ( xc xcaddr -- xcaddr' )
over maxascii u< IF tuck c! char+ EXIT THEN \ special case ASCII over maxascii u< IF tuck c! char+ EXIT THEN \ special case ASCII
>r 0 swap 3F >r 0 swap 3F
...@@ -83,7 +89,7 @@ base @ hex ...@@ -83,7 +89,7 @@ base @ hex
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 key 6 lshift r> 5 lshift >r >r key
\ dup C0 and 80 <> abort" malformed character" \ dup C0 and 80 <> mal-xchar and throw
3F and r> or 3F and r> or
REPEAT r> drop ; REPEAT r> drop ;
...@@ -95,6 +101,13 @@ base @ hex ...@@ -95,6 +101,13 @@ base @ hex
REPEAT 7F xor 2* or REPEAT 7F xor 2* or
BEGIN dup 80 u< 0= WHILE emit REPEAT drop ; BEGIN dup 80 u< 0= WHILE emit REPEAT drop ;
: holds ( addr u -- )
BEGIN dup WHILE 1- 2dup + c@ hold REPEAT 2drop ;
Create xholdbuf 8 allot
: xhold ( xchar -- ) xholdbuf tuck xc!+ over - holds ;
\ utf size \ utf size
\ uses wcwidth ( xc -- n ) \ uses wcwidth ( xc -- n )
...@@ -260,8 +273,8 @@ here wc-table - Constant #wc-table ...@@ -260,8 +273,8 @@ here wc-table - Constant #wc-table
80 Constant utf-8 80 Constant utf-8
100 Constant iso-latin-1 100 Constant iso-latin-1
: set-encoding to maxascii ; : set-internal-encoding to maxascii ;
: get-encoding maxascii ; : get-internal-encoding maxascii ;
base ! base !
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment