( à á«ïæ¨ï ¨á室ëå ⥪á⮢ ¯à®£à ¬¬.
-¥§ ¢¨á¨¬ë¥ ®¯à¥¤¥«¥¨ï.
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
८¡à §®¢ ¨¥ ¨§ 16-à §à冷£® ¢ 32-à §àï¤ë© ª®¤ - 1995-96££
¥¢¨§¨ï - á¥âï¡àì 1999
)
VECT OK.
VECT <MAIN>
VECT ?LITERAL
VECT ?SLITERAL
USER-VALUE SOURCE-ID-XT \ ¥á«¨ ¥ à ¢¥ ã«î, ⮠ᮤ¥à¦¨â § ¯®«ïî饥
: DEPTH ( -- +n ) \ 94
\ +n - ç¨á«® ®¤¨ àëå ï祥ª, 室ïé¨åáï á⥪¥ ¤ ëå ¯¥à¥¤
\ ⥬ ª ª â㤠¡ë«® ¯®¬¥é¥® +n.
SP@ S0 @ - NEGATE 4 U/
;
: ?STACK ( -> ) \ ¢ë¤ âì ®è¨¡ªã "¨áç¥à¯ ¨¥ á⥪ ", ¥á«¨ ® ¡®«¥¥ 祬 ¯ãáâ
SP@ S0 @ SWAP U< IF S0 @ SP! -4 THROW THEN
;
: ?COMP ( -> )
STATE @ 0= IF -312 THROW THEN ( ®«ìª® ¤«ï ०¨¬ ª®¬¯¨«ï樨 )
;
: WORD ( char "<chars>ccc<char>" -- c-addr ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 à §¤¥«¨â¥«¨. ë¡à âì ᨬ¢®«ë, ®£à ¨ç¥ë¥
\ à §¤¥«¨â¥«¥¬ char.
\ ᪫îç¨â¥«ì ï á¨âã æ¨ï ¢®§¨ª ¥â, ¥á«¨ ¤«¨ ¨§¢«¥ç¥®© áâப¨
\ ¡®«ìè¥ ¬ ªá¨¬ «ì®© ¤«¨ë áâப¨ á® áç¥â稪®¬.
\ c-addr - ¤à¥á ¯¥à¥¬¥®© ®¡« áâ¨, ᮤ¥à¦ 饩 ¨§¢«¥ç¥®¥ á«®¢®
\ ¢ ¢¨¤¥ áâப¨ á® áç¥â稪®¬.
\
᫨ à §¡¨à ¥¬ ï ®¡« áâì ¯ãáâ ¨«¨ ᮤ¥à¦¨â ⮫쪮 à §¤¥«¨â¥«¨,
\ १ã«ìâ¨àãîé ï áâப ¨¬¥¥â ã«¥¢ãî ¤«¨ã.
\ ª®¥æ áâப¨ ¯®¬¥é ¥âáï ¯à®¡¥«, ¥ ¢ª«îç ¥¬ë© ¢ ¤«¨ã áâப¨.
\ à®£à ¬¬ ¬®¦¥â ¨§¬¥ïâì ᨬ¢®«ë ¢ áâப¥.
DUP PSKIP PARSE
DUP HERE C! HERE 1+ SWAP CMOVE
BL HERE COUNT + !
HERE
;
1 [IF]
: ' ( "<spaces>name" -- xt ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 ¯à®¡¥«ë. 뤥«¨âì name, ®£à ¨ç¥®¥ ¯à®¡¥«®¬. ©â¨ name
\ ¨ ¢¥àãâì xt, ¢ë¯®«¨¬ë© ⮪¥ ¤«ï name. ¥®¯à¥¤¥«¥ ï á¨âã æ¨ï ¢®§¨ª ¥â,
\ ¥á«¨ name ¥ ©¤¥®.
\ ® ¢à¥¬ï ¨â¥à¯à¥â 樨 ' name EXECUTE à ¢®á¨«ì® name.
PARSE-WORD SFIND 0=
IF -321 THROW THEN ( -? )
;
[THEN]
: CHAR ( "<spaces>name" -- char ) \ 94
\ யãáâ¨âì ¢¥¤ã騥 à §¤¥«¨â¥«¨. 뤥«¨âì ¨¬ï, ®à£ ¨ç¥®¥ ¯à®¡¥« ¬¨.
\ ®«®¦¨âì ª®¤ ¥£® ¯¥à¢®£® ᨬ¢®« á⥪.
PARSE-WORD DROP C@ ;
CREATE ILAST-WORD 0 , 0 ,
: INTERPRET_ ( -> ) \ ¨â¥à¯à¥â¨à®¢ âì ¢å®¤®© ¯®â®ª
SAVEERR? ON
BEGIN
PARSE-WORD DUP
WHILE 2DUP ILAST-WORD 2!
\ ." <" TYPE ." >"
SFIND ?DUP
IF
STATE @ =
IF COMPILE, ELSE EXECUTE THEN
ELSE
S" NOTFOUND" SFIND
IF EXECUTE
ELSE 2DROP ?SLITERAL THEN
\ ?SLITERAL
THEN
?STACK
REPEAT 2DROP
;
VARIABLE &INTERPRET
' INTERPRET_ &INTERPRET !
: INTERPRET &INTERPRET @ EXECUTE ;
\ : HALT ( ERRNUM -> ) \ ¢ë室 á ª®¤®¬ ®è¨¡ª¨
\ >R exit ;
: .SN ( n --)
\ ᯥç â âì n ¢¥àå¨å í«¥¬¥â®¢ á⥪
>R BEGIN
R@
WHILE
SP@ R@ 1- CELLS + @ DUP 0<
IF DUP U>D <# #S #> TYPE
." (" ABS 0 <# #S [CHAR] - HOLD #> TYPE ." ) " ELSE . THEN
R> 1- >R
REPEAT RDROP
;
: OK1
STATE @ 0=
IF ." Ok" DEPTH 70 UMIN
0 ?DO [CHAR] . EMIT LOOP CR
THEN
;
: EVAL-WORD ( a u -- )
\ ¨â¥à¯à¥â¨à®¢ âì ( âà ᫨஢ âì) á«®¢® á ¨¬¥¥¬ a u
SFIND ?DUP IF
STATE @ = IF
COMPILE, ELSE
EXECUTE THEN
ELSE
-2003 THROW THEN
;
: [ \ 94 CORE
\ â¥à¯à¥â æ¨ï: ᥬ ⨪ ¥®¯à¥¤¥«¥ .
\ ®¬¯¨«ïæ¨ï: 믮«¨âì ᥬ ⨪㠢믮«¥¨ï, ¤ ãî ¨¦¥.
\ 믮«¥¨¥: ( -- )
\ áâ ®¢¨âì á®áâ®ï¨¥ ¨â¥à¯à¥â 樨. [ á«®¢® ¥¬¥¤«¥®£® ¢ë¯®«¥¨ï.
STATE 0!
; IMMEDIATE
: ] ( -- ) \ 94 CORE
\ áâ ®¢¨âì á®áâ®ï¨¥ ª®¬¯¨«ï樨.
TRUE STATE !
;
: QUIT ( -- ) ( R: i*x ) \ CORE 94
\ ¡à®á¨âì á⥪ ¢®§¢à ⮢, § ¯¨á âì ®«ì ¢ SOURCE-ID.
\ áâ ®¢¨âì áâ ¤ àâë© ¢å®¤®© ¯®â®ª ¨ á®áâ®ï¨¥ ¨â¥à¯à¥â 樨.
\ ¥ ¢ë¢®¤¨âì á®®¡é¥¨©. ®¢â®àïâì á«¥¤ãî饥:
\ - à¨ïâì áâப㠨§ ¢å®¤®£® ¯®â®ª ¢® ¢å®¤®© ¡ãä¥à, ®¡ã«¨âì >IN
\ ¨ ¨â¥¯à¥â¨à®¢ âì.
\ - 뢥á⨠§ ¢¨áï饥 ®â ॠ«¨§ 樨 á¨á⥬®¥ ¯à¨£« 襨¥, ¥á«¨
\ á¨á⥬ 室¨âáï ¢ á®áâ®ï¨¨ ¨â¥à¯à¥â 樨, ¢á¥ ¯à®æ¥ááë § ¢¥àè¥ë,
\ ¨ ¥â ¥®¤®§ çëå á¨âã 権.
\ R0 @ RP! ( ¥ ¤¥« ¥¬ í⮣®, çâ®¡ë ¯®§¢®«¨âì "['] QUIT CATCH" )
CONSOLE-HANDLES
0 TO SOURCE-ID
[COMPILE] [
<MAIN>
;
: MAIN1 ( -- )
BEGIN REFILL
WHILE INTERPRET OK.
REPEAT _BYE
;
' MAIN1 TO <MAIN>
: SAVE-SOURCE ( -- i*x i )
SOURCE-ID-XT SOURCE-ID >IN @ SOURCE CURSTR @ 6
;
: RESTORE-SOURCE ( i*x i -- )
6 <> IF ABORT THEN
CURSTR ! SOURCE! >IN ! TO SOURCE-ID TO SOURCE-ID-XT
;
: EVALUATE-WITH ( ( i*x c-addr u xt -- j*x )
\ ç¨â ï c-addr u ¢å®¤ë¬ ¯®â®ª®¬, ¢ëç¨á«¨âì ¥ñ ¨â¥à¯à¥â â®à®¬ xt.
SAVE-SOURCE N>R
>R SOURCE! -1 TO SOURCE-ID
R> ( ['] INTERPRET) CATCH
NR> RESTORE-SOURCE
THROW
;
: EVALUATE ( i*x c-addr u -- j*x ) \ 94
\ ®åà ï¥â ⥪ã騥 ᯥæ¨ä¨ª 樨 ¢å®¤®£® ¯®â®ª .
\ ¯¨áë¢ ¥â -1 ¢ SOURCE-ID. ¥« ¥â áâபã, § ¤ ãî c-addr u,
\ ¢å®¤ë¬ ¯®â®ª®¬ ¨ ¢å®¤ë¬ ¡ãä¥à®¬, ãáâ ¢«¨¢ ¥â >IN ¢ 0
\ ¨ ¨â¥à¯à¥â¨àã¥â. ®£¤ áâப à §®¡à ¤® ª®æ - ¢®ááâ ¢«¨¢ ¥â
\ ᯥæ¨ä¨ª 樨 ¯à¥¤ë¤ã饣® ¢å®¤®£® ¯®â®ª .
\ à㣨¥ ¨§¬¥¥¨ï á⥪ ®¯à¥¤¥«ïîâáï ¢ë¯®«ï¥¬ë¬¨ ¯® EVALUATE á«®¢ ¬¨.
['] INTERPRET EVALUATE-WITH
;
: FQUIT
BEGIN REFILL
WHILE INTERPRET
REPEAT ;
: INCLUDE-FILE ( i*x fileid -- j*x ) \ 94 FILE
>IN @ >R
SOURCE-ID >R TO SOURCE-ID
RP@ #TIB @ ALIGNED - RP!
TIB RP@ #TIB @ CMOVE
SOURCE 2>R
\ TCR ." IF"
['] FQUIT CATCH SAVEERR
\ ['] NOOP CATCH SAVEERR
2R> SOURCE!
RP@ TIB #TIB @ CMOVE
RP@ #TIB @ ALIGNED + RP!
R> TO SOURCE-ID
R> >IN ! THROW ;
: INCLUDED_ ( c-addr u ---- )
\ Open the file with name c-addr u and interpret all lines contained in it.
R/O OPEN-FILE THROW \ ABORT" Can't open include file"
DUP >R
['] INCLUDE-FILE CATCH
R> CLOSE-FILE DROP THROW
;
: REQUIRED ( waddr wu laddr lu -- )
2SWAP SFIND
IF DROP 2DROP
ELSE 2DROP INCLUDED_ THEN
;
: REQUIRE ( "word" "libpath" -- )
PARSE-NAME PARSE-NAME 2DUP + 0 SWAP C!
REQUIRED
;
: AUTOEXEC S" /sys/INIT.F" INCLUDED_ ;