( ¯à¥¤¥«ïî騥 á«®¢ , ᮧ¤ î騥 á«®¢ àë¥ áâ âì¨ ¢ á«®¢ à¥.
-¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥¨ï.
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
८¡à §®¢ ¨¥ ¨§ 16-à §à冷£® ¢ 32-à §àï¤ë© ª®¤ - 1995-96££
¥¢¨§¨ï - á¥âï¡àì 1999
)
USER LAST-CFA
USER-VALUE LAST-NON
: REVEAL ( --- )
\ Add the last created definition to the CURRENT wordlist.
LAST @ CURRENT @ ! ;
: SHEADER ( addr u -- )
_SHEADER REVEAL
;
: _SHEADER ( addr u -- )
0 C, ( flags )
HERE 0 , ( cfa )
DUP LAST-CFA !
-ROT WARNING @
IF 2DUP GET-CURRENT SEARCH-WORDLIST
IF DROP 2DUP TYPE ." isn't unique" CR THEN
THEN
CURRENT @ SWORD,
ALIGN
HERE SWAP ! ( § ¯®«¨«¨ cfa )
;
: HEADER ( "name" -- ) PARSE-WORD SHEADER ;
: CREATED ( addr u -- )
\ ®§¤ âì ®¯à¥¤¥«¥¨¥ ¤«ï c-addr u á ᥬ ⨪®© ¢ë¯®«¥¨ï, ®¯¨á ®© ¨¦¥.
\
᫨ 㪠§ â¥«ì ¯à®áâà á⢠¤ ëå ¥ ¢ë஢¥, § १¥à¢¨à®¢ âì ¬¥áâ®
\ ¤«ï ¢ëà ¢¨¢ ¨ï. ®¢ë© 㪠§ â¥«ì ¯à®áâà á⢠¤ ëå ®¯à¥¤¥«ï¥â
\ ¯®«¥ ¤ ëå name. CREATE ¥ १¥à¢¨àã¥â ¬¥áâ® ¢ ¯®«¥ ¤ ëå name.
\ name 믮«¥¨¥: ( -- a-addr )
\ a-addr - ¤à¥á ¯®«ï ¤ ëå name. ¥¬ ⨪ ¢ë¯®«¥¨ï name ¬®¦¥â
\ ¡ëâì à áè¨à¥ á ¯®¬®éìî DOES>.
SHEADER
HERE DOES>A ! ( ¤«ï DOES )
CREATE-CODE COMPILE,
;
: CREATE ( "<spaces>name" -- ) \ 94
PARSE-WORD CREATED
;
: (DOES1) \ â ç áâì, ª®â®à ï à ¡®â ¥â ®¤®¢à¥¬¥® á CREATE (®¡ëç®)
R> DOES>A @ CFL + -
DOES>A @ 1+ ! ;
Code (DOES2)
SUB EBP, 4
MOV [EBP], EAX
POP EBX
POP EAX
PUSH EBX
RET
EndCODE
: DOES> \ 94
\ â¥à¯à¥â æ¨ï: ᥬ ⨪ ¥®¯à¥¤¥«¥ .
\ ®¬¯¨«ïæ¨ï: ( C: clon-sys1 -- colon-sys2 )
\ ®¡ ¢¨âì ᥬ ⨪㠢६¥¨ ¢ë¯®«¥¨ï, ¤ ãî ¨¦¥, ª ⥪ã饬ã
\ ®¯à¥¤¥«¥¨î. 㤥⠨«¨ ¥â ⥪ã饥 ®¯à¥¤¥«¥¨¥ ᤥ« ® ¢¨¤¨¬®
\ ¤«ï ¯®¨áª ¢ á«®¢ ॠ¯à¨ ª®¬¯¨«ï樨 DOES>, § ¢¨á¨â ®â ॠ«¨§ 樨.
\ ®£«®é ¥â colon-sys1 ¨ ¯à®¨§¢®¤¨â colon-sys2. ®¡ ¢«ï¥â ᥬ ⨪ã
\ ¨¨æ¨ «¨§ 樨, ¤ ãî ¨¦¥, ª ⥪ã饬㠮¯à¥¤¥«¥¨î.
\ à¥¬ï ¢ë¯®«¥¨ï: ( -- ) ( R: nest-sys1 -- )
\ ¬¥¨âì ᥬ ⨪㠢믮«¥¨ï ¯®á«¥¤¥£® ®¯à¥¤¥«¥¨ï name, ᥬ ⨪ã
\ ¢ë¯®«¥¨ï name, ¤ ãî ¨¦¥. ®§¢à â¨âì ã¯à ¢«¥¨¥ ¢ ¢ë§ë¢ î饥 ®¯à¥¤¥-
\ «¥¨¥, § ¤ ®¥ nest-sys1. ¥®¯à¥¤¥«¥ ï á¨âã æ¨ï ¢®§¨ª ¥â, ¥á«¨ name
\ ¥ ¡ë«® ®¯à¥¤¥«¥® ç¥à¥§ CREATE ¨«¨ ®¯à¥¤¥«¥®¥ ¯®«ì§®¢ ⥫¥¬ á«®¢®,
\ ¢ë§ë¢ î饥 CREATE.
\ ¨æ¨ «¨§ æ¨ï: ( i*x -- i*x a-addr ) ( R: -- nest-sys2 )
\ ®åà ¨âì § ¢¨áïéãî ®â ॠ«¨§ 樨 ¨ä®à¬ æ¨î nest-sys2 ® ¢ë§ë¢ î饬
\ ®¯à¥¤¥«¥¨¨. ®«®¦¨âì ¤à¥á ¯®«ï ¤ ëå name á⥪. «¥¬¥âë á⥪
\ i*x ¯à¥¤áâ ¢«ïîâ à£ã¬¥âë name.
\ name 믮«¥¨¥: ( i*x -- j*x )
\ 믮«¨âì ç áâì ®¯à¥¤¥«¥¨ï, ª®â®à ï ç¨ ¥âáï á ᥬ ⨪¨ ¨¨æ¨ «¨§ 樨,
\ ¤®¡ ¢«¥®© DOES>, ª®â®à®¥ ¬®¤¨ä¨æ¨à®¢ «® name. «¥¬¥âë á⥪ i*x ¨ j*x
\ ¯à¥¤áâ ¢«ïîâ à£ã¬¥âë ¨ १ã«ìâ âë á«®¢ name, ᮮ⢥âá⢥®.
['] (DOES1) COMPILE,
['] (DOES2) COMPILE, \ ['] C-R> MACRO,
; IMMEDIATE
: VOCABULARY ( "<spaces>name" -- )
\ ®§¤ âì ᯨ᮪ á«®¢ á ¨¬¥¥¬ name. 믮«¥¨¥ name § ¬¥¨â ¯¥à¢ë© ᯨ᮪
\ ¢ ¯®à浪¥ ¯®¨áª ᯨ᮪ á ¨¬¥¥¬ name.
WORDLIST DUP
CREATE
,
LATEST OVER CELL+ ! ( áá뫪 ¨¬ï á«®¢ àï )
GET-CURRENT SWAP PAR! ( á«®¢ àì-¯à¥¤®ª )
\ FORTH-WORDLIST SWAP CLASS! ( ª« áá )
VOC
( DOES> ¥ à ¡®â ¥â ¢ í⮬ )
(DOES1) (DOES2) \ â ª ᤥ« « ¡ë DOES>, ®¯à¥¤¥«¥ë© ¢ëè¥
@ CONTEXT !
;
: VARIABLE ( "<spaces>name" -- ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 ¯à®¡¥«ë. 뤥«¨âì name, ®£à ¨ç¥®¥ ¯à®¡¥«®¬.
\ ®§¤ âì ®¯à¥¤¥«¥¨¥ ¤«ï name á ᥬ ⨪®© ¢ë¯®«¥¨ï, ¤ ®© ¨¦¥.
\ १¥à¢¨à®¢ âì ®¤ã ï祩ªã ¯à®áâà á⢠¤ ëå á ¢ë஢¥ë¬ ¤à¥á®¬.
\ name ¨á¯®«ì§ã¥âáï ª ª "¯¥à¥¬¥ ï".
\ name 믮«¥¨¥: ( -- a-addr )
\ a-addr - ¤à¥á § १¥à¢¨à®¢ ®© ï祩ª¨. ¨¨æ¨ «¨§ æ¨î ï祩ª¨ ®â¢¥ç ¥â
\ ¯à®£à ¬¬
CREATE
0 ,
;
: CONSTANT ( x "<spaces>name" -- ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 ¯à®¡¥«ë. 뤥«¨âì name, ®£à ¨ç¥®¥ ¯à®¡¥«®¬.
\ ®§¤ âì ®¯à¥¤¥«¥¨¥ ¤«ï name á ᥬ ⨪®© ¢ë¯®«¥¨ï, ¤ ®© ¨¦¥.
\ name ¨á¯®«ì§ã¥âáï ª ª "ª®áâ â ".
\ name 믮«¥¨¥: ( -- x )
\ ®«®¦¨âì x á⥪.
HEADER
CONSTANT-CODE COMPILE, ,
;
: VALUE ( x "<spaces>name" -- ) \ 94 CORE EXT
\ யãáâ¨âì ¢¥¤ã騥 ¯à®¡¥«ë. 뤥«¨âì name, ®£à ¨ç¥®¥ ¯à®¡¥«®¬. ®§¤ âì
\ ®¯à¥¤¥«¥¨¥ ¤«ï name á ᥬ ⨪®© ¢ë¯®«¥¨ï, ®¯à¥¤¥«¥®© ¨¦¥, á ç «ìë¬
\ § 票¥¬ à ¢ë¬ x.
\ name ¨á¯®«ì§ã¥âáï ª ª "§ 票¥".
\ 믮«¥¨¥: ( -- x )
\ ®«®¦¨âì x á⥪. 票¥ x - â®, ª®â®à®¥ ¡ë«® ¤ ®, ª®£¤ ¨¬ï ᮧ¤ ¢ «®áì,
\ ¯®ª ¥ ¨á¯®«¨âáï äà § x TO name, § ¤ ¢ ®¢®¥ § 票¥ x,
\ áá®æ¨¨à®¢ ®¥ á name.
HEADER
CONSTANT-CODE COMPILE, ,
TOVALUE-CODE COMPILE,
;
: VECT ( -> )
( ᮧ¤ âì á«®¢®, ᥬ ⨪㠢믮«¥¨ï ª®â®à®£® ¬®¦® ¬¥ïâì,
§ ¯¨áë¢ ï ¢ ¥£® ®¢ë© xt ¯® TO)
HEADER
VECT-CODE COMPILE, ['] NOOP ,
TOVALUE-CODE COMPILE,
;
: ->VARIABLE ( x "<spaces>name" -- ) \ 94
HEADER
CREATE-CODE COMPILE,
,
;
: USER-ALIGNED ( -- a-addr n )
USER-HERE 3 + 2 RSHIFT ( 4 / ) 4 * DUP
USER-HERE -
;
: USER-CREATE ( "<spaces>name" -- )
HEADER
HERE DOES>A ! ( ¤«ï DOES )
USER-CODE COMPILE,
USER-ALIGNED
USER-ALLOT ,
;
: USER ( "<spaces>name" -- ) \ «®ª «ìë¥ ¯¥à¥¬¥ë¥ ¯®â®ª
USER-CREATE
4 USER-ALLOT
;
' _TOUSER-VALUE-CODE TO TOUSER-VALUE-CODE
: USER-VALUE ( "<spaces>name" -- ) \ 94 CORE EXT
HEADER
USER-VALUE-CODE COMPILE,
USER-ALIGNED SWAP ,
CELL+ USER-ALLOT
TOUSER-VALUE-CODE COMPILE,
;
: ->VECT ( x -> )
HEADER
VECT-CODE COMPILE, ,
TOVALUE-CODE COMPILE,
;
: : _: ;
: _: ( C: "<spaces>name" -- colon-sys ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 à §¤¥«¨â¥«¨. 뤥«¨âì ¨¬ï, ®£à ¨ç¥®¥ ¯à®¡¥«®¬.
\ ®§¤ âì ®¯à¥¤¥«¥¨¥ ¤«ï ¨¬¥¨, §ë¢ ¥¬®¥ "®¯à¥¤¥«¥¨¥ ç¥à¥§ ¤¢®¥â®ç¨¥".
\ áâ ®¢¨âì á®áâ®ï¨¥ ª®¬¯¨«ï樨 ¨ ç âì ⥪ã饥 ®¯à¥¤¥«¥¨¥, ¯®«ã稢
\ colon-sys. ®¡ ¢¨âì ᥬ ⨪㠨¨æ¨ «¨§ 樨, ®¯¨á ãî ¨¦¥, ¢ ⥪ã饥
\ ®¯à¥¤¥«¥¨¥. ¥¬ ⨪ ¢ë¯®«¥¨ï ¡ã¤¥â ®¯à¥¤¥«¥ á«®¢ ¬¨, ᪮¬¯¨«¨à®-
\ ¢ 묨 ¢ ⥫® ®¯à¥¤¥«¥¨ï. ¥ªã饥 ®¯à¥¤¥«¥¨¥ ¤®«¦® ¡ëâì ¥¢¨¤¨¬®
\ ¯à¨ ¯®¨áª¥ ¢ á«®¢ ॠ¤® â¥å ¯®à, ¯®ª ¥ ¡ã¤¥â § ¢¥à襮.
\ ¨æ¨ «¨§ æ¨ï: ( i*x -- i*x ) ( R: -- nest-sys )
\ ®åà ¨âì ¨ä®à¬ æ¨î nest-sys ® ¢ë§®¢¥ ®¯à¥¤¥«¥¨ï. ®áâ®ï¨¥ á⥪
\ i*x ¯à¥¤áâ ¢«ï¥â à£ã¬¥âë ¨¬¥¨.
\ ¬ï 믮«¥¨¥: ( i*x -- j*x )
\ 믮«¨âì ®¯à¥¤¥«¥¨¥ ¨¬¥¨. ®áâ®ï¨ï á⥪ i*x ¨ j*x ¯à¥¤áâ ¢«ïîâ
\ à£ã¬¥âë ¨ १ã«ìâ âë ¨¬¥¨ ᮮ⢥âá⢥®.
PARSE-WORD _SHEADER ]
HERE TO :-SET
;
\ S" ~mak\CompIF.f" INCLUDED