\ Temporary variables
( 24.09.1997 ¥à¥§®¢ . )
\ April 12th, 2000 - 14:44 Mihail Maksimov
\ ¤®¡ ¢¨« ª®áâàãªæ¨¨ !! ... !! ¨ >| ... | , «¨ª¢¨¤¨à®¢ « |DOES
\ ®¯â¨¬¨§¨à®¢ ë© ¢ ਠâ. ¯¥à¥¬¥ë¥ ¬®¦® ¨á¯®«ì§®¢ âì ¨ ¢ãâਠDO LOOP
( 10.06.1999 Ruvim Pinka, idea - Mihail Maksimov )
( à®á⮥ à áè¨à¥¨¥ -®àâ «®ª «ì묨 ¯¥à¥¬¥ë¬¨.
¥ «¨§®¢ ® ¡¥§ ¨á¯®«ì§®¢ ¨ï LOCALS áâ ¤ àâ 94.
¡ê¥¨¥ ¢à¥¬¥ëå ¯¥à¥¬¥ëå, ¢¨¤¨¬ëå ⮫쪮 ¢ãâà¨
⥪ã饣® á«®¢ ¨ ®£à ¨ç¥ëå ¢à¥¬¥¥¬ ¢ë§®¢ ¤ ®£®
á«®¢ ¢ë¯®«ï¥âáï á ¯®¬®éìî á«®¢ "|" «®£¨ç®
¬®«â®«ªã: ¢ãâਠ®¯à¥¤¥«¥¨ï á«®¢ ¨á¯®«ì§ã¥âáï
ª®áâàãªæ¨ï
| ᯨ᮪ «®ª «ìëå ¯¥à¥¬¥ëå ç¥à¥§ ¯à®¡¥« |
â® § áâ ¢«ï¥â -®à⠢⮬ â¨ç¥áª¨ ¢ë¤¥«ïâì ¬¥áâ® ¢
á⥪¥ ¢®§¢à ⮢ ¤«ï íâ¨å ¯¥à¥¬¥ëå ¢ ¬®¬¥â ¢ë§®¢ á«®¢
¨ ¢â®¬ â¨ç¥áª¨ ®á¢®¡®¦¤ âì ¬¥áâ® ¯à¨ ¢ë室¥ ¨§ ¥£®.
¡à 饨¥ ª â ª¨¬ «®ª «ìë¬ ¯¥à¥¬¥ë¬ - ª ª ª ®¡ëçë¬
¯¥à¥¬¥ë¬ ¯® ¨¬¥¨ ¨ á«¥¤ãî騬¨ @ ¨ !
¬¥ «®ª «ìëå ¯¥à¥¬¥ëå áãé¥áâ¢ãîâ ¢ ¤¨ ¬¨ç¥áª®¬
á«®¢ ॠTEMP-NAMES ⮫쪮 ¢ ¬®¬¥â ª®¬¯¨«ï樨 á«®¢ ,
¯®á«¥ í⮣® ¢ëç¨é îâáï ¨ ¡®«¥¥ ¥¤®áâã¯ë.
)
\ ¨æ¨ «¨§ æ¨ï ¢à¥¬¥ëå ¯¥à¥¬¥ëå § 票ﬨ, «¥¦ 騬¨
\ á⥪¥ ( ¯à¨¬¥à, ¢å®¤ë¬¨ ¯ à ¬¥âà ¬¨), ¢®§¬®¦ "ᯨ᪮¬"
\ á ¯®¬®éìî ª®áâàãªæ¨¨
\ (( ¨¬¥ ¨¨æ¨ «¨§¨à㥬ëå «®ª «ìëå ¯¥à¥¬¥ëå ))
\ ¬¥ ¤®«¦ë ¡ëâì à ¥¥ ®¡ê¥ë ¢ á«®¢¥ á ¯®¬®éìî | ... |
( ᯮ«ì§®¢ ¨¥ «®ª «ìëå ¯¥à¥¬¥ëå ¢ãâਠ横«®¢ DO LOOP
¥¢®§¬®¦® ¯® ¯à¨ç¨¥, ®¯¨á ®© ¢ áâ ¤ à⥠94.
ਠ¦¥« ¨¨ ¨á¯®«ì§®¢ âì «®ª «ìë¥ ¯¥à¥¬¥ë¥ ¢ á⨫¥ 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