kolibrios/programs/develop/SPForth/devel/~mak/~af/lib/c/zstr.f
Kirill Lipatov (Leency) 09488af869 KolSPForth12 uploaded to SVN
git-svn-id: svn://kolibrios.org@4867 a494cfbc-eb01-0410-851d-a64ba20cac60
2014-04-21 19:22:58 +00:00

76 lines
2.0 KiB
Forth
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

\ $Id: zstring.f,v 1.1 2003/01/18 09:02:11 anfilat Exp $
\ <20>ã«ì-áâப¨. ’¥å­®«®£¨ï ¢§ïâ  ¨§ ~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) \ ¢ ०¨¬¥ ¨­â¥à¯à¥â æ¨¨ ¢®§¢à é ¥â  ¤à¥á
\ ¡ãä¥à  ¢ ¤¨­ ¬¨ç¥áª®© ¯ ¬ïâ¨. <20>ãä¥à ¦¥« â¥«ì­® ®á¢®¡®¤¨âì
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