0,0 → 1,206 |
( ¯à¥¤¥«ïî騥 á«®¢ , ᮧ¤ î騥 á«®¢ àë¥ áâ âì¨ ¢ á«®¢ à¥. |
-¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥¨ï. |
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 |
|