Subversion Repositories Kolibri OS

Rev

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

  1.  
  2. \ Temporary variables
  3. ( 24.09.1997 —¥à¥§®¢ €. )
  4. \ April 12th, 2000 - 14:44 Mihail Maksimov
  5. \ ¤®¡ ¢¨« ª®­áâàãªæ¨¨ !! ... !! ¨ >| ... | , «¨ª¢¨¤¨à®¢ « |DOES
  6.  
  7. \ ®¯â¨¬¨§¨à®¢ ­­ë© ¢ à¨ ­â. ¯¥à¥¬¥­­ë¥ ¬®¦­® ¨á¯®«ì§®¢ âì ¨ ¢­ãâਠDO LOOP
  8. ( 10.06.1999 Ruvim Pinka, idea - Mihail Maksimov )
  9.  
  10. ( à®á⮥ à áè¨à¥­¨¥ ‘-”®àâ  «®ª «ì­ë¬¨ ¯¥à¥¬¥­­ë¬¨.
  11.   ¥ «¨§®¢ ­® ¡¥§ ¨á¯®«ì§®¢ ­¨ï LOCALS áâ ­¤ àâ  94.
  12.  
  13.   Ž¡ê¥­¨¥ ¢à¥¬¥­­ëå ¯¥à¥¬¥­­ëå, ¢¨¤¨¬ëå ⮫쪮 ¢­ãâà¨
  14.   ⥪ã饣® á«®¢  ¨ ®£à ­¨ç¥­­ëå ¢à¥¬¥­¥¬ ¢ë§®¢  ¤ ­­®£®
  15.   á«®¢  ¢ë¯®«­ï¥âáï á ¯®¬®éìî á«®¢  "|"  ­ «®£¨ç­®
  16.   ‘¬®«â®«ªã: ¢­ãâਠ®¯à¥¤¥«¥­¨ï á«®¢  ¨á¯®«ì§ã¥âáï
  17.   ª®­áâàãªæ¨ï
  18.   | ᯨ᮪ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ç¥à¥§ ¯à®¡¥« |
  19.  
  20.   â® § áâ ¢«ï¥â ‘-”®àâ  ¢â®¬ â¨ç¥áª¨ ¢ë¤¥«ïâì ¬¥áâ® ¢
  21.   á⥪¥ ¢®§¢à â®¢ ¤«ï íâ¨å ¯¥à¥¬¥­­ëå ¢ ¬®¬¥­â ¢ë§®¢  á«®¢ 
  22.   ¨  ¢â®¬ â¨ç¥áª¨ ®á¢®¡®¦¤ âì ¬¥áâ® ¯à¨ ¢ë室¥ ¨§ ­¥£®.
  23.  
  24.   Ž¡à é¥­¨¥ ª â ª¨¬ «®ª «ì­ë¬ ¯¥à¥¬¥­­ë¬ - ª ª ª ®¡ëç­ë¬
  25.   ¯¥à¥¬¥­­ë¬ ¯® ¨¬¥­¨ ¨ á«¥¤ãî騬¨ @ ¨ !
  26.   ˆ¬¥­  «®ª «ì­ëå ¯¥à¥¬¥­­ëå áãé¥áâ¢ãîâ ¢ ¤¨­ ¬¨ç¥áª®¬
  27.   á«®¢ à¥ TEMP-NAMES ⮫쪮 ¢ ¬®¬¥­â ª®¬¯¨«ï樨 á«®¢ ,  
  28.   ¯®á«¥ í⮣® ¢ëç¨é îâáï ¨ ¡®«¥¥ ­¥¤®áâ㯭ë.
  29. )
  30. \ ˆ­¨æ¨ «¨§ æ¨ï ¢à¥¬¥­­ëå ¯¥à¥¬¥­­ëå §­ ç¥­¨ï¬¨, «¥¦ é¨¬¨ ­ 
  31. \ á⥪¥ (­ ¯à¨¬¥à, ¢å®¤­ë¬¨ ¯ à ¬¥âà ¬¨), ¢®§¬®¦­  "ᯨ᪮¬"
  32. \ á ¯®¬®éìî ª®­áâàãªæ¨¨
  33. \ (( ¨¬¥­  ¨­¨æ¨ «¨§¨à㥬ëå «®ª «ì­ëå ¯¥à¥¬¥­­ëå ))
  34. \ ˆ¬¥­  ¤®«¦­ë ¡ëâì à ­¥¥ ®¡ê¥­ë ¢ á«®¢¥ á ¯®¬®éìî | ... |
  35.  
  36. ( ˆá¯®«ì§®¢ ­¨¥ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ¢­ãâਠ横«®¢ DO LOOP
  37.   ­¥¢®§¬®¦­® ¯® ¯à¨ç¨­¥, ®¯¨á ­­®© ¢ áâ ­¤ à⥠94.
  38.  
  39.   à¨ ¦¥« ­¨¨ ¨á¯®«ì§®¢ âì «®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ ¢ á⨫¥ VALUE-¯¥à¥¬¥­­ëå
  40.   ¬®¦­® ¨á¯®«ì§®¢ âì ª®­áâàãªæ¨î
  41.   || ᯨ᮪ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ç¥à¥§ ¯à®¡¥« ||
  42.   ˆ¬¥­  íâ¨å ¯¥à¥¬¥­­ëå ¡ã¤ãâ ¤ ¢ âì ­¥  ¤à¥á,   ᢮¥ §­ ç¥­¨¥.
  43.   ‘®®â¢¥âá⢥­­® ¯à¨á¢®¥­¨¥ §­ ç¥­¨© ¡ã¤¥â ®áãé¥á⢫ïâìáï ª®­áâàãªæ¨¥©
  44.   -> ¨¬ï
  45.   ¯®  ­ «®£¨¨ á ¯à¨á¢®¥­¨¥¬ §­ ç¥­¨© VALUE-¯¥à¥¬¥­­ë¬ á«®¢®¬ TO.
  46. )
  47.  
  48. VARIABLE TEMP-CNT
  49. WORDLIST CONSTANT TEMP-NAMES
  50.  
  51. : INIT-TEMP-NAMES
  52.   ALSO TEMP-NAMES CONTEXT !
  53.   TEMP-CNT 0!
  54. ;
  55. : DEL-NAMES ( A -- )
  56.   DUP>R
  57.   @
  58.   BEGIN
  59.     DUP 0<>
  60.   WHILE
  61.     DUP CDR SWAP 5 - FREE THROW
  62.   REPEAT DROP
  63.   R> 0!
  64. ;
  65. : DEL-TEMP-NAMES
  66.   TEMP-NAMES DEL-NAMES
  67. ;
  68. HEX
  69. : COMPIL, ( A -- )
  70.   0E8 DOES>A @ C! DOES>A 1+!              \ ¬ è¨­­ ï ª®¬ ­¤  CALL
  71.   DOES>A @ CELL+ - DOES>A @ !
  72.   DOES>A @ 1- DOES>A !
  73. ;
  74. DECIMAL
  75. C" LAST-HERE" FIND NIP
  76. [IF]
  77.   : TEMP-DOES ( N -- ) ( -- ADDR )
  78.     ['] DUP MACRO,
  79.    0x8D C, 0x44 C, 0x24 C, C,  \ LEA     EAX , X [ESP]
  80.    HERE TO LAST-HERE  \ à §à¥è¥­® ®¯â¨¬¨§¨à®¢ âì
  81.    ;
  82. [ELSE]
  83.  : TEMP-DOES ( N -- ) ( -- ADDR )
  84.     POSTPONE RP@ LIT, POSTPONE +  ;
  85. [THEN]
  86.  
  87. : |TEMP-DOES ( N -- ) ( -- VALUE )
  88.  TEMP-DOES ['] @ COMPILE,
  89. ;
  90. : |TEMP-DOES! ( N --  ) ( X -- )
  91.   TEMP-DOES ['] ! COMPILE,
  92. ;
  93.  
  94. VARIABLE  add_depth   add_depth 0!  
  95.  
  96. \ £«ã¡¨­  ¢ á⥪¥ ¢®§¢à â®¢ ¤® ­ ç «  ¯¥à¥¬¥­­ëå
  97.  
  98. : !TEMP-CREATE ( addr u -- )
  99.  DUP 20 + ALLOCATE THROW >R
  100.  R@ CELL+ CHAR+ 2DUP C!
  101.  CHAR+ SWAP MOVE ( name )
  102.  TEMP-NAMES @
  103.  R@ CELL+ CHAR+ TEMP-NAMES ! ( latest )
  104.  R@ CELL+ CHAR+ COUNT + DUP>R ! ( link )
  105.  R> CELL+ DUP DOES>A ! R@ ! ( cfa )
  106.  &IMMEDIATE R> CELL+ C! ( flags )
  107.  ['] _CREATE-CODE COMPIL,
  108.   TEMP-CNT @ DOES>A @ 5 + !
  109.   TEMP-CNT 1+!
  110.   POSTPONE >R   DOES> @  2 +  CELLS  add_depth @ +  |TEMP-DOES ;
  111.  
  112. : TEMP-CREATE ( addr u -- )
  113.  !TEMP-CREATE   DOES> @  2 +  CELLS  add_depth @ +   TEMP-DOES ;
  114.  
  115. : ->            ' 5 + @  2 +  CELLS  add_depth @ +  |TEMP-DOES!
  116. ; IMMEDIATE
  117.  
  118. : |DROP    R> RP@ + RP! ;
  119.  
  120. ' |DROP VALUE '|DROP
  121.  
  122. : !!!!;  ( N N1 -- )
  123.  DROP  TEMP-CNT @ CELLS LIT,    POSTPONE >R
  124.  DROP            '|DROP LIT,    POSTPONE >R ;
  125.  
  126. : !!
  127.   BEGIN  NextWord 2DUP S" !!" COMPARE 0<>
  128.   WHILE          !TEMP-CREATE
  129.   REPEAT  !!!!;  ; IMMEDIATE
  130.  
  131. : ||
  132.   BEGIN  NextWord 2DUP S" ||" COMPARE 0<>
  133.   WHILE  0 LIT,  !TEMP-CREATE
  134.   REPEAT !!!!;   ; IMMEDIATE
  135.  
  136. : |
  137.   BEGIN  NextWord 2DUP S" |"  COMPARE 0<>
  138.   WHILE  0 LIT,   TEMP-CREATE
  139.   REPEAT !!!!;   ; IMMEDIATE
  140.  
  141. : >|
  142.   BEGIN  NextWord 2DUP S" |"  COMPARE 0<>
  143.   WHILE           TEMP-CREATE
  144.   REPEAT !!!!;   ; IMMEDIATE
  145.  
  146. : ((
  147.   0
  148.   BEGIN
  149.     BL WORD DUP COUNT S" ))" COMPARE 0<>
  150.   WHILE
  151.     FIND IF >R 1+ ELSE 5012 THROW THEN
  152.   REPEAT DROP
  153.   BEGIN
  154.     DUP 0<>
  155.   WHILE
  156. \    R> EXECUTE POSTPONE !     ( ¨á¯à ¢«¥­® ¤«ï ¯®¤¤¥à¦ª¨ || )
  157.     R> 5 + @    2 + CELLS add_depth @ +
  158.     |TEMP-DOES!
  159.     1-
  160.   REPEAT DROP
  161. ; IMMEDIATE
  162.  
  163.  
  164. \ ===
  165. \ ¯¥à¥®¯à¥¤¥«¥­¨¥ ᮮ⢥âáâ¢ãîé¨å á«®¢ ¤«ï ¢®§¬®¦­®á⨠¨á¯®«ì§®¢ âì
  166. \ ¢à¥¬¥­­ë¥ ¯¥à¥¬¥­­ë¥ ¢­ãâਠ æ¨ª«  DO LOOP  ¨ ­¥§ ¢¨á¨¬® ®â ¨§¬¥­¥­¨ï
  167. \ ᮤ¥à¦¨¬®£® á⥪  ¢®§¢à â®¢  á«®¢ ¬¨   >R   R>
  168.  
  169.  
  170. : DO     POSTPONE DO     [  3 CELLS ] LITERAL  add_depth +!
  171. ; IMMEDIATE
  172.  
  173. : LOOP   POSTPONE LOOP   [ -3 CELLS ] LITERAL  add_depth +!
  174. ; IMMEDIATE
  175.  
  176. : +LOOP  POSTPONE +LOOP  [ -3 CELLS ] LITERAL  add_depth +!
  177. ; IMMEDIATE
  178.  
  179. : >R     POSTPONE >R     [  1 CELLS ] LITERAL  add_depth +!
  180. ; IMMEDIATE
  181.  
  182. : R>     POSTPONE R>     [ -1 CELLS ] LITERAL  add_depth +!
  183. ; IMMEDIATE
  184.  
  185. \ ===
  186.  
  187.  
  188. : :: : ;
  189.  
  190. : : ( -- )
  191.   : INIT-TEMP-NAMES
  192. ;
  193. :: ; ( -- )
  194.   DEL-TEMP-NAMES PREVIOUS
  195.   POSTPONE ;
  196.   add_depth 0!      \ ­  ¢á直© á«ãç © ;)
  197. ; IMMEDIATE
  198.  
  199.