Subversion Repositories Kolibri OS

Rev

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

  1. ( 28.Mar.2000 Andrey Cherezov  Copyright [C] RU FIG
  2.  
  3.   ˆá¯®«ì§®¢ ­ë ¨¤¥¨ á«¥¤ãîé¨å  ¢â®à®¢:
  4.   Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
  5.   Konstantin Tarasov; Michail Maximov.
  6.  
  7.   !!  ¡®â ¥â ⮫쪮 ¢ SPF4.
  8. )
  9.  
  10. ( à®á⮥ à áè¨à¥­¨¥ ‘-”®àâ  «®ª «ì­ë¬¨ ¯¥à¥¬¥­­ë¬¨.
  11.   ¥ «¨§®¢ ­® ¡¥§ ¨á¯®«ì§®¢ ­¨ï LOCALS áâ ­¤ àâ  94.
  12.  
  13.   Ž¡ê¥­¨¥ ¢à¥¬¥­­ëå ¯¥à¥¬¥­­ëå, ¢¨¤¨¬ëå ⮫쪮 ¢­ãâà¨
  14.   ⥪ã饣® á«®¢  ¨ ®£à ­¨ç¥­­ëå ¢à¥¬¥­¥¬ ¢ë§®¢  ¤ ­­®£®
  15.   á«®¢  ¢ë¯®«­ï¥âáï á ¯®¬®éìî á«®¢  "{". ‚­ãâਠ®¯à¥¤¥«¥­¨ï
  16.   á«®¢  ¨á¯®«ì§ã¥âáï ª®­áâàãªæ¨ï, ¯®¤®¡­ ï á⥪®¢®© ­®â æ¨¨ ”®àâ 
  17.   { ᯨ᮪_¨­¨æ¨ «¨§¨à®¢ ­­ëå_«®ª «®¢ \ á¯.­¥¨­¨æ.«®ª «®¢ -- ç⮠㣮¤­® }
  18.    ¯à¨¬¥à:
  19.  
  20.   { a b c d \ e f -- i j }
  21.  
  22.   ˆ«¨ { a b c d \ e f[ EVALUATE_¢ëà ¦¥­¨¥ ] -- i j }
  23.   â® §­ ç¨â çâ® ¤«ï ¯¥à¥¬¥­­®© f[ ¡ã¤¥â ¢ë¤¥«¥­ ­  á⥪¥ ¢®§¢à â®¢ ãç á⮪
  24.   ¯ ¬ï⨠¤«¨­®© n ¡ ©â. ˆá¯®«ì§®¢ ­¨¥ ¯¥à¥¬¥­­®© f[ ¤ áâ  ¤à¥á ­ ç «  í⮣®
  25.   ãç á⪠. \‚ á⨫¥ MPE\
  26.  
  27.   ˆ«¨ { a b c d \ e [ 12 ] f -- i j }
  28.   â® §­ ç¨â çâ® ¤«ï ¯¥à¥¬¥­­®© f ¡ã¤¥â ¢ë¤¥«¥­ ­  á⥪¥ ¢®§¢à â®¢ ãç á⮪
  29.   ¯ ¬ï⨠¤«¨­®© 12 ¡ ©â. ˆá¯®«ì§®¢ ­¨¥ ¯¥à¥¬¥­­®© f ¤ áâ  ¤à¥á ­ ç «  í⮣®
  30.   ãç á⪠.
  31.  
  32.   — áâì "\ á¯.­¥¨­¨æ.«®ª «®¢" ¬®¦¥â ®âáãâá⢮¢ âì, ­ ¯à¨¬¥à:
  33.  
  34.   { item1 item2 -- }
  35.  
  36.   â® § áâ ¢«ï¥â ‘-”®àâ  ¢â®¬ â¨ç¥áª¨ ¢ë¤¥«ïâì ¬¥áâ® ¢
  37.   á⥪¥ ¢®§¢à â®¢ ¤«ï íâ¨å ¯¥à¥¬¥­­ëå ¢ ¬®¬¥­â ¢ë§®¢  á«®¢ 
  38.   ¨  ¢â®¬ â¨ç¥áª¨ ®á¢®¡®¦¤ âì ¬¥áâ® ¯à¨ ¢ë室¥ ¨§ ­¥£®.
  39.  
  40.   Ž¡à é¥­¨¥ ª â ª¨¬ «®ª «ì­ë¬ ¯¥à¥¬¥­­ë¬ - ª ª ª VALUE-¯¥à¥¬¥­­ë¬
  41.   ¯® ¨¬¥­¨. …᫨ ­ã¦¥­  ¤à¥á ¯¥à¥¬¥­­®©, â® ¨á¯®«ì§ã¥âáï "^ ¨¬ï"
  42.   ¨«¨ "AT ¨¬ï".
  43.  
  44.  
  45.   ‚¬¥áâ® \ ¬®¦­® ¨á¯®«ì§®¢ âì |
  46.   ‚¬¥áâ® -> ¬®¦­® ¨á¯®«ì§®¢ âì TO
  47.  
  48.   à¨¬¥àë:
  49.  
  50.   : TEST { a b c d \ e f -- } a . b . c .  b c + -> e  e .  f .  ^ a @ . ;
  51.    Ok
  52.   1 2 3 4 TEST
  53.   1 2 3 5 0 1  Ok
  54.  
  55.   : TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
  56.    Ok
  57.   12 34 TEST
  58.   12 34
  59.   0 12 34
  60.   1 12 34
  61.   2 12 34
  62.   3 12 34
  63.   4 12 34
  64.    Ok
  65.  
  66.   : TEST { a b } a . b . ;
  67.    Ok
  68.   1 2 TEST
  69.   1 2  Ok
  70.  
  71.   : TEST { a b \ c } a . b . c . ;
  72.    Ok
  73.   1 2 TEST
  74.   1 2 0  Ok
  75.  
  76.   : TEST { a b -- } a . b . ;
  77.    Ok
  78.   1 2 TEST
  79.   1 2  Ok
  80.  
  81.   : TEST { a b \ c -- d } a . b . c . ;
  82.    Ok
  83.   1 2 TEST
  84.   1 2 0  Ok
  85.  
  86.   : TEST { \ a b } a . b .  1 -> a  2 -> b  a . b . ;
  87.    Ok
  88.   TEST
  89.   0 0 1 2  Ok
  90.  
  91.   ˆ¬¥­  «®ª «ì­ëå ¯¥à¥¬¥­­ëå áãé¥áâ¢ãîâ ¢ ¤¨­ ¬¨ç¥áª®¬
  92.   ¢à¥¬¥­­®¬ á«®¢ à¥ ⮫쪮 ¢ ¬®¬¥­â ª®¬¯¨«ï樨 á«®¢ ,  
  93.   ¯®á«¥ í⮣® ¢ëç¨é îâáï ¨ ¡®«¥¥ ­¥¤®áâ㯭ë.
  94.  
  95.   ˆá¯®«ì§®¢ âì ª®­áâàãªæ¨î "{ ... }" ¢­ãâਠ®¤­®£® ®¯à¥¤¥«¥­¨ï ¬®¦­®
  96.   ⮫쪮 ®¤¨­ à §.
  97.  
  98.   Š®¬¯¨«ïæ¨ï í⮩ ¡¨¡«¨®â¥ª¨ ¤®¡ ¢«ï¥â ¢ ⥪ã騩 á«®¢ àì ª®¬¯¨«ï樨
  99.   ’®«ìª® ¤¢  á«®¢ :
  100.   á«®¢ àì "vocLocalsSupport" ¨ "{"
  101.   ‚ᥠ®áâ «ì­ë¥ ¤¥â «¨ "á¯àïâ ­ë" ¢ á«®¢ à¥, ¨á¯®«ì§®¢ âì ¨å
  102.   ­¥ ४®¬¥­¤ã¥âáï.
  103. )
  104.  
  105. REQUIRE [IF] ~MAK\CompIF.f
  106.  
  107. C" 'DROP_V" FIND NIP 0=
  108. [IF]  ' DROP VALUE 'DROP_V
  109. : 'DROP 'DROP_V ;
  110. [THEN]
  111.  
  112. C" 'DUP_V" FIND NIP 0=
  113. [IF]  ' DUP VALUE 'DUP_V
  114. :  'DUP  'DUP_V ;
  115. [THEN]
  116.  
  117. C" 'DROP" FIND NIP 0=
  118. [IF]  ' DROP VALUE 'DROP
  119. [THEN]
  120.  
  121. C" 'DUP" FIND NIP 0=
  122. [IF]  ' DUP VALUE 'DUP
  123. [THEN]
  124.  
  125. \ C" '(LocalsExit)_V" FIND NIP 0=
  126. \ [IF]  ' (LocalsExit)_V VALUE '(LocalsExit)_V
  127. \ [THEN]
  128.  
  129. MODULE: vocLocalsSupport_M
  130.  
  131. VARIABLE uLocalsCnt
  132. VARIABLE uLocalsUCnt
  133. VARIABLE uPrevCurrent
  134. VARIABLE uAddDepth
  135.  
  136. : LocalOffs ( n -- offs )
  137.   2+ CELLS uAddDepth @ +
  138. ;
  139.  
  140. BASE @ HEX
  141.  
  142. ' RP@ 7 + @ 0xC3042444 =
  143.  
  144. [IF]
  145.  
  146. : R_ALLOT,
  147.  DUP  SHORT?
  148.  OPT_INIT SetOP
  149.  IF    8D C, 64 C, 24 C,  C, \ mov esp, offset [esp]
  150.  ELSE  8D C, A4 C, 24 C,  , \ mov esp, offset [esp]
  151.  THEN
  152.  OPT_CLOSE
  153. ;  
  154.  
  155. C" MACRO," FIND NIP 0=
  156. [IF] : MACRO, INLINE,  ;
  157. [THEN]
  158.  
  159. : CompileLocalRec ( u -- )
  160.  LocalOffs DUP  
  161.  'DUP MACRO,
  162.   SHORT?
  163.   OPT_INIT SetOP
  164.   IF    8D C, 44 C, 24 C, C, \ lea eax, offset [esp]
  165.   ELSE  8D C, 84 C, 24 C,  , \ lea eax, offset [esp]
  166.   THEN  OPT
  167.   OPT_CLOSE
  168. ;
  169.  
  170. : CompileLocal@ ( n -- )
  171.   'DUP MACRO,
  172.  LocalOffs DUP  SHORT?
  173.  OPT_INIT SetOP
  174.  IF    8B C, 44 C, 24 C, C, \ mov eax, offset [esp]
  175.  ELSE  8B C, 84 C, 24 C,  , \ mov eax, offset [esp]
  176.  THEN  OPT
  177.  OPT_CLOSE
  178. ;
  179.  
  180. : CompileLocal! ( n -- )
  181.  LocalOffs DUP  SHORT?
  182.  OPT_INIT SetOP
  183.  IF    89 C, 44 C, 24 C, C, \ mov  offset [esp], eax
  184.  ELSE  89 C, 84 C, 24 C,  , \ mov  offset [esp], eax
  185.  THEN  OPT
  186.  OPT_CLOSE
  187.  'DROP MACRO,
  188. ;
  189.  
  190. \ : CompileLocal@ ( n -- )
  191. \   LocalOffs LIT, POSTPONE RP+@
  192. \ ;
  193.  
  194.  
  195. [ELSE]
  196.  
  197. : R_ALLOT,
  198.  ] POSTPONE LITERAL  S"  RP@ + RP! " EVALUATE
  199.  POSTPONE [ ;
  200.  
  201. : CompileLocalRec ( u -- )
  202.   LocalOffs
  203.   POSTPONE LITERAL
  204. \  S"  RP@ + " EVALUATE
  205. ;
  206.  
  207. : CompileLocal@ ( n -- )
  208.   CompileLocalRec
  209.   S" @ " EVALUATE
  210. ;
  211.  
  212. : CompileLocal! ( n -- )
  213.   CompileLocalRec
  214.   S" ! " EVALUATE
  215. ;
  216.  
  217. [THEN]
  218.  
  219. VARIABLE TEMP-DP
  220.  
  221. : CompileLocalsInit
  222.   TEMP-DP @ DP !
  223.   uPrevCurrent @ SET-CURRENT
  224.   uLocalsUCnt @ ?DUP
  225.   IF NEGATE CELLS R_ALLOT,
  226.   THEN
  227.   uLocalsCnt @ uLocalsUCnt @ - ?DUP
  228.   IF DUP CELLS NEGATE uAddDepth +!  0 DO  S" >R " EVALUATE LOOP THEN
  229.   uLocalsCnt  @ ?DUP
  230.   IF CELLS POSTPONE LITERAL S" >R ['] (LocalsExit) >R" EVALUATE
  231.      -2 CELLS uAddDepth +!
  232.   THEN
  233. ;
  234.  
  235.  
  236. \ : CompileLocal@ ( n -- )
  237. \   LocalOffs LIT, POSTPONE RP+@
  238. \ ;
  239.  
  240.  
  241. BASE !
  242.  
  243. WORDLIST CONSTANT widLocals@
  244.  
  245. CREATE  TEMP-BUF 1000 ALLOT
  246.  
  247. : LocalsStartup
  248.   GET-CURRENT uPrevCurrent !
  249.   ALSO vocLocalsSupport_M
  250.   ALSO widLocals@ CONTEXT ! DEFINITIONS
  251.   HERE TEMP-DP !
  252.   TEMP-BUF DP !
  253.   widLocals@  0!
  254.   uLocalsCnt 0!
  255.   uLocalsUCnt 0!
  256.   uAddDepth 0!
  257. ;
  258. : LocalsCleanup
  259.   PREVIOUS PREVIOUS
  260. ;
  261.  
  262. : ProcessLocRec ( "name" -- u )
  263.   [CHAR] ] PARSE
  264.   STATE 0!
  265.   EVALUATE CELL 1- + CELL / \ ¤¥« ¥¬ ªà â­ë¬ 4
  266.   -1 STATE !
  267. \  DUP uLocalsCnt +!
  268.   uLocalsCnt @
  269. ;
  270.  
  271. : CreateLocArray
  272.   [CHAR] [ PSKIP
  273.   ProcessLocRec
  274.   CREATE ,
  275.   DUP uLocalsCnt +!  
  276. ;
  277.  
  278. : LocalsRecDoes@ ( -- u )
  279.   DOES>  @ CompileLocalRec
  280. ;
  281.  
  282. : LocalsRecDoes@2 ( -- u )
  283.   ProcessLocRec ,
  284.   DUP uLocalsCnt +!
  285.   DOES> @ CompileLocalRec
  286. ;
  287.  
  288. : LocalsDoes@
  289.   uLocalsCnt @ ,
  290.   uLocalsCnt 1+!
  291.   DOES>  @ CompileLocal@
  292. ;
  293.  
  294. : ;; POSTPONE ; ; IMMEDIATE
  295.  
  296.  
  297. : ^
  298.   ' >BODY @
  299.  CompileLocalRec
  300. ; IMMEDIATE
  301.  
  302.  
  303. : -> ' >BODY @ CompileLocal!  ; IMMEDIATE
  304.  
  305. WARNING DUP @ SWAP 0!
  306.  
  307. : AT
  308.   [COMPILE] ^
  309. ; IMMEDIATE
  310.  
  311. : TO ( "name" -- )
  312.   >IN @ NextWord widLocals@ SEARCH-WORDLIST 1 =
  313.   IF >BODY @ CompileLocal! DROP
  314.   ELSE >IN ! [COMPILE] TO
  315.   THEN
  316. ; IMMEDIATE
  317.  
  318. WARNING !
  319.  
  320. : ¢ POSTPONE -> ; IMMEDIATE
  321.  
  322. WARNING @ WARNING 0!
  323. \ ===
  324. \ ¯¥à¥®¯à¥¤¥«¥­¨¥ ᮮ⢥âáâ¢ãîé¨å á«®¢ ¤«ï ¢®§¬®¦­®á⨠¨á¯®«ì§®¢ âì
  325. \ ¢à¥¬¥­­ë¥ ¯¥à¥¬¥­­ë¥ ¢­ãâਠ æ¨ª«  DO LOOP  ¨ ­¥§ ¢¨á¨¬® ®â ¨§¬¥­¥­¨ï
  326. \ ᮤ¥à¦¨¬®£® á⥪  ¢®§¢à â®¢  á«®¢ ¬¨   >R   R>
  327. C" DO_SIZE" FIND NIP 0=
  328. [IF] 3 CELLS CONSTANT DO_SIZE
  329. [THEN]
  330.  
  331.  
  332. : DO    POSTPONE DO      DO_SIZE              uAddDepth +! ; IMMEDIATE
  333. : ?DO   POSTPONE ?DO     DO_SIZE              uAddDepth +! ; IMMEDIATE
  334. : LOOP  POSTPONE LOOP    DO_SIZE NEGATE       uAddDepth +! ; IMMEDIATE
  335. : +LOOP POSTPONE +LOOP   DO_SIZE NEGATE       uAddDepth +! ; IMMEDIATE
  336. : >R    POSTPONE >R     [  1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  337. : R>    POSTPONE R>     [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  338. : RDROP POSTPONE RDROP  [ -1 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  339. : 2>R   POSTPONE 2>R    [  2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  340. : 2R>   POSTPONE 2R>    [ -2 CELLS ] LITERAL  uAddDepth +! ; IMMEDIATE
  341.  
  342. \ ===
  343.  
  344. \  uLocalsCnt  @ ?DUP
  345. \  IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
  346.  
  347. : ;  LocalsCleanup
  348.     S" ;" EVAL-WORD
  349. ; IMMEDIATE
  350.  
  351. WARNING !
  352.  
  353. \ =====================================================================
  354.  
  355.  
  356. EXPORT
  357.  
  358. : {
  359.  
  360.  LocalsStartup
  361.  BEGIN
  362.    BL PSKIP PeekChar DUP [CHAR] \ <>
  363.                    OVER [CHAR] - <>  AND
  364.                    OVER [CHAR] } <>  AND
  365.                    OVER [CHAR] | <>  AND
  366.                    SWAP [CHAR] ) XOR AND
  367.  WHILE
  368.    CREATE LocalsDoes@ IMMEDIATE
  369.  REPEAT
  370.  PeekChar >IN 1+! DUP [CHAR] } <>
  371.  IF
  372.     DUP [CHAR] \ =
  373.    SWAP [CHAR] | = OR
  374.    IF
  375.      BEGIN
  376.        BL PSKIP PeekChar DUP
  377.         DUP [CHAR] - <>
  378.        SWAP [CHAR] } <>  AND
  379.        SWAP [CHAR] ) XOR AND
  380.      WHILE
  381.        PeekChar [CHAR] [ =
  382.        IF  CreateLocArray  LocalsRecDoes@
  383.        ELSE
  384.             CREATE LATEST DUP C@ + C@
  385.             [CHAR] [ =
  386.             IF  
  387.               LocalsRecDoes@2
  388.             ELSE
  389.               LocalsDoes@ 1
  390.             THEN
  391.        THEN  DUP U.
  392.        uLocalsUCnt +!
  393.        IMMEDIATE
  394.      REPEAT
  395.    THEN
  396.    [CHAR] } PARSE 2DROP
  397.  ELSE DROP THEN
  398.  CompileLocalsInit
  399. ;; IMMEDIATE
  400.  
  401. ;MODULE
  402.