77 lines
2.2 KiB
Forth
77 lines
2.2 KiB
Forth
DECIMAL
|
||
|
||
\ ' DUP VALUE 'DUP_V
|
||
\ ' DROP VALUE 'DROP_V
|
||
|
||
USER HLD \ ¯¥à¥¬¥ ï - ¯®§¨æ¨ï ¯®á«¥¤¥© «¨â¥àë, ¯¥à¥¥á¥®© ¢ PAD
|
||
|
||
0 VALUE H-STDIN \ åí¤« ä ©« - áâ ¤ à⮣® ¢¢®¤
|
||
1 VALUE H-STDOUT \ åí¤« ä ©« - áâ ¤ à⮣® ¢ë¢®¤
|
||
1 VALUE H-STDERR \ åí¤« ä ©« - áâ ¤ à⮣® ¢ë¢®¤ ®è¨¡®ª
|
||
|
||
USER ALIGN-BYTES
|
||
|
||
: ALIGNED ( addr -- a-addr ) \ 94
|
||
\ a-addr - ¯¥à¢ë© ¢ë஢¥ë© ¤à¥á, ¡®«ì訩 ¨«¨ à ¢ë© addr.
|
||
ALIGN-BYTES @ DUP 0= IF 1+ DUP ALIGN-BYTES ! THEN
|
||
2DUP
|
||
MOD DUP IF - + ELSE 2DROP THEN
|
||
;
|
||
|
||
: ALIGN ( -- ) \ 94
|
||
\ …᫨ 㪠§ â¥«ì ¯à®áâà á⢠¤ ëå ¥ ¢ë஢¥ -
|
||
\ ¢ë஢ïâì ¥£®.
|
||
DP @ ALIGNED DP @ - ALLOT
|
||
;
|
||
|
||
: ALIGN-NOP ( n -- )
|
||
\ ¢ë஢ïâì HERE n ¨ § ¯®«¨âì NOP
|
||
HERE DUP ROT 2DUP
|
||
MOD DUP IF - + ELSE 2DROP THEN
|
||
OVER - DUP ALLOT 0x90 FILL
|
||
;
|
||
|
||
: IMMEDIATE ( -- ) \ 94
|
||
\ ‘¤¥« âì ¯®á«¥¤¥¥ ®¯à¥¤¥«¥¨¥ á«®¢®¬ ¥¬¥¤«¥®£® ¨á¯®«¥¨ï.
|
||
\ ˆáª«îç¨â¥«ì ï á¨âã æ¨ï ¢®§¨ª ¥â, ¥á«¨ ¯®á«¥¤¥¥ ®¯à¥¤¥«¥¨¥
|
||
\ ¥ ¨¬¥¥â ¨¬¥¨.
|
||
LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP C!
|
||
;
|
||
|
||
|
||
: :NONAME ( C: -- colon-sys ) ( S: -- xt ) \ 94 CORE EXT
|
||
\ ‘®§¤ âì ¢ë¯®«¨¬ë© ⮪¥ xt, ãáâ ®¢¨âì á®áâ®ï¨¥ ª®¬¯¨«ï樨 ¨
|
||
\ ç âì ⥪ã饥 ®¯à¥¤¥«¥¨¥, ¯à®¨§¢¥¤ï colon-sys. „®¡ ¢¨âì ᥬ ⨪ã
|
||
\ ¨¨æ¨ «¨§ 樨 ª ⥪ã饬㠮¯à¥¤¥«¥¨î.
|
||
\ ‘¥¬ ⨪ ¢ë¯®«¥¨ï xt ¡ã¤¥â § ¤ á«®¢ ¬¨, ᪮¬¯¨«¨à®¢ 묨
|
||
\ ¢ ⥫® ®¯à¥¤¥«¥¨ï. <20>â® ®¯à¥¤¥«¥¨¥ ¬®¦¥â ¡ëâì ¯®§¦¥ ¢ë¯®«¥® ¯®
|
||
\ xt EXECUTE.
|
||
\ …᫨ ã¯à ¢«ïî騩 á⥪ ॠ«¨§®¢ á ¨¬¯®«ì§®¢ ¨¥¬ á⥪ ¤ ëå,
|
||
\ colon-sys ¡ã¤¥â ¢¥à娬 í«¥¬¥â®¬ á⥪¥ ¤ ëå.
|
||
\ ˆ¨æ¨ «¨§ æ¨ï: ( i*x -- i*x ) ( R: -- nest-sys )
|
||
\ ‘®åà ¨âì § ¢¨áïéãî ®â ॠ«¨§ 樨 ¨ä®à¬ æ¨î nest-sys ® ¢ë§®¢¥
|
||
\ ®¯à¥¤¥«¥¨ï. <20>«¥¬¥âë á⥪ i*x ¯à¥¤áâ ¢«ïîâ à£ã¬¥âë xt.
|
||
\ xt ‚믮«¥¨¥: ( i*x -- j*x )
|
||
\ ‚믮«¨âì ®¯à¥¤¥«¥¨¥, § ¤ ®¥ xt. <20>«¥¬¥âë á⥪ i*x ¨ j*x
|
||
\ ¯à¥¤áâ ¢«ïîâ à£ã¬¥âë ¨ १ã«ìâ âë xt ᮮ⢥âá⢥®.
|
||
HERE ]
|
||
HERE TO :-SET ;
|
||
|
||
: INCLUDED INCLUDED_ ;
|
||
' NOOP TO <PRE>
|
||
' FIND1 TO FIND
|
||
' ?LITERAL2 TO ?LITERAL
|
||
' ?SLITERAL2 TO ?SLITERAL
|
||
' OK1 TO OK.
|
||
' (ABORT1") TO (ABORT")
|
||
|
||
VECT TYPE ' _TYPE TO TYPE
|
||
VECT EMIT ' _EMIT TO EMIT
|
||
|
||
|
||
: H. BASE @ SWAP HEX U. BASE ! ;
|
||
|
||
: TST S" /rd/1/autoload.f" INCLUDED_ ;
|
||
: TST1 S" WORDS" EVALUATE ;
|
||
|