Subversion Repositories Kolibri OS

Rev

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

  1. ( ‘®§¤ ­¨¥ á«®¢ àëå áâ â¥© ¨ á«®¢ à¥© WORDLIST.
  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. HEX
  13. 1 CONSTANT &IMMEDIATE \ ª®­áâ ­â  ¤«ï ¢ëá¥ç¥­¨ï ä« ¦ª  IMMEDIATE
  14. 2 CONSTANT &VOC
  15.  
  16. \ ‚®§¢à â¨âì wid - ¨¤¥­â¨ä¨ª â®à ᯨ᪠ á«®¢, ¢ª«îç î饣® ¢á¥ áâ ­¤ àâ­ë¥
  17. \ á«®¢ , ®¡¥á¯¥ç¨¢ ¥¬ë¥ ॠ«¨§ æ¨¥©. â®â ᯨ᮪ á«®¢ ¨§­ ç «ì­® ᯨ᮪
  18. \ ª®¬¯¨«ï樨 ¨ ç áâì ­ ç «ì­®£® ¯®à浪  ¯®¨áª .
  19. : >BODY ( xt -- a-addr ) \ 94
  20. \ a-addr -  ¤à¥á ¯®«ï ¤ ­­ëå, ᮮ⢥âáâ¢ãî騩 xt.
  21. \ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ xt ­¥ ®â á«®¢ ,
  22. \ ®¯à¥¤¥«¥­­®£® ç¥à¥§ CREATE.
  23. (  1+ @ ¡ë«® ¢ ¢¥àᨨ 2.5 )
  24.   5 +
  25. ;
  26.  
  27. : SWORD, ( addr u wid -> ) \ ¤®¡ ¢«¥­¨¥ § £®«®¢ª  áâ âì¨ á ¨¬¥­¥¬,
  28.          \ § ¤ ­­ë¬ áâப®© addr u, ª ᯨáªã, § ¤ ­­®¬ã wid.
  29.          \ ”®à¬¨àã¥â ⮫쪮 ¯®«ï ¨¬¥­¨ ¨ á¢ï§¨ á
  30.          \ ®â¢¥¤¥­¨¥¬ ¯ ¬ï⨠¯® ALLOT.
  31.   HERE CELL+
  32.   DUP LAST !
  33.   SWAP DUP @ , !
  34.   S, 0 C,
  35. ;
  36.  
  37. : WORDLIST ( -- wid ) \ 94 SEARCH
  38. \ ‘®§¤ ¥â ­®¢ë© ¯ãá⮩ ᯨ᮪ á«®¢, ¢®§¢à é ï ¥£® ¨¤¥­â¨ä¨ª â®à wid.
  39. \ ®¢ë© ᯨ᮪ á«®¢ ¬®¦¥â ¡ëâì ¢®§¢à é¥­ ¨§ ¯à¥¤¢ à¨â¥«ì­® à á¯à¥¤¥«¥­­ëå
  40. \ ᯨ᪮¢ á«®¢ ¨«¨ ¬®¦¥â ¤¨­ ¬¨ç¥áª¨ à á¯à¥¤¥«ïâìáï ¢ ¯à®áâà ­á⢥ ¤ ­­ëå.
  41. \ ‘¨á⥬  ¤®«¦­  ¤®¯ã᪠âì ᮧ¤ ­¨¥ ª ª ¬¨­¨¬ã¬ 8 ­®¢ëå ᯨ᪮¢ á«®¢ ¢
  42. \ ¤®¯®«­¥­¨¥ ª ¨¬¥î騬áï ¢ á¨á⥬¥.
  43.   HERE VOC-LIST  @ ,  VOC-LIST !
  44.   HERE 0 , \ §¤¥áì ¡ã¤¥â 㪠§ â¥«ì ­  ¨¬ï ¯®á«¥¤­¥£® á«®¢  ᯨ᪠
  45.        0 , \ §¤¥áì ¡ã¤¥â 㪠§ â¥«ì ­  ¨¬ï ᯨ᪠ ¤«ï ¨¬¥­®¢ ­ëå
  46.        0 , \ wid á«®¢ àï-¯à¥¤ª 
  47.        0 , \ ª« áá á«®¢ àï = wid á«®¢ àï, ®¯à¥¤¥«ïî饣® ᢮©á⢠ ¤ ­­®£®
  48. ;
  49.  
  50.  
  51. : CLASS! ( cls wid -- ) CELL+ CELL+ CELL+ ! ;
  52. : CLASS@ ( wid -- cls ) CELL+ CELL+ CELL+ @ ;
  53. : PAR!   ( Pwid wid -- ) CELL+ CELL+ ! ;
  54. : PAR@   ( wid -- Pwid ) CELL+ CELL+ @ ;
  55.  
  56.  
  57. : ID. ( NFA[E] -> )
  58.   ZCOUNT TYPE
  59. ;
  60.  
  61. \ -9 -- flags
  62. \ -8 -- cfa
  63. \ -4 -- LFA
  64. \  0 -- NFA
  65.  
  66. Code NAME>L ;( NFA -> LFA )
  67.         LEA EAX, [EAX-4]
  68.      RET
  69. EndCode
  70.  
  71. Code NAME>C ;( NFA -> 'CFA )
  72.         LEA EAX, [EAX-8]
  73.      RET
  74. EndCode
  75.  
  76. Code NAME> ;( NFA -> CFA )
  77.         MOV EAX, [EAX-8]
  78.      RET
  79. EndCode
  80.  
  81. Code NAME>F ;( NFA -> FFA )
  82.         LEA EAX, [EAX-9]
  83.      RET
  84. EndCode
  85.  
  86. Code CDR ;( NFA1 -> NFA2 )
  87.      OR EAX, EAX
  88.      SIF 0<>
  89.                 MOV EAX, [EAX-4]
  90.      STHEN
  91.      RET
  92. EndCode
  93.  
  94. : ?IMMEDIATE ( NFA -> F )
  95.   NAME>F C@ &IMMEDIATE AND
  96. ;
  97.  
  98. : ?VOC ( NFA -> F )
  99.   NAME>F C@ &VOC AND
  100. ;
  101. 0 [IF]
  102. : IMM ( -- ) \ 94
  103. \ ‘¤¥« âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥ á«®¢®¬ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï.
  104. \ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥
  105. \ ­¥ ¨¬¥¥â ¨¬¥­¨.
  106.   LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP ." I=" 2DUP H. H.
  107. ;
  108. : IMMEDIATE ( -- ) \ 94
  109. \ ‘¤¥« âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥ á«®¢®¬ ­¥¬¥¤«¥­­®£® ¨á¯®«­¥­¨ï.
  110. \ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­¨¥
  111. \ ­¥ ¨¬¥¥â ¨¬¥­¨.
  112.   LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP C!
  113. ;
  114. [THEN]
  115. : VOC ( -- )
  116. \ ®¬¥â¨âì ¯®á«¥¤­¥¥ ®¯à¥¤¥«¥­­®¥ á«®¢® ¯à¨§­ ª®¬ "á«®¢ àì".
  117.   LAST @ NAME>F DUP C@ &VOC OR SWAP C!
  118. ;
  119.  
  120. \ ==============================================
  121. \ ®â« ¤ª  - ¯®¨áª á«®¢  ¯®  ¤à¥áã ¢ ¥£® ⥫¥
  122.  
  123.  
  124. \ ==============================================
  125. \ ®â« ¤ª  - ¯®¨áª á«®¢  ¯®  ¤à¥áã ¢ ¥£® ⥫¥
  126.  
  127. : N_UMAX ( nfa nfa1 -- nfa|nfa1 )
  128.  OVER DUP IF NAME> THEN
  129.  OVER DUP IF NAME> THEN U< IF NIP EXIT THEN DROP ;
  130.  
  131. : WL_NEAR_NFA ( addr wid - addr nfa | addr 0 )
  132.    @
  133.    BEGIN 2DUP DUP IF NAME> THEN U<
  134.    WHILE CDR
  135.    REPEAT
  136. ;
  137.  
  138. 0
  139. [IF]
  140.  
  141. : NEAR_NFA ( addr - nfa addr | 0 addr )
  142.    0 SWAP
  143.    VOC-LIST
  144.     BEGIN  @ DUP
  145.     WHILE    DUP >R CELL+ WL_NEAR_NFA SWAP >R N_UMAX R>  R>
  146.     REPEAT   DROP
  147. ;
  148.  
  149. [ELSE]
  150.  
  151. : WL_NEAR_NFA_N ( addr nfa - addr nfa | addr 0 )
  152.    BEGIN 2DUP DUP IF NAME> THEN U<
  153.    WHILE CDR
  154.    REPEAT
  155. ;
  156.  
  157. : WL_NEAR_NFA_M (  addr wid - nfa2 addr | 0 addr )
  158.    0 -ROT
  159.    CELL+ @
  160.    BEGIN  DUP
  161.    WHILE  WL_NEAR_NFA_N  \  nfa addr nfa1
  162.        SWAP >R
  163.        DUP  >R  N_UMAX
  164.        R>  DUP  IF CDR THEN
  165.        R>  SWAP
  166.    REPEAT DROP
  167. ;
  168.  
  169. : NEAR_NFA ( addr - nfa addr | 0 addr )
  170.    0 SWAP
  171.    VOC-LIST
  172.    BEGIN  @ DUP
  173.    WHILE  DUP  >R   WL_NEAR_NFA_M
  174.    >R  N_UMAX  R>  R>
  175.    REPEAT DROP
  176. ;
  177.  
  178. [THEN]
  179.  
  180. : WordByAddr  ( addr -- c-addr u )
  181. \ ­ ©â¨ á«®¢®, ⥫㠪®â®à®£® ¯à¨­ ¤«¥¦¨â ¤ ­­ë©  ¤à¥á
  182.    DUP         DP @ U> IF DROP S" <not in the image>" EXIT THEN
  183.    NEAR_NFA DROP  DUP 0= IF DROP S" <not found>"        EXIT THEN
  184.    COUNT
  185. ;
  186.  
  187.  
  188. DECIMAL