( 28.Mar.2000 Andrey Cherezov Copyright [C] RU FIG
ᯮ«ì§®¢ ë ¨¤¥¨ á«¥¤ãîé¨å ¢â®à®¢:
Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
Konstantin Tarasov; Michail Maximov.
!! ¡®â ¥â ⮫쪮 ¢ SPF4.
)
( à®á⮥ à áè¨à¥¨¥ -®àâ «®ª «ì묨 ¯¥à¥¬¥ë¬¨.
¥ «¨§®¢ ® ¡¥§ ¨á¯®«ì§®¢ ¨ï LOCALS áâ ¤ àâ 94.
¡ê¥¨¥ ¢à¥¬¥ëå ¯¥à¥¬¥ëå, ¢¨¤¨¬ëå ⮫쪮 ¢ãâà¨
⥪ã饣® á«®¢ ¨ ®£à ¨ç¥ëå ¢à¥¬¥¥¬ ¢ë§®¢ ¤ ®£®
á«®¢ ¢ë¯®«ï¥âáï á ¯®¬®éìî á«®¢ "{". ãâਠ®¯à¥¤¥«¥¨ï
á«®¢ ¨á¯®«ì§ã¥âáï ª®áâàãªæ¨ï, ¯®¤®¡ ï á⥪®¢®© ®â 樨 ®àâ
{ ᯨ᮪_¨¨æ¨ «¨§¨à®¢ ëå_«®ª «®¢ \ á¯.¥¨¨æ.«®ª «®¢ -- ç⮠㣮¤® }
¯à¨¬¥à:
{ a b c d \ e f -- i j }
«¨ { a b c d \ e f[ EVALUATE_¢ëà ¦¥¨¥ ] -- i j }
â® § ç¨â çâ® ¤«ï ¯¥à¥¬¥®© f[ ¡ã¤¥â ¢ë¤¥«¥ á⥪¥ ¢®§¢à ⮢ ãç á⮪
¯ ¬ï⨠¤«¨®© n ¡ ©â. ᯮ«ì§®¢ ¨¥ ¯¥à¥¬¥®© f[ ¤ áâ ¤à¥á ç « í⮣®
ãç á⪠. \ á⨫¥ MPE\
Ǭ { a b c d \ e [ 12 ] f -- i j }
â® § ç¨â çâ® ¤«ï ¯¥à¥¬¥®© f ¡ã¤¥â ¢ë¤¥«¥ á⥪¥ ¢®§¢à ⮢ ãç á⮪
¯ ¬ï⨠¤«¨®© 12 ¡ ©â. ᯮ«ì§®¢ ¨¥ ¯¥à¥¬¥®© f ¤ áâ ¤à¥á ç « í⮣®
ãç á⪠.
áâì "\ á¯.¥¨¨æ.«®ª «®¢" ¬®¦¥â ®âáãâá⢮¢ âì, ¯à¨¬¥à:
{ item1 item2 -- }
â® § áâ ¢«ï¥â -®à⠢⮬ â¨ç¥áª¨ ¢ë¤¥«ïâì ¬¥áâ® ¢
á⥪¥ ¢®§¢à ⮢ ¤«ï íâ¨å ¯¥à¥¬¥ëå ¢ ¬®¬¥â ¢ë§®¢ á«®¢
¨ ¢â®¬ â¨ç¥áª¨ ®á¢®¡®¦¤ âì ¬¥áâ® ¯à¨ ¢ë室¥ ¨§ ¥£®.
¡à 饨¥ ª â ª¨¬ «®ª «ìë¬ ¯¥à¥¬¥ë¬ - ª ª ª VALUE-¯¥à¥¬¥ë¬
¯® ¨¬¥¨.
᫨ 㦥 ¤à¥á ¯¥à¥¬¥®©, â® ¨á¯®«ì§ã¥âáï "^ ¨¬ï"
¨«¨ "AT ¨¬ï".
¬¥áâ® \ ¬®¦® ¨á¯®«ì§®¢ âì |
¬¥áâ® -> ¬®¦® ¨á¯®«ì§®¢ âì TO
ਬ¥àë:
: TEST { a b c d \ e f -- } a . b . c . b c + -> e e . f . ^ a @ . ;
Ok
1 2 3 4 TEST
1 2 3 5 0 1 Ok
: TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
Ok
12 34 TEST
12 34
0 12 34
1 12 34
2 12 34
3 12 34
4 12 34
Ok
: TEST { a b } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { a b -- } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c -- d } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { \ a b } a . b . 1 -> a 2 -> b a . b . ;
Ok
TEST
0 0 1 2 Ok
¬¥ «®ª «ìëå ¯¥à¥¬¥ëå áãé¥áâ¢ãîâ ¢ ¤¨ ¬¨ç¥áª®¬
¢à¥¬¥®¬ á«®¢ ॠ⮫쪮 ¢ ¬®¬¥â ª®¬¯¨«ï樨 á«®¢ ,
¯®á«¥ í⮣® ¢ëç¨é îâáï ¨ ¡®«¥¥ ¥¤®áâã¯ë.
ᯮ«ì§®¢ âì ª®áâàãªæ¨î "{ ... }" ¢ãâਠ®¤®£® ®¯à¥¤¥«¥¨ï ¬®¦®
⮫쪮 ®¤¨ à §.
®¬¯¨«ïæ¨ï í⮩ ¡¨¡«¨®â¥ª¨ ¤®¡ ¢«ï¥â ¢ ⥪ã騩 á«®¢ àì ª®¬¯¨«ï樨
®«ìª® ¤¢ á«®¢ :
á«®¢ àì "vocLocalsSupport" ¨ "{"
ᥠ®áâ «ìë¥ ¤¥â «¨ "á¯àïâ ë" ¢ á«®¢ à¥, ¨á¯®«ì§®¢ âì ¨å
¥ ४®¬¥¤ã¥âáï.
)
REQUIRE [IF] ~MAK\CompIF.f
C" 'DROP_V" FIND NIP 0=
[IF] ' DROP VALUE 'DROP_V
: 'DROP 'DROP_V ;
[THEN]
C" 'DUP_V" FIND NIP 0=
[IF] ' DUP VALUE 'DUP_V
: 'DUP 'DUP_V ;
[THEN]
C" 'DROP" FIND NIP 0=
[IF] ' DROP VALUE 'DROP
[THEN]
C" 'DUP" FIND NIP 0=
[IF] ' DUP VALUE 'DUP
[THEN]
\ C" '(LocalsExit)_V" FIND NIP 0=
\ [IF] ' (LocalsExit)_V VALUE '(LocalsExit)_V
\ [THEN]
MODULE: vocLocalsSupport_M
VARIABLE uLocalsCnt
VARIABLE uLocalsUCnt
VARIABLE uPrevCurrent
VARIABLE uAddDepth
: LocalOffs ( n -- offs )
2+ CELLS uAddDepth @ +
;
BASE @ HEX
' RP@ 7 + @ 0xC3042444 =
[IF]
: R_ALLOT,
DUP SHORT?
OPT_INIT SetOP
IF 8D C, 64 C, 24 C, C, \ mov esp, offset [esp]
ELSE 8D C, A4 C, 24 C, , \ mov esp, offset [esp]
THEN
OPT_CLOSE
;
C" MACRO," FIND NIP 0=
[IF] : MACRO, INLINE, ;
[THEN]
: CompileLocalRec ( u -- )
LocalOffs DUP
'DUP MACRO,
SHORT?
OPT_INIT SetOP
IF 8D C, 44 C, 24 C, C, \ lea eax, offset [esp]
ELSE 8D C, 84 C, 24 C, , \ lea eax, offset [esp]
THEN OPT
OPT_CLOSE
;
: CompileLocal@ ( n -- )
'DUP MACRO,
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 8B C, 44 C, 24 C, C, \ mov eax, offset [esp]
ELSE 8B C, 84 C, 24 C, , \ mov eax, offset [esp]
THEN OPT
OPT_CLOSE
;
: CompileLocal! ( n -- )
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 89 C, 44 C, 24 C, C, \ mov offset [esp], eax
ELSE 89 C, 84 C, 24 C, , \ mov offset [esp], eax
THEN OPT
OPT_CLOSE
'DROP MACRO,
;
\ : CompileLocal@ ( n -- )
\ LocalOffs LIT, POSTPONE RP+@
\ ;
[ELSE]
: R_ALLOT,
] POSTPONE LITERAL S" RP@ + RP! " EVALUATE
POSTPONE [ ;
: CompileLocalRec ( u -- )
LocalOffs
POSTPONE LITERAL
\ S" RP@ + " EVALUATE
;
: CompileLocal@ ( n -- )
CompileLocalRec
S" @ " EVALUATE
;
: CompileLocal! ( n -- )
CompileLocalRec
S" ! " EVALUATE
;
[THEN]
VARIABLE TEMP-DP
: CompileLocalsInit
TEMP-DP @ DP !
uPrevCurrent @ SET-CURRENT
uLocalsUCnt @ ?DUP
IF NEGATE CELLS R_ALLOT,
THEN
uLocalsCnt @ uLocalsUCnt @ - ?DUP
IF DUP CELLS NEGATE uAddDepth +! 0 DO S" >R " EVALUATE LOOP THEN
uLocalsCnt @ ?DUP
IF CELLS POSTPONE LITERAL S" >R ['] (LocalsExit) >R" EVALUATE
-2 CELLS uAddDepth +!
THEN
;
\ : CompileLocal@ ( n -- )
\ LocalOffs LIT, POSTPONE RP+@
\ ;
BASE !
WORDLIST CONSTANT widLocals@
CREATE TEMP-BUF 1000 ALLOT
: LocalsStartup
GET-CURRENT uPrevCurrent !
ALSO vocLocalsSupport_M
ALSO widLocals@ CONTEXT ! DEFINITIONS
HERE TEMP-DP !
TEMP-BUF DP !
widLocals@ 0!
uLocalsCnt 0!
uLocalsUCnt 0!
uAddDepth 0!
;
: LocalsCleanup
PREVIOUS PREVIOUS
;
: ProcessLocRec ( "name" -- u )
[CHAR] ] PARSE
STATE 0!
EVALUATE CELL 1- + CELL / \ ¤¥« ¥¬ ªà âë¬ 4
-1 STATE !
\ DUP uLocalsCnt +!
uLocalsCnt @
;
: CreateLocArray
[CHAR] [ PSKIP
ProcessLocRec
CREATE ,
DUP uLocalsCnt +!
;
: LocalsRecDoes@ ( -- u )
DOES> @ CompileLocalRec
;
: LocalsRecDoes@2 ( -- u )
ProcessLocRec ,
DUP uLocalsCnt +!
DOES> @ CompileLocalRec
;
: LocalsDoes@
uLocalsCnt @ ,
uLocalsCnt 1+!
DOES> @ CompileLocal@
;
: ;; POSTPONE ; ; IMMEDIATE
: ^
' >BODY @
CompileLocalRec
; IMMEDIATE
: -> ' >BODY @ CompileLocal! ; IMMEDIATE
WARNING DUP @ SWAP 0!
: AT
[COMPILE] ^
; IMMEDIATE
: TO ( "name" -- )
>IN @ NextWord widLocals@ SEARCH-WORDLIST 1 =
IF >BODY @ CompileLocal! DROP
ELSE >IN ! [COMPILE] TO
THEN
; IMMEDIATE
WARNING !
: ¢ POSTPONE -> ; IMMEDIATE
WARNING @ WARNING 0!
\ ===
\ ¯¥à¥®¯à¥¤¥«¥¨¥ ᮮ⢥âáâ¢ãîé¨å á«®¢ ¤«ï ¢®§¬®¦®á⨠¨á¯®«ì§®¢ âì
\ ¢à¥¬¥ë¥ ¯¥à¥¬¥ë¥ ¢ãâਠ横« DO LOOP ¨ ¥§ ¢¨á¨¬® ®â ¨§¬¥¥¨ï
\ ᮤ¥à¦¨¬®£® á⥪ ¢®§¢à ⮢ á«®¢ ¬¨ >R R>
C" DO_SIZE" FIND NIP 0=
[IF] 3 CELLS CONSTANT DO_SIZE
[THEN]
: DO POSTPONE DO DO_SIZE uAddDepth +! ; IMMEDIATE
: ?DO POSTPONE ?DO DO_SIZE uAddDepth +! ; IMMEDIATE
: LOOP POSTPONE LOOP DO_SIZE NEGATE uAddDepth +! ; IMMEDIATE
: +LOOP POSTPONE +LOOP DO_SIZE NEGATE uAddDepth +! ; IMMEDIATE
: >R POSTPONE >R [ 1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: R> POSTPONE R> [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: RDROP POSTPONE RDROP [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2>R POSTPONE 2>R [ 2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2R> POSTPONE 2R> [ -2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
\ ===
\ uLocalsCnt @ ?DUP
\ IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
: ; LocalsCleanup
S" ;" EVAL-WORD
; IMMEDIATE
WARNING !
\ =====================================================================
EXPORT
: {
LocalsStartup
BEGIN
BL PSKIP PeekChar DUP [CHAR] \ <>
OVER [CHAR] - <> AND
OVER [CHAR] } <> AND
OVER [CHAR] | <> AND
SWAP [CHAR] ) XOR AND
WHILE
CREATE LocalsDoes@ IMMEDIATE
REPEAT
PeekChar >IN 1+! DUP [CHAR] } <>
IF
DUP [CHAR] \ =
SWAP [CHAR] | = OR
IF
BEGIN
BL PSKIP PeekChar DUP
DUP [CHAR] - <>
SWAP [CHAR] } <> AND
SWAP [CHAR] ) XOR AND
WHILE
PeekChar [CHAR] [ =
IF CreateLocArray LocalsRecDoes@
ELSE
CREATE LATEST DUP C@ + C@
[CHAR] [ =
IF
LocalsRecDoes@2
ELSE
LocalsDoes@ 1
THEN
THEN DUP U.
uLocalsUCnt +!
IMMEDIATE
REPEAT
THEN
[CHAR] } PARSE 2DROP
ELSE DROP THEN
CompileLocalsInit
;; IMMEDIATE
;MODULE