\ $Id: zstring.f,v 1.1 2003/01/18 09:02:11 anfilat Exp $
\ ã«ì-áâப¨. ¥å®«®£¨ï ¢§ïâ ¨§ ~yz\common.f
\ ®¯¨àã¥â áâபã addr u ¯® ¤à¥áã z. ª®¥æ áâப¨ § ¯¨áë¢ ¥â 0
: CZMOVE ( a # z --) 2DUP + >R SWAP CMOVE R> 0 SWAP C! ;
: ALITERAL R> COUNT OVER + 1+ >R ;
\ VOCABULARY ZStrSupport
\ GET-CURRENT ALSO ZStrSupport DEFINITIONS
USER toadr USER fromadr USER counter
: zchar ( --c/0) counter @ 1 <
IF 0 ELSE -1 counter +! fromadr @ C@ fromadr 1+! THEN ;
: unchar counter 1+! -1 fromadr +! ;
: c> ( c--) toadr @ C! toadr 1+! ;
: escape ( c--c )
DUP [CHAR] n = IF DROP 10 ELSE
DUP [CHAR] r = IF DROP 13 ELSE
DUP [CHAR] t = IF DROP 9 ELSE
DUP [CHAR] b = IF DROP 8 ELSE
DUP [CHAR] q = IF DROP [CHAR] " ELSE
DUP [ CHAR 0 1- ] LITERAL OVER < SWAP [ CHAR 9 1+ ] LITERAL < AND IF
[CHAR] 0 -
BEGIN ( n) zchar DUP
[ CHAR 0 1- ] LITERAL OVER < SWAP [ CHAR 9 1+ ] LITERAL < AND
WHILE
( n c) [CHAR] 0 - SWAP 10 * +
REPEAT
0<> IF unchar THEN
THEN
THEN
THEN
THEN
THEN
THEN
;
: ESC-CZMOVE ( a # to --)
toadr ! counter ! fromadr !
BEGIN
zchar
DUP [CHAR] \ = IF DROP zchar escape THEN
DUP c> 0= UNTIL ;
\ SET-CURRENT
: Z\LITERAL ( addr u -- \ a) \ ¢ ०¨¬¥ ¨â¥à¯à¥â 樨 ¢®§¢à é ¥â ¤à¥á
\ ¡ãä¥à ¢ ¤¨ ¬¨ç¥áª®© ¯ ¬ïâ¨. ãä¥à ¦¥« â¥«ì® ®á¢®¡®¤¨âì
STATE @ IF
POSTPONE ALITERAL
HERE 1+ DUP >R ESC-CZMOVE
R@ ASCIIZ> NIP 2+ DUP ALLOT 2- R> 1- C!
ELSE
DUP 1+ ALLOCATE THROW DUP >R ESC-CZMOVE R>
THEN
; IMMEDIATE
: ZLITERAL ( addr u -- \ a)
STATE @ IF
POSTPONE ALITERAL
DUP C,
HERE SWAP DUP ALLOT MOVE 0 C,
ELSE
DUP 1+ ALLOCATE THROW DUP >R CZMOVE R>
THEN
; IMMEDIATE
\ ®§¤ ¥â áâபã, ®ª 稢 îéãîáï ã«¥¬
: Z" ( -->") [CHAR] " PARSE [COMPILE] ZLITERAL ; IMMEDIATE
\ ®§¤ ¥â 0-áâபã, ¯à¨ í⮬ ¯à¥®¡à §ã¥â ¥¥ ¯® C-¯à ¢¨« ¬.
: Z\" ( -->") [CHAR] " PARSE [COMPILE] Z\LITERAL ; IMMEDIATE
\ PREVIOUS