Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 4866 → Rev 4867

/programs/develop/SPForth/src/compiler/spf_wordlist.f
0,0 → 1,188
( ‘®§¤ ­¨¥ á«®¢ àëå áâ â¥© ¨ á«®¢ à¥© WORDLIST.
Ž‘-­¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥­¨ï.
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
à¥®¡à §®¢ ­¨¥ ¨§ 16-à §à來®£® ¢ 32-à §àï¤­ë© ª®¤ - 1995-96££
¥¢¨§¨ï - ᥭâï¡àì 1999
Œ®¤¨ä¨æ¨à®¢ ­­® Œ ªá¨¬®¢ë¬ Œ.Ž.
email:mak@mail.rtc.neva.ru
http://informer.rtc.neva.ru/
â ¤ {812}105-92-03
â à {812}552-47-64
)
HEX
1 CONSTANT &IMMEDIATE \ ª®­áâ ­â  ¤«ï ¢ëá¥ç¥­¨ï ä« ¦ª  IMMEDIATE
2 CONSTANT &VOC
 
\ ‚®§¢à â¨âì wid - ¨¤¥­â¨ä¨ª â®à ᯨ᪠ á«®¢, ¢ª«îç î饣® ¢á¥ áâ ­¤ àâ­ë¥
\ á«®¢ , ®¡¥á¯¥ç¨¢ ¥¬ë¥ ॠ«¨§ æ¨¥©. â®â ᯨ᮪ á«®¢ ¨§­ ç «ì­® ᯨ᮪
\ ª®¬¯¨«ï樨 ¨ ç áâì ­ ç «ì­®£® ¯®à浪  ¯®¨áª .
: >BODY ( xt -- a-addr ) \ 94
\ a-addr -  ¤à¥á ¯®«ï ¤ ­­ëå, ᮮ⢥âáâ¢ãî騩 xt.
\ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ xt ­¥ ®â á«®¢ ,
\ ®¯à¥¤¥«¥­­®£® ç¥à¥§ CREATE.
( 1+ @ ¡ë«® ¢ ¢¥àᨨ 2.5 )
5 +
;
 
: SWORD, ( addr u wid -> ) \ ¤®¡ ¢«¥­¨¥ § £®«®¢ª  áâ âì¨ á ¨¬¥­¥¬,
\ § ¤ ­­ë¬ áâப®© addr u, ª ᯨáªã, § ¤ ­­®¬ã wid.
\ ”®à¬¨àã¥â ⮫쪮 ¯®«ï ¨¬¥­¨ ¨ á¢ï§¨ á
\ ®â¢¥¤¥­¨¥¬ ¯ ¬ï⨠¯® ALLOT.
HERE CELL+
DUP LAST !
SWAP DUP @ , !
S, 0 C,
;
 
: WORDLIST ( -- wid ) \ 94 SEARCH
\ ‘®§¤ ¥â ­®¢ë© ¯ãá⮩ ᯨ᮪ á«®¢, ¢®§¢à é ï ¥£® ¨¤¥­â¨ä¨ª â®à wid.
\ ®¢ë© ᯨ᮪ á«®¢ ¬®¦¥â ¡ëâì ¢®§¢à é¥­ ¨§ ¯à¥¤¢ à¨â¥«ì­® à á¯à¥¤¥«¥­­ëå
\ ᯨ᪮¢ á«®¢ ¨«¨ ¬®¦¥â ¤¨­ ¬¨ç¥áª¨ à á¯à¥¤¥«ïâìáï ¢ ¯à®áâà ­á⢥ ¤ ­­ëå.
\ ‘¨á⥬  ¤®«¦­  ¤®¯ã᪠âì ᮧ¤ ­¨¥ ª ª ¬¨­¨¬ã¬ 8 ­®¢ëå ᯨ᪮¢ á«®¢ ¢
\ ¤®¯®«­¥­¨¥ ª ¨¬¥î騬áï ¢ á¨á⥬¥.
HERE VOC-LIST @ , VOC-LIST !
HERE 0 , \ §¤¥áì ¡ã¤¥â 㪠§ â¥«ì ­  ¨¬ï ¯®á«¥¤­¥£® á«®¢  ᯨ᪠
0 , \ §¤¥áì ¡ã¤¥â 㪠§ â¥«ì ­  ¨¬ï ᯨ᪠ ¤«ï ¨¬¥­®¢ ­ëå
0 , \ wid á«®¢ àï-¯à¥¤ª 
0 , \ ª« áá á«®¢ àï = wid á«®¢ àï, ®¯à¥¤¥«ïî饣® ᢮©á⢠ ¤ ­­®£®
;
 
 
: CLASS! ( cls wid -- ) CELL+ CELL+ CELL+ ! ;
: CLASS@ ( wid -- cls ) CELL+ CELL+ CELL+ @ ;
: PAR! ( Pwid wid -- ) CELL+ CELL+ ! ;
: PAR@ ( wid -- Pwid ) CELL+ CELL+ @ ;
 
 
: ID. ( NFA[E] -> )
ZCOUNT TYPE
;
 
\ -9 -- flags
\ -8 -- cfa
\ -4 -- LFA
\ 0 -- NFA
 
Code NAME>L ;( NFA -> LFA )
LEA EAX, [EAX-4]
RET
EndCode
 
Code NAME>C ;( NFA -> 'CFA )
LEA EAX, [EAX-8]
RET
EndCode
 
Code NAME> ;( NFA -> CFA )
MOV EAX, [EAX-8]
RET
EndCode
 
Code NAME>F ;( NFA -> FFA )
LEA EAX, [EAX-9]
RET
EndCode
 
Code CDR ;( NFA1 -> NFA2 )
OR EAX, EAX
SIF 0<>
MOV EAX, [EAX-4]
STHEN
RET
EndCode
 
: ?IMMEDIATE ( NFA -> F )
NAME>F C@ &IMMEDIATE AND
;
 
: ?VOC ( NFA -> F )
NAME>F C@ &VOC AND
;
0 [IF]
: IMM ( -- ) \ 94
\ ‘¤¥« âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥ á«®¢®¬ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï.
\ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥
\ ­¥ ¨¬¥¥â ¨¬¥­¨.
LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP ." I=" 2DUP H. H.
;
: IMMEDIATE ( -- ) \ 94
\ ‘¤¥« âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥ á«®¢®¬ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï.
\ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥
\ ­¥ ¨¬¥¥â ¨¬¥­¨.
LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP C!
;
[THEN]
: VOC ( -- )
\ ®¬¥â¨âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­­®¥ á«®¢® ¯à¨§­ ª®¬ "á«®¢ àì".
LAST @ NAME>F DUP C@ &VOC OR SWAP C!
;
 
\ ==============================================
\ ®â« ¤ª  - ¯®¨áª á«®¢  ¯®  ¤à¥áã ¢ ¥£® ⥫¥
 
 
\ ==============================================
\ ®â« ¤ª  - ¯®¨áª á«®¢  ¯®  ¤à¥áã ¢ ¥£® ⥫¥
 
: N_UMAX ( nfa nfa1 -- nfa|nfa1 )
OVER DUP IF NAME> THEN
OVER DUP IF NAME> THEN U< IF NIP EXIT THEN DROP ;
 
: WL_NEAR_NFA ( addr wid - addr nfa | addr 0 )
@
BEGIN 2DUP DUP IF NAME> THEN U<
WHILE CDR
REPEAT
;
 
 
[IF]
 
: NEAR_NFA ( addr - nfa addr | 0 addr )
0 SWAP
VOC-LIST
BEGIN @ DUP
WHILE DUP >R CELL+ WL_NEAR_NFA SWAP >R N_UMAX R> R>
REPEAT DROP
;
 
[ELSE]
 
: WL_NEAR_NFA_N ( addr nfa - addr nfa | addr 0 )
BEGIN 2DUP DUP IF NAME> THEN U<
WHILE CDR
REPEAT
;
 
: WL_NEAR_NFA_M ( addr wid - nfa2 addr | 0 addr )
0 -ROT
CELL+ @
BEGIN DUP
WHILE WL_NEAR_NFA_N \ nfa addr nfa1
SWAP >R
DUP >R N_UMAX
R> DUP IF CDR THEN
R> SWAP
REPEAT DROP
;
 
: NEAR_NFA ( addr - nfa addr | 0 addr )
0 SWAP
VOC-LIST
BEGIN @ DUP
WHILE DUP >R WL_NEAR_NFA_M
>R N_UMAX R> R>
REPEAT DROP
;
 
[THEN]
 
: WordByAddr ( addr -- c-addr u )
\ ­ ©â¨ á«®¢®, ⥫㠪®â®à®£® ¯à¨­ ¤«¥¦¨â ¤ ­­ë©  ¤à¥á
DUP DP @ U> IF DROP S" <not in the image>" EXIT THEN
NEAR_NFA DROP DUP 0= IF DROP S" <not found>" EXIT THEN
COUNT
;
 
 
DECIMAL