( ®¨áª á«®¢ ¢ á«®¢ àïå ¨ ã¯à ¢«¥¨¥ ¯®à浪®¬ ¯®¨áª .
-¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥¨ï.
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
)
VECT FIND
0x10 CELLS CONSTANT CONTEXT_SIZE
CREATE SEARCH-BUFF 0x81 ALLOT
Code ZSEARCH-WORDLIST ;( z-addr wid -- 0 | xt 1 | xt -1 ) \ 94 SEARCH
; ©â¨ ®¯à¥¤¥«¥¨¥, § ¤ ®¥ áâப®© c-addr u ¢ ᯨ᪥ á«®¢, ¨¤¥â¨ä¨æ¨à㥬®¬
; wid.
᫨ ®¯à¥¤¥«¥¨¥ ¥ ©¤¥®, ¢¥àãâì ®«ì.
;
᫨ ®¯à¥¤¥«¥¨¥ ©¤¥®, ¢¥àãâì ¢ë¯®«¨¬ë© ⮪¥ xt ¨ ¥¤¨¨æã (1), ¥á«¨
; ®¯à¥¤¥«¥¨¥ ¥¬¥¤«¥®£® ¨á¯®«¥¨ï, ¨ ç¥ ¬¨ãá ¥¤¨¨æã (-1).
; PUSH WORD PTR [EBP]
MOV EDX, [EBP]
PUSH EDX
MOV EAX, [EAX]
PUSH EAX
LEA EBP, [EBP+4]
CALL {' GETPR}
test eax, eax
JZ END
LEA EBP, [EBP-4]
mov [ebp],eax
MOVZX EAX, BYTE PTR [EDX-9]
DEC EAX
OR EAX,1
END: RET
EndCode
: SEARCH-WORDLIST ( c-addr u wid -- 0 | xt 1 | xt -1 )
>R 0x7F AND SEARCH-BUFF ASCII-Z
R> ZSEARCH-WORDLIST
;
: SFIND ( addr len --- addr len 0| xt 1|xt -1 )
\ Search all word lists in the search order for the name in the
\ counted string at c-addr. If not found return the name address and 0.
\ If found return the execution token xt and -1 if the word is non-immediate
\ and 1 if the word is immediate.
CONTEXT
BEGIN DUP @
WHILE >R
2DUP R@ @ SEARCH-WORDLIST ?DUP
IF RDROP 2NIP EXIT \ Exit if found.
THEN
R> CELL+
REPEAT @
;
: FIND1 ( c-addr -- c-addr 0 | xt 1 | xt -1 ) \ 94 SEARCH
\ áè¨à¨âì ᥬ ⨪ã CORE FIND á«¥¤ãî騬:
\ ᪠âì ®¯à¥¤¥«¥¨¥ á ¨¬¥¥¬, § ¤ ë¬ áâப®© á® áç¥â稪®¬ c-addr.
\
᫨ ®¯à¥¤¥«¥¨¥ ¥ ©¤¥® ¯®á«¥ ¯à®á¬®âà ¢á¥å ᯨ᪮¢ ¢ ¯®à浪¥ ¯®¨áª ,
\ ¢®§¢à â¨âì c-addr ¨ ®«ì.
᫨ ®¯à¥¤¥«¥¨¥ ©¤¥®, ¢®§¢à â¨âì xt.
\
᫨ ®¯à¥¤¥«¥¨¥ ¥¬¥¤«¥®£® ¨á¯®«¥¨ï, ¢¥àãâì â ª¦¥ ¥¤¨¨æã (1);
\ ¨ ç¥ â ª¦¥ ¢¥àãâì ¬¨ãá ¥¤¨¨æã (-1). «ï ¤ ®© áâப¨, § 票ï,
\ ¢®§¢à é ¥¬ë¥ FIND ¢® ¢à¥¬ï ª®¬¯¨«ï樨, ¬®£ã⠮⫨ç âìáï ®â § 票©,
\ ¢®§¢à é ¥¬ëå ¥ ¢ ०¨¬¥ ª®¬¯¨«ï樨.
COUNT SFIND
DUP 0= IF 2DROP 1- 0 THEN ;
: DEFINITIONS ( -- ) \ 94 SEARCH
\ ¤¥« âì ᯨ᪮¬ ª®¬¯¨«ï樨 â®â ¦¥ ᯨ᮪ á«®¢, çâ® ¨ ¯¥à¢ë© ᯨ᮪ ¢ ¯®à浪¥
\ ¯®¨áª . ¬¥ ¯®á«¥¤ãîé¨å ®¯à¥¤¥«¥¨© ¡ã¤ãâ ¯®¬¥é âìáï ¢ ᯨ᮪ ª®¬¯¨«ï樨.
\ ®á«¥¤ãî騥 ¨§¬¥¥¨ï ¯®à浪 ¯®¨áª ¥ ¢«¨ïîâ ᯨ᮪ ª®¬¯¨«ï樨.
CONTEXT @ SET-CURRENT
;
: GET-ORDER_DROP ( CONTEXT -- widn .. wid1 )
DUP @ DUP IF >R CELL+ RECURSE R> EXIT THEN 2DROP ;
: GET-ORDER ( -- widn .. wid1 n )
DEPTH >R
CONTEXT GET-ORDER_DROP
DEPTH R> - ;
: SET-ORDER ( widn .. wid1 n -- )
DUP 0<
IF DROP ONLY
ELSE CONTEXT CONTEXT_SIZE ERASE
0
?DO CONTEXT I CELLS+ !
LOOP
THEN ;
: FORTH ( -- ) \ 94 SEARCH EXT
\ ८¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
\ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2, widFORTH-WORDLIST.
FORTH-WORDLIST CONTEXT !
;
: ONLY ( -- ) \ 94 SEARCH EXT
\ áâ ®¢¨âì ᯨ᮪ ¯®¨áª § ¢¨áï騩 ®â ॠ«¨§ 樨 ¬¨¨¬ «ìë© á¯¨á®ª ¯®¨áª .
\ ¨¨¬ «ìë© á¯¨á®ª ¯®¨áª ¤®«¦¥ ¢ª«îç âì á«®¢ FORTH-WORDLIST ¨ SET-ORDER.
CONTEXT CELL+ 0!
FORTH
;
: ALSO ( -- ) \ 94 SEARCH EXT
\ ८¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
\ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2, wid1, wid1. ¥®¯à¥¤¥«¥ ï á¨âã æ¨ï
\ ¢®§¨ª ¥â, ¥á«¨ ¢ ¯®à浪¥ ¯®¨áª ᫨誮¬ ¬®£® ᯨ᪮¢.
CONTEXT CONTEXT CELL+ CONTEXT_SIZE CMOVE> ;
: PREVIOUS ( -- ) \ 94 SEARCH EXT
\ ८¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
\ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2. ¥®¯à¥¤¥«¥ ï á¨âã æ¨ï ¢®§¨ª ¥â,
\ ¥á«¨ ¯®à冷ª ¯®¨áª ¡ë« ¯ãáâ ¯¥à¥¤ ¢ë¯®«¥¨¥¬ PREVIOUS.
_PREVIOUS ;
: _PREVIOUS ( -- ) \ 94 SEARCH EXT
CONTEXT CELL+ CONTEXT CONTEXT_SIZE CMOVE ;
: VOC-NAME. ( wid -- ) \ ¯¥ç â âì ¨¬ï ᯨ᪠᫮¢, ¥á«¨ ® ¨¬¥®¢
DUP FORTH-WORDLIST = IF DROP ." FORTH" EXIT THEN
\ DUP KERNEL-WORDLIST = IF DROP ." KERNEL" EXIT THEN
DUP CELL+ @ DUP IF ID. DROP ELSE DROP ." <NONAME>:" U. THEN
;
: ORDER ( -- ) \ 94 SEARCH EXT
\ ®ª § âì ᯨ᪨ ¢ ¯®à浪¥ ¯®¨áª , ®â ¯¥à¢®£® ¯à®á¬ âਢ ¥¬®£® ᯨ᪠¤®
\ ¯®á«¥¤¥£®. ª¦¥ ¯®ª § âì ᯨ᮪ á«®¢, ªã¤ ¯®¬¥é îâáï ®¢ë¥ ®¯à¥¤¥«¥¨ï.
\ ®à¬ â ¨§®¡à ¦¥¨ï § ¢¨á¨â ®â ॠ«¨§ 樨.
\ ORDER ¬®¦¥â ¡ëâì ॠ«¨§®¢ á ¨á¯®«ì§®¢ ¨¥¬ á«®¢ ä®à¬ ⮣® ¯à¥®¡à §®¢ ¨ï
\ ç¨á¥«. «¥¤®¢ â¥«ì® ® ¬®¦¥â à §àãè¨âì ¯¥à¥¬¥é ¥¬ãî ®¡« áâì,
\ ¨¤¥â¨ä¨æ¨à㥬ãî #>.
GET-ORDER ." Context: "
0 ?DO ( DUP .) VOC-NAME. SPACE LOOP CR
." Current: " GET-CURRENT VOC-NAME. CR
;
: LATEST ( -> NFA )
CURRENT @ @
;