Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 4866 → Rev 4867

/programs/develop/SPForth/src/compiler/spf_defwords.f
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