forked from KolibriOS/kolibrios
76 lines
2.0 KiB
FortranFixed
76 lines
2.0 KiB
FortranFixed
|
\ $Id: zstring.f,v 1.1 2003/01/18 09:02:11 anfilat Exp $
|
|||
|
|
\ <20><><EFBFBD><EFBFBD>-<EFBFBD><EFBFBD>ப<EFBFBD>. <EFBFBD><EFBFBD>孮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> ~yz\common.f
|
|||
|
|
|
|||
|
|
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>ப<EFBFBD> addr u <EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> z. <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>ப<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>뢠<EFBFBD><EFBFBD> 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) \ <EFBFBD> ०<EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>樨 <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>頥<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>⥫쭮 <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
|||
|
|
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
|
|||
|
|
|
|||
|
|
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>ப<EFBFBD>, <EFBFBD><EFBFBD><EFBFBD><EFBFBD>稢<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>㫥<EFBFBD>
|
|||
|
|
: Z" ( -->") [CHAR] " PARSE [COMPILE] ZLITERAL ; IMMEDIATE
|
|||
|
|
|
|||
|
|
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 0-<EFBFBD><EFBFBD>ப<EFBFBD>, <EFBFBD><EFBFBD><EFBFBD> <EFBFBD>⮬ <EFBFBD>८<EFBFBD>ࠧ<EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD> C-<EFBFBD>ࠢ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
|
|||
|
|
: Z\" ( -->") [CHAR] " PARSE [COMPILE] Z\LITERAL ; IMMEDIATE
|
|||
|
|
|
|||
|
|
\ PREVIOUS
|