Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ( ®¨áª á«®¢ ¢ á«®¢ àïå ¨ ã¯à ¢«¥­¨¥ ¯®à浪®¬ ¯®¨áª .
  2.   Ž‘-­¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥­¨ï.
  3.   Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  4.   à¥®¡à §®¢ ­¨¥ ¨§ 16-à §à來®£® ¢ 32-à §àï¤­ë© ª®¤ - 1995-96££
  5.   ¥¢¨§¨ï - ᥭâï¡àì 1999
  6.   Œ®¤¨ä¨æ¨à®¢ ­­® Œ ªá¨¬®¢ë¬ Œ.Ž.
  7.   email:mak@mail.rtc.neva.ru
  8.   http://informer.rtc.neva.ru/
  9.   â ¤ {812}105-92-03
  10.   â à {812}552-47-64
  11. )
  12.  
  13. VECT FIND
  14.  
  15. 0x10 CELLS CONSTANT CONTEXT_SIZE
  16.  
  17. CREATE SEARCH-BUFF 0x81 ALLOT
  18.  
  19. Code ZSEARCH-WORDLIST ;( z-addr wid -- 0 | xt 1 | xt -1 ) \ 94 SEARCH
  20. ;  ©â¨ ®¯à¥¤¥«¥­¨¥, § ¤ ­­®¥ áâப®© c-addr u ¢ ᯨ᪥ á«®¢, ¨¤¥­â¨ä¨æ¨à㥬®¬
  21. ; wid. …᫨ ®¯à¥¤¥«¥­¨¥ ­¥ ­ ©¤¥­®, ¢¥à­ãâì ­®«ì.
  22. ; …᫨ ®¯à¥¤¥«¥­¨¥ ­ ©¤¥­®, ¢¥à­ãâì ¢ë¯®«­¨¬ë© ⮪¥­ xt ¨ ¥¤¨­¨æã (1), ¥á«¨
  23. ; ®¯à¥¤¥«¥­¨¥ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï, ¨­ ç¥ ¬¨­ãá ¥¤¨­¨æã (-1).
  24. ;       PUSH    WORD PTR [EBP]
  25.         MOV     EDX, [EBP]
  26.         PUSH    EDX
  27.         MOV     EAX, [EAX]
  28.         PUSH    EAX
  29.         LEA     EBP,  [EBP+4]
  30.         CALL    {' GETPR}
  31.         test    eax, eax
  32.         JZ      END
  33.         LEA     EBP, [EBP-4]
  34.         mov     [ebp],eax
  35.         MOVZX   EAX, BYTE PTR [EDX-9]
  36.         DEC     EAX
  37.         OR      EAX,1
  38.        
  39. END:       RET
  40. EndCode
  41.  
  42. : SEARCH-WORDLIST ( c-addr u wid -- 0 | xt 1 | xt -1 )
  43.  >R 0x7F AND SEARCH-BUFF  ASCII-Z
  44.  R>  ZSEARCH-WORDLIST
  45.  
  46. ;
  47.  
  48. : SFIND ( addr len --- addr len 0| xt 1|xt -1 )
  49. \ Search all word lists in the search order for the name in the
  50. \ counted string at c-addr. If not found return the name address and 0.
  51. \ If found return the execution token xt and -1 if the word is non-immediate
  52. \ and 1 if the word is immediate.
  53.  CONTEXT
  54.   BEGIN DUP @
  55.   WHILE >R
  56.         2DUP  R@ @ SEARCH-WORDLIST ?DUP
  57.         IF    RDROP 2NIP  EXIT \ Exit if found.
  58.         THEN
  59.         R> CELL+
  60.  REPEAT @
  61. ;
  62.  
  63. : FIND1 ( c-addr -- c-addr 0 | xt 1 | xt -1 ) \ 94 SEARCH
  64. \  áè¨à¨âì ᥬ ­â¨ªã CORE FIND á«¥¤ãî騬:
  65. \ ˆáª âì ®¯à¥¤¥«¥­¨¥ á ¨¬¥­¥¬, § ¤ ­­ë¬ áâப®© á® áç¥â稪®¬ c-addr.
  66. \ …᫨ ®¯à¥¤¥«¥­¨¥ ­¥ ­ ©¤¥­® ¯®á«¥ ¯à®á¬®âà  ¢á¥å ᯨ᪮¢ ¢ ¯®à浪¥ ¯®¨áª ,
  67. \ ¢®§¢à â¨âì c-addr ¨ ­®«ì. …᫨ ®¯à¥¤¥«¥­¨¥ ­ ©¤¥­®, ¢®§¢à â¨âì xt.
  68. \ …᫨ ®¯à¥¤¥«¥­¨¥ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï, ¢¥à­ãâì â ª¦¥ ¥¤¨­¨æã (1);
  69. \ ¨­ ç¥ â ª¦¥ ¢¥à­ãâì ¬¨­ãá ¥¤¨­¨æã (-1). „«ï ¤ ­­®© áâப¨, §­ ç¥­¨ï,
  70. \ ¢®§¢à é ¥¬ë¥ FIND ¢® ¢à¥¬ï ª®¬¯¨«ï樨, ¬®£ã⠮⫨ç âìáï ®â §­ ç¥­¨©,
  71. \ ¢®§¢à é ¥¬ëå ­¥ ¢ ०¨¬¥ ª®¬¯¨«ï樨.
  72.  COUNT SFIND
  73.  DUP 0= IF 2DROP 1- 0 THEN ;
  74.  
  75. : DEFINITIONS ( -- ) \ 94 SEARCH
  76. \ ‘¤¥« âì ᯨ᪮¬ ª®¬¯¨«ï樨 â®â ¦¥ ᯨ᮪ á«®¢, çâ® ¨ ¯¥à¢ë© ᯨ᮪ ¢ ¯®à浪¥
  77. \ ¯®¨áª . ˆ¬¥­  ¯®á«¥¤ãîé¨å ®¯à¥¤¥«¥­¨© ¡ã¤ãâ ¯®¬¥é âìáï ¢ ᯨ᮪ ª®¬¯¨«ï樨.
  78. \ ®á«¥¤ãî騥 ¨§¬¥­¥­¨ï ¯®à浪  ¯®¨áª  ­¥ ¢«¨ïîâ ­  ᯨ᮪ ª®¬¯¨«ï樨.
  79.  CONTEXT @ SET-CURRENT
  80. ;
  81.  
  82. : GET-ORDER_DROP ( CONTEXT -- widn .. wid1 )
  83.  DUP @ DUP IF >R CELL+ RECURSE R> EXIT THEN 2DROP ;
  84.  
  85. : GET-ORDER     ( -- widn .. wid1 n )
  86.         DEPTH >R
  87.         CONTEXT GET-ORDER_DROP
  88.         DEPTH R> - ;
  89.  
  90. : SET-ORDER     ( widn .. wid1 n -- )
  91.                DUP 0<
  92.                IF      DROP ONLY
  93.                ELSE    CONTEXT CONTEXT_SIZE ERASE
  94.                        0
  95.                        ?DO     CONTEXT I CELLS+ !
  96.                        LOOP
  97.                THEN    ;
  98.  
  99.  
  100. : FORTH ( -- ) \ 94 SEARCH EXT
  101. \ à¥®¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
  102. \ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2, widFORTH-WORDLIST.
  103.  FORTH-WORDLIST CONTEXT !
  104. ;
  105.  
  106. : ONLY ( -- ) \ 94 SEARCH EXT
  107. \ “áâ ­®¢¨âì ᯨ᮪ ¯®¨áª  ­  § ¢¨áï騩 ®â ॠ«¨§ æ¨¨ ¬¨­¨¬ «ì­ë© ᯨ᮪ ¯®¨áª .
  108. \ Œ¨­¨¬ «ì­ë© ᯨ᮪ ¯®¨áª  ¤®«¦¥­ ¢ª«îç âì á«®¢  FORTH-WORDLIST ¨ SET-ORDER.
  109.  CONTEXT CELL+ 0!
  110.  FORTH
  111. ;
  112.  
  113. : ALSO ( -- ) \ 94 SEARCH EXT
  114. \ à¥®¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
  115. \ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2, wid1, wid1. ¥®¯à¥¤¥«¥­­ ï á¨âã æ¨ï
  116. \ ¢®§­¨ª ¥â, ¥á«¨ ¢ ¯®à浪¥ ¯®¨áª  ᫨誮¬ ¬­®£® ᯨ᪮¢.
  117. CONTEXT CONTEXT CELL+ CONTEXT_SIZE CMOVE> ;
  118.  
  119.  
  120. : PREVIOUS ( -- ) \ 94 SEARCH EXT
  121. \ à¥®¡à §®¢ âì ¯®à冷ª ¯®¨áª , á®áâ®ï騩 ¨§ widn, ...wid2, wid1 (£¤¥ wid1
  122. \ ¯à®á¬ âਢ ¥âáï ¯¥à¢ë¬) ¢ widn,... wid2. ¥®¯à¥¤¥«¥­­ ï á¨âã æ¨ï ¢®§­¨ª ¥â,
  123. \ ¥á«¨ ¯®à冷ª ¯®¨áª  ¡ë« ¯ãáâ ¯¥à¥¤ ¢ë¯®«­¥­¨¥¬ PREVIOUS.
  124.  _PREVIOUS ;
  125.  
  126. : _PREVIOUS ( -- ) \ 94 SEARCH EXT
  127. CONTEXT CELL+ CONTEXT CONTEXT_SIZE CMOVE  ;
  128.  
  129. : VOC-NAME. ( wid -- ) \ ­ ¯¥ç â âì ¨¬ï ᯨ᪠ á«®¢, ¥á«¨ ®­ ¨¬¥­®¢ ­
  130.  DUP FORTH-WORDLIST = IF DROP ." FORTH"  EXIT THEN
  131. \ DUP KERNEL-WORDLIST = IF DROP ." KERNEL"  EXIT THEN
  132.  DUP CELL+ @ DUP IF ID. DROP ELSE DROP ." <NONAME>:" U. THEN
  133. ;
  134.  
  135. : ORDER ( -- ) \ 94 SEARCH EXT
  136. \ ®ª § âì ᯨ᪨ ¢ ¯®à浪¥ ¯®¨áª , ®â ¯¥à¢®£® ¯à®á¬ âਢ ¥¬®£® ᯨ᪠ ¤®
  137. \ ¯®á«¥¤­¥£®. ’ ª¦¥ ¯®ª § âì ᯨ᮪ á«®¢, ªã¤  ¯®¬¥é îâáï ­®¢ë¥ ®¯à¥¤¥«¥­¨ï.
  138. \ ”®à¬ â ¨§®¡à ¦¥­¨ï § ¢¨á¨â ®â ॠ«¨§ æ¨¨.
  139. \ ORDER ¬®¦¥â ¡ëâì ॠ«¨§®¢ ­ á ¨á¯®«ì§®¢ ­¨¥¬ á«®¢ ä®à¬ â­®£® ¯à¥®¡à §®¢ ­¨ï
  140. \ ç¨á¥«. ‘«¥¤®¢ â¥«ì­® ®­ ¬®¦¥â à §àãè¨âì ¯¥à¥¬¥é ¥¬ãî ®¡« áâì,
  141. \ ¨¤¥­â¨ä¨æ¨à㥬ãî #>.
  142.  GET-ORDER ." Context: "
  143.  0 ?DO ( DUP .) VOC-NAME. SPACE LOOP CR
  144.  ." Current: " GET-CURRENT VOC-NAME. CR
  145. ;
  146.  
  147. : LATEST ( -> NFA )
  148.  CURRENT @ @
  149. ;
  150.