kolibrios-fun/programs/develop/SPForth/devel/~mak/temps4.f

\ Temporary variables
( 24.09.1997 —¥à¥§®¢ €. )
\ April 12th, 2000 - 14:44 Mihail Maksimov
\ ¤®¡ ¢¨« ª®­áâàãªæ¨¨ !! ... !! ¨ >| ... | , «¨ª¢¨¤¨à®¢ « |DOES

\ ®¯â¨¬¨§¨à®¢ ­­ë© ¢ à¨ ­â. ¯¥à¥¬¥­­ë¥ ¬®¦­® ¨á¯®«ì§®¢ âì ¨ ¢­ãâਠDO LOOP
( 10.06.1999 Ruvim Pinka, idea - Mihail Maksimov )

( <EFBFBD>à®á⮥ à áè¨à¥­¨¥ ‘<EFBFBD>-”®àâ  «®ª «ì­ë¬¨ ¯¥à¥¬¥­­ë¬¨.
  <EFBFBD>¥ «¨§®¢ ­® ¡¥§ ¨á¯®«ì§®¢ ­¨ï LOCALS áâ ­¤ àâ  94.

  Ž¡ê¥­¨¥ ¢à¥¬¥­­ëå ¯¥à¥¬¥­­ëå, ¢¨¤¨¬ëå ⮫쪮 ¢­ãâà¨
  ⥪ã饣® á«®¢  ¨ ®£à ­¨ç¥­­ëå ¢à¥¬¥­¥¬ ¢ë§®¢  ¤ ­­®£®
  á«®¢  ¢ë¯®«­ï¥âáï á ¯®¬®éìî á«®¢  "|"  ­ «®£¨ç­®
  ‘¬®«â®«ªã: ¢­ãâਠ®¯à¥¤¥«¥­¨ï á«®¢  ¨á¯®«ì§ã¥âáï
  ª®­áâàãªæ¨ï
  | ᯨ᮪ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ç¥à¥§ ¯à®¡¥« |

  <EFBFBD>â® § áâ ¢«ï¥â ‘<EFBFBD>-”®àâ  ¢â®¬ â¨ç¥áª¨ ¢ë¤¥«ïâì ¬¥áâ® ¢
  á⥪¥ ¢®§¢à â®¢ ¤«ï íâ¨å ¯¥à¥¬¥­­ëå ¢ ¬®¬¥­â ¢ë§®¢  á«®¢ 
  ¨  ¢â®¬ â¨ç¥áª¨ ®á¢®¡®¦¤ âì ¬¥áâ® ¯à¨ ¢ë室¥ ¨§ ­¥£®.

  Ž¡à é¥­¨¥ ª â ª¨¬ «®ª «ì­ë¬ ¯¥à¥¬¥­­ë¬ - ª ª ª ®¡ëç­ë¬
  ¯¥à¥¬¥­­ë¬ ¯® ¨¬¥­¨ ¨ á«¥¤ãî騬¨ @ ¨ !
  ˆ¬¥­  «®ª «ì­ëå ¯¥à¥¬¥­­ëå áãé¥áâ¢ãîâ ¢ ¤¨­ ¬¨ç¥áª®¬
  á«®¢ à¥ TEMP-NAMES ⮫쪮 ¢ ¬®¬¥­â ª®¬¯¨«ï樨 á«®¢ ,  
  ¯®á«¥ í⮣® ¢ëç¨é îâáï ¨ ¡®«¥¥ ­¥¤®áâ㯭ë.
)
\ ˆ­¨æ¨ «¨§ æ¨ï ¢à¥¬¥­­ëå ¯¥à¥¬¥­­ëå §­ ç¥­¨ï¬¨, «¥¦ é¨¬¨ ­ 
\ á⥪¥ (­ ¯à¨¬¥à, ¢å®¤­ë¬¨ ¯ à ¬¥âà ¬¨), ¢®§¬®¦­  "ᯨ᪮¬"
\ á ¯®¬®éìî ª®­áâàãªæ¨¨
\ (( ¨¬¥­  ¨­¨æ¨ «¨§¨à㥬ëå «®ª «ì­ëå ¯¥à¥¬¥­­ëå ))
\ ˆ¬¥­  ¤®«¦­ë ¡ëâì à ­¥¥ ®¡ê¥­ë ¢ á«®¢¥ á ¯®¬®éìî | ... |

( ˆá¯®«ì§®¢ ­¨¥ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ¢­ãâਠ横«®¢ DO LOOP
  ­¥¢®§¬®¦­® ¯® ¯à¨ç¨­¥, ®¯¨á ­­®© ¢ áâ ­¤ à⥠94.

  <EFBFBD>ਠ¦¥« ­¨¨ ¨á¯®«ì§®¢ âì «®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ ¢ á⨫¥ VALUE-¯¥à¥¬¥­­ëå
  ¬®¦­® ¨á¯®«ì§®¢ âì ª®­áâàãªæ¨î
  || ᯨ᮪ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ç¥à¥§ ¯à®¡¥« ||
  ˆ¬¥­  íâ¨å ¯¥à¥¬¥­­ëå ¡ã¤ãâ ¤ ¢ âì ­¥  ¤à¥á,   ᢮¥ §­ ç¥­¨¥.
  ‘®®â¢¥âá⢥­­® ¯à¨á¢®¥­¨¥ §­ ç¥­¨© ¡ã¤¥â ®áãé¥á⢫ïâìáï ª®­áâàãªæ¨¥©
  -> ¨¬ï
  ¯®  ­ «®£¨¨ á ¯à¨á¢®¥­¨¥¬ §­ ç¥­¨© VALUE-¯¥à¥¬¥­­ë¬ á«®¢®¬ TO.
)

VARIABLE TEMP-CNT
WORDLIST CONSTANT TEMP-NAMES

: INIT-TEMP-NAMES
  ALSO TEMP-NAMES CONTEXT !
  TEMP-CNT 0!
;
: DEL-NAMES ( A -- )
  DUP>R
  @
  BEGIN
    DUP 0<>
  WHILE
    DUP CDR SWAP 5 - FREE THROW
  REPEAT DROP
  R> 0!
;
: DEL-TEMP-NAMES
  TEMP-NAMES DEL-NAMES
;
HEX
: COMPIL, ( A -- )
  0E8 DOES>A @ C! DOES>A 1+!              \ ¬ è¨­­ ï ª®¬ ­¤  CALL
  DOES>A @ CELL+ - DOES>A @ !
  DOES>A @ 1- DOES>A !
;
DECIMAL
C" LAST-HERE" FIND NIP
[IF] 
  : TEMP-DOES ( N -- ) ( -- ADDR )
    ['] DUP MACRO,
    0x8D C, 0x44 C, 0x24 C, C,  \  LEA     EAX , X [ESP]
    HERE TO LAST-HERE  \  à §à¥è¥­® ®¯â¨¬¨§¨à®¢ âì
    ;
[ELSE]
  : TEMP-DOES ( N -- ) ( -- ADDR )
     POSTPONE RP@ LIT, POSTPONE +  ;
[THEN]

: |TEMP-DOES ( N -- ) ( -- VALUE )
  TEMP-DOES ['] @ COMPILE,
;
: |TEMP-DOES! ( N --  ) ( X -- )
  TEMP-DOES ['] ! COMPILE,
;

VARIABLE  add_depth   add_depth 0!   

\ £«ã¡¨­  ¢ á⥪¥ ¢®§¢à â®¢ ¤® ­ ç «  ¯¥à¥¬¥­­ëå

: !TEMP-CREATE ( addr u -- )
  DUP 20 + ALLOCATE THROW >R
  R@ CELL+ CHAR+ 2DUP C!
  CHAR+ SWAP MOVE ( name )
  TEMP-NAMES @
  R@ CELL+ CHAR+ TEMP-NAMES ! ( latest )
  R@ CELL+ CHAR+ COUNT + DUP>R ! ( link )
  R> CELL+ DUP DOES>A ! R@ ! ( cfa )
  &IMMEDIATE R> CELL+ C! ( flags )
  ['] _CREATE-CODE COMPIL,
  TEMP-CNT @ DOES>A @ 5 + !
  TEMP-CNT 1+!
  POSTPONE >R   DOES> @  2 +  CELLS  add_depth @ +  |TEMP-DOES ;

: TEMP-CREATE ( addr u -- )
 !TEMP-CREATE   DOES> @  2 +  CELLS  add_depth @ +   TEMP-DOES ;

: ->            ' 5 + @  2 +  CELLS  add_depth @ +  |TEMP-DOES!
; IMMEDIATE

: |DROP    R> RP@ + RP! ;

' |DROP VALUE '|DROP

: !!!!;  ( N N1 -- )
  DROP  TEMP-CNT @ CELLS LIT,    POSTPONE >R
  DROP            '|DROP LIT,    POSTPONE >R ;

: !!
  BEGIN  NextWord 2DUP S" !!" COMPARE 0<>
  WHILE          !TEMP-CREATE
  REPEAT  !!!!;  ; IMMEDIATE

: ||
  BEGIN  NextWord 2DUP S" ||" COMPARE 0<>
  WHILE  0 LIT,  !TEMP-CREATE
  REPEAT !!!!;   ; IMMEDIATE

: |
  BEGIN  NextWord 2DUP S" |"  COMPARE 0<>
  WHILE  0 LIT,   TEMP-CREATE
  REPEAT !!!!;   ; IMMEDIATE

: >|
  BEGIN  NextWord 2DUP S" |"  COMPARE 0<>
  WHILE           TEMP-CREATE
  REPEAT !!!!;   ; IMMEDIATE

: ((
  0
  BEGIN
    BL WORD DUP COUNT S" ))" COMPARE 0<>
  WHILE
    FIND IF >R 1+ ELSE 5012 THROW THEN
  REPEAT DROP
  BEGIN
    DUP 0<>
  WHILE
\    R> EXECUTE POSTPONE !     ( ¨á¯à ¢«¥­® ¤«ï ¯®¤¤¥à¦ª¨ || )
    R> 5 + @    2 + CELLS add_depth @ + 
    |TEMP-DOES!
    1-
  REPEAT DROP
; IMMEDIATE


\ ===
\ ¯¥à¥®¯à¥¤¥«¥­¨¥ ᮮ⢥âáâ¢ãîé¨å á«®¢ ¤«ï ¢®§¬®¦­®á⨠¨á¯®«ì§®¢ âì
\ ¢à¥¬¥­­ë¥ ¯¥à¥¬¥­­ë¥ ¢­ãâਠ 横«  DO LOOP  ¨ ­¥§ ¢¨á¨¬® ®â ¨§¬¥­¥­¨ï
\ ᮤ¥à¦¨¬®£® á⥪  ¢®§¢à â®¢  á«®¢ ¬¨   >R   R>


: DO     POSTPONE DO     [  3 CELLS ] LITERAL  add_depth +!
; IMMEDIATE

: LOOP   POSTPONE LOOP   [ -3 CELLS ] LITERAL  add_depth +!
; IMMEDIATE

: +LOOP  POSTPONE +LOOP  [ -3 CELLS ] LITERAL  add_depth +!
; IMMEDIATE

: >R     POSTPONE >R     [  1 CELLS ] LITERAL  add_depth +!
; IMMEDIATE

: R>     POSTPONE R>     [ -1 CELLS ] LITERAL  add_depth +!
; IMMEDIATE

\ ===


: :: : ;

: : ( -- )
  : INIT-TEMP-NAMES
;
:: ; ( -- )
  DEL-TEMP-NAMES PREVIOUS
  POSTPONE ;
  add_depth 0!      \ ­  ¢á直© á«ãç © ;)
; IMMEDIATE