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.  
  8. VECT OK.
  9. VECT <MAIN>
  10. VECT ?LITERAL
  11. VECT ?SLITERAL
  12. USER-VALUE SOURCE-ID-XT \ ¥á«¨ ­¥ à ¢¥­ ­ã«î, ⮠ᮤ¥à¦¨â § ¯®«­ïî饥
  13.  
  14. : DEPTH ( -- +n ) \ 94
  15. \ +n - ç¨á«® ®¤¨­ à­ëå ï祥ª, ­ å®¤ïé¨åáï ­  á⥪¥ ¤ ­­ëå ¯¥à¥¤
  16. \ ⥬ ª ª â㤠 ¡ë«® ¯®¬¥é¥­® +n.
  17.   SP@ S0 @ - NEGATE 4 U/
  18. ;
  19. : ?STACK ( -> ) \ ¢ë¤ âì ®è¨¡ªã "¨áç¥à¯ ­¨¥ á⥪ ", ¥á«¨ ®­ ¡®«¥¥ 祬 ¯ãáâ
  20.   SP@ S0 @ SWAP U< IF S0 @ SP! -4 THROW THEN
  21. ;
  22. : ?COMP ( -> )
  23.   STATE @ 0= IF -312 THROW THEN ( ’®«ìª® ¤«ï ०¨¬  ª®¬¯¨«ï樨 )
  24. ;
  25.  
  26. : WORD ( char "<chars>ccc<char>" -- c-addr ) \ 94
  27. \ à®¯ãáâ¨âì ¢¥¤ã騥 à §¤¥«¨â¥«¨. ‚ë¡à âì ᨬ¢®«ë, ®£à ­¨ç¥­­ë¥
  28. \ à §¤¥«¨â¥«¥¬ char.
  29. \ ˆáª«îç¨â¥«ì­ ï á¨âã æ¨ï ¢®§­¨ª ¥â, ¥á«¨ ¤«¨­  ¨§¢«¥ç¥­­®© áâப¨
  30. \ ¡®«ìè¥ ¬ ªá¨¬ «ì­®© ¤«¨­ë áâப¨ á® áç¥â稪®¬.
  31. \ c-addr -  ¤à¥á ¯¥à¥¬¥­­®© ®¡« áâ¨, ᮤ¥à¦ é¥© ¨§¢«¥ç¥­­®¥ á«®¢®
  32. \ ¢ ¢¨¤¥ áâப¨ á® áç¥â稪®¬.
  33. \ …᫨ à §¡¨à ¥¬ ï ®¡« áâì ¯ãáâ  ¨«¨ ᮤ¥à¦¨â ⮫쪮 à §¤¥«¨â¥«¨,
  34. \ १ã«ìâ¨àãîé ï áâப  ¨¬¥¥â ­ã«¥¢ãî ¤«¨­ã.
  35. \ ‚ ª®­¥æ áâப¨ ¯®¬¥é ¥âáï ¯à®¡¥«, ­¥ ¢ª«îç ¥¬ë© ¢ ¤«¨­ã áâப¨.
  36. \ à®£à ¬¬  ¬®¦¥â ¨§¬¥­ïâì ᨬ¢®«ë ¢ áâப¥.
  37.   DUP PSKIP PARSE
  38.   DUP HERE C! HERE 1+ SWAP CMOVE
  39.   BL HERE COUNT + !
  40.   HERE
  41. ;
  42. 1 [IF]
  43. : ' ( "<spaces>name" -- xt ) \ 94
  44. \ à®¯ãáâ¨âì ¢¥¤ã騥 ¯à®¡¥«ë. ‚뤥«¨âì name, ®£à ­¨ç¥­­®¥ ¯à®¡¥«®¬.  ©â¨ name
  45. \ ¨ ¢¥à­ãâì xt, ¢ë¯®«­¨¬ë© ⮪¥­ ¤«ï name. ¥®¯à¥¤¥«¥­­ ï á¨âã æ¨ï ¢®§­¨ª ¥â,
  46. \ ¥á«¨ name ­¥ ­ ©¤¥­®.
  47. \ ‚® ¢à¥¬ï ¨­â¥à¯à¥â æ¨¨  ' name EXECUTE  à ¢­®á¨«ì­®  name.
  48.   PARSE-WORD SFIND 0=
  49.   IF -321 THROW THEN (  -? )
  50. ;
  51.  
  52. [THEN]
  53.  
  54. : CHAR ( "<spaces>name" -- char ) \ 94
  55. \ à®¯ãáâ¨âì ¢¥¤ã騥 à §¤¥«¨â¥«¨. ‚뤥«¨âì ¨¬ï, ®à£ ­¨ç¥­­®¥ ¯à®¡¥« ¬¨.
  56. \ ®«®¦¨âì ª®¤ ¥£® ¯¥à¢®£® ᨬ¢®«  ­  á⥪.
  57.   PARSE-WORD DROP C@ ;
  58.  
  59. CREATE ILAST-WORD 0 , 0 ,
  60.  
  61. : INTERPRET_ ( -> ) \ ¨­â¥à¯à¥â¨à®¢ âì ¢å®¤­®© ¯®â®ª
  62.   SAVEERR? ON
  63.   BEGIN
  64.     PARSE-WORD DUP
  65.   WHILE 2DUP  ILAST-WORD 2!
  66. \       ." <" TYPE ." >"
  67.     SFIND ?DUP
  68.     IF
  69.          STATE @ =
  70.          IF COMPILE, ELSE EXECUTE THEN
  71.     ELSE
  72.          S" NOTFOUND" SFIND
  73.          IF EXECUTE
  74.          ELSE 2DROP ?SLITERAL THEN
  75. \          ?SLITERAL
  76.     THEN
  77.     ?STACK
  78.   REPEAT 2DROP
  79. ;
  80.  
  81. VARIABLE &INTERPRET
  82. ' INTERPRET_ &INTERPRET !
  83.  
  84. : INTERPRET &INTERPRET @ EXECUTE ;
  85.  
  86. \ : HALT ( ERRNUM -> ) \ ¢ë室 á ª®¤®¬ ®è¨¡ª¨
  87. \ >R exit ;
  88.  
  89. : .SN ( n --)
  90. \  á¯¥ç â âì n ¢¥àå­¨å í«¥¬¥­â®¢ á⥪ 
  91.   >R BEGIN
  92.         R@
  93.      WHILE
  94.        SP@ R@ 1- CELLS + @ DUP 0<
  95.        IF DUP U>D <# #S #> TYPE
  96.           ." (" ABS 0 <# #S [CHAR] - HOLD #> TYPE ." ) " ELSE . THEN
  97.        R> 1- >R
  98.      REPEAT RDROP
  99. ;
  100.  
  101. : OK1
  102.  STATE @ 0=
  103.  IF ."  Ok" DEPTH 70 UMIN
  104.     0 ?DO [CHAR] . EMIT LOOP CR
  105.  THEN
  106. ;
  107.  
  108. : EVAL-WORD ( a u -- )
  109. \ ¨­â¥à¯à¥â¨à®¢ âì ( â࠭᫨஢ âì) á«®¢® á ¨¬¥­¥¬  a u
  110.    SFIND ?DUP    IF
  111.    STATE @ =  IF
  112.    COMPILE,   ELSE
  113.    EXECUTE    THEN
  114.                  ELSE
  115.    -2003 THROW THEN
  116. ;
  117.  
  118. : [   \ 94 CORE
  119. \ ˆ­â¥à¯à¥â æ¨ï: ᥬ ­â¨ª  ­¥®¯à¥¤¥«¥­ .
  120. \ Š®¬¯¨«ïæ¨ï: ‚믮«­¨âì ᥬ ­â¨ªã ¢ë¯®«­¥­¨ï, ¤ ­­ãî ­¨¦¥.
  121. \ ‚믮«­¥­¨¥: ( -- )
  122. \ “áâ ­®¢¨âì á®áâ®ï­¨¥ ¨­â¥à¯à¥â æ¨¨. [ á«®¢® ­¥¬¥¤«¥­­®£® ¢ë¯®«­¥­¨ï.
  123.  STATE 0!
  124. ; IMMEDIATE
  125.  
  126. : ] ( -- ) \ 94 CORE
  127. \ “áâ ­®¢¨âì á®áâ®ï­¨¥ ª®¬¯¨«ï樨.
  128.  TRUE STATE !
  129. ;
  130.  
  131. : QUIT ( -- ) ( R: i*x ) \ CORE 94
  132. \ ‘¡à®á¨âì á⥪ ¢®§¢à â®¢, § ¯¨á âì ­®«ì ¢ SOURCE-ID.
  133. \ “áâ ­®¢¨âì áâ ­¤ àâ­ë© ¢å®¤­®© ¯®â®ª ¨ á®áâ®ï­¨¥ ¨­â¥à¯à¥â æ¨¨.
  134. \ ¥ ¢ë¢®¤¨âì á®®¡é¥­¨©. ®¢â®àïâì á«¥¤ãî饥:
  135. \ - à¨­ïâì áâப㠨§ ¢å®¤­®£® ¯®â®ª  ¢® ¢å®¤­®© ¡ãä¥à, ®¡­ã«¨âì >IN
  136. \  ¨ ¨­â¥¯à¥â¨à®¢ âì.
  137. \ - ‚뢥á⨠§ ¢¨áï饥 ®â ॠ«¨§ æ¨¨ á¨á⥬­®¥ ¯à¨£« è¥­¨¥, ¥á«¨
  138. \  á¨á⥬  ­ å®¤¨âáï ¢ á®áâ®ï­¨¨ ¨­â¥à¯à¥â æ¨¨, ¢á¥ ¯à®æ¥ááë § ¢¥à襭ë,
  139. \  ¨ ­¥â ­¥®¤­®§­ ç­ëå á¨âã æ¨©.
  140.  
  141. \ R0 @ RP! ( ­¥ ¤¥« ¥¬ í⮣®, çâ®¡ë ¯®§¢®«¨âì "['] QUIT CATCH" )
  142.  CONSOLE-HANDLES
  143.  0 TO SOURCE-ID
  144.  [COMPILE] [
  145.  <MAIN>
  146. ;
  147.  
  148. : MAIN1 ( -- )
  149.  BEGIN REFILL
  150.  WHILE INTERPRET OK.
  151.  REPEAT _BYE
  152. ;
  153. ' MAIN1 TO <MAIN>
  154.  
  155. : SAVE-SOURCE ( -- i*x i )
  156.  SOURCE-ID-XT  SOURCE-ID   >IN @   SOURCE   CURSTR @   6
  157. ;
  158.  
  159. : RESTORE-SOURCE ( i*x i  -- )
  160.  6 <> IF ABORT THEN
  161.  CURSTR !    SOURCE!  >IN !  TO SOURCE-ID   TO SOURCE-ID-XT
  162. ;
  163.  
  164. : EVALUATE-WITH ( ( i*x c-addr u xt -- j*x )
  165. \ ‘ç¨â ï c-addr u ¢å®¤­ë¬ ¯®â®ª®¬, ¢ëç¨á«¨âì ¥ñ ¨­â¥à¯à¥â â®à®¬ xt.
  166.  SAVE-SOURCE N>R
  167.  >R  SOURCE!  -1 TO SOURCE-ID
  168.  R> ( ['] INTERPRET) CATCH
  169.  NR> RESTORE-SOURCE
  170.  THROW
  171. ;
  172.  
  173. : EVALUATE ( i*x c-addr u -- j*x ) \ 94
  174. \ ‘®åà ­ï¥â ⥪ã騥 ᯥæ¨ä¨ª æ¨¨ ¢å®¤­®£® ¯®â®ª .
  175. \ ‡ ¯¨á뢠¥â -1 ¢ SOURCE-ID. „¥« ¥â áâபã, § ¤ ­­ãî c-addr u,
  176. \ ¢å®¤­ë¬ ¯®â®ª®¬ ¨ ¢å®¤­ë¬ ¡ãä¥à®¬, ãáâ ­ ¢«¨¢ ¥â >IN ¢ 0
  177. \ ¨ ¨­â¥à¯à¥â¨àã¥â. Š®£¤  áâப  à §®¡à ­  ¤® ª®­æ  - ¢®ááâ ­ ¢«¨¢ ¥â
  178. \ ᯥæ¨ä¨ª æ¨¨ ¯à¥¤ë¤ã饣® ¢å®¤­®£® ¯®â®ª .
  179. \ „à㣨¥ ¨§¬¥­¥­¨ï á⥪  ®¯à¥¤¥«ïîâáï ¢ë¯®«­ï¥¬ë¬¨ ¯® EVALUATE á«®¢ ¬¨.
  180.  ['] INTERPRET EVALUATE-WITH
  181. ;
  182.  
  183. : FQUIT
  184.         BEGIN REFILL
  185.         WHILE INTERPRET
  186. REPEAT ;
  187.  
  188. : INCLUDE-FILE ( i*x fileid -- j*x ) \ 94 FILE
  189.         >IN  @ >R
  190.         SOURCE-ID >R  TO SOURCE-ID
  191.         RP@ #TIB @ ALIGNED - RP!
  192.         TIB     RP@ #TIB @ CMOVE
  193.         SOURCE 2>R
  194. \       TCR ." IF"
  195.         ['] FQUIT CATCH SAVEERR
  196. \       ['] NOOP CATCH  SAVEERR
  197.  
  198.         2R> SOURCE!
  199.         RP@ TIB  #TIB @ CMOVE
  200.         RP@ #TIB @ ALIGNED + RP!
  201.         R> TO SOURCE-ID
  202.         R> >IN ! THROW      ;
  203.  
  204. : INCLUDED_  ( c-addr u ---- )
  205. \ Open the file with name c-addr u and interpret all lines contained in it.
  206.         R/O  OPEN-FILE THROW \ ABORT" Can't open include file"
  207.         DUP >R
  208.         ['] INCLUDE-FILE CATCH
  209.         R> CLOSE-FILE DROP THROW
  210. ;
  211.  
  212. : REQUIRED ( waddr wu laddr lu -- )
  213.   2SWAP SFIND
  214.   IF DROP 2DROP
  215.   ELSE 2DROP INCLUDED_ THEN
  216. ;
  217. : REQUIRE ( "word" "libpath" -- )
  218.   PARSE-NAME PARSE-NAME 2DUP + 0 SWAP C!
  219.   REQUIRED
  220. ;
  221.  
  222. : AUTOEXEC S" /sys/INIT.F" INCLUDED_ ;
  223.