badpork/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity
efbe3e0a39
kolibrios/programs/develop/SPForth/src/spf_last.f

77 lines
2.2 KiB
FortranFixed
Raw Normal View History

KolSPForth12 uploaded to SVN git-svn-id: svn://kolibrios.org@4867 a494cfbc-eb01-0410-851d-a64ba20cac60
2014-04-21 21:22:58 +02:00
DECIMAL
\ ' DUP VALUE 'DUP_V
\ ' DROP VALUE 'DROP_V
USER HLD \ <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>᫥<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD><EFBFBD>७<EFBFBD>ᥭ<EFBFBD><EFBFBD><EFBFBD> <EFBFBD> PAD
0 VALUE H-STDIN \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 䠩<EFBFBD><EFBFBD> - <EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD>⭮<EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
1 VALUE H-STDOUT \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 䠩<EFBFBD><EFBFBD> - <EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD>⭮<EFBFBD><EFBFBD> <EFBFBD>뢮<EFBFBD><EFBFBD>
1 VALUE H-STDERR \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 䠩<EFBFBD><EFBFBD> - <EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD>⭮<EFBFBD><EFBFBD> <EFBFBD>뢮<EFBFBD><EFBFBD> <EFBFBD>訡<EFBFBD><EFBFBD>
USER ALIGN-BYTES
: ALIGNED ( addr -- a-addr ) \ 94
\ a-addr - <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD><EFBFBD><EFBFBD><EFBFBD>訩 <EFBFBD><EFBFBD><EFBFBD> ࠢ<EFBFBD><EFBFBD><EFBFBD> addr.
ALIGN-BYTES @ DUP 0= IF 1+ DUP ALIGN-BYTES ! THEN
2DUP
MOD DUP IF - + ELSE 2DROP THEN
;
: ALIGN ( -- ) \ 94
\ <20>᫨ 㪠<EFBFBD><EFBFBD>⥫<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>࠭<EFBFBD>⢠ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> <EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD> -
\ <20><>஢<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD>.
DP @ ALIGNED DP @ - ALLOT
;
: ALIGN-NOP ( n -- )
\ <20><>஢<EFBFBD><EFBFBD><EFBFBD><EFBFBD> HERE <EFBFBD><EFBFBD> n <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> NOP
HERE DUP ROT 2DUP
MOD DUP IF - + ELSE 2DROP THEN
OVER - DUP ALLOT 0x90 FILL
;
: IMMEDIATE ( -- ) \ 94
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>᫥<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ᫮<EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>ᯮ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
\ <20>᪫<EFBFBD><EFBFBD><EFBFBD>⥫쭠<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD>᫨ <EFBFBD><EFBFBD>᫥<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
\ <20><> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
LAST @ NAME>F DUP C@ &IMMEDIATE OR SWAP C!
;
: :NONAME ( C: -- colon-sys ) ( S: -- xt ) \ 94 CORE EXT
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>믮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ⮪<EFBFBD><EFBFBD> xt, <EFBFBD><EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ﭨ<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>樨 <EFBFBD>
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ⥪<EFBFBD>饥 <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD>ந<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> colon-sys. <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ᥬ<EFBFBD><EFBFBD>⨪<EFBFBD>
\ <20><><EFBFBD>樠<EFBFBD><EFBFBD><EFBFBD><EFBFBD>樨 <EFBFBD> ⥪<EFBFBD>饬<EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
\ <20><><EFBFBD><EFBFBD><EFBFBD>⨪<EFBFBD> <EFBFBD>믮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> xt <EFBFBD>㤥<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ᫮<EFBFBD><EFBFBD><EFBFBD><EFBFBD>, ᪮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>஢<EFBFBD><EFBFBD><EFBFBD>묨
\ <20> ⥫<EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>믮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>
\ xt EXECUTE.
\ <20>᫨ <EFBFBD><EFBFBD>ࠢ<EFBFBD><EFBFBD><EFBFBD>騩 <EFBFBD>⥪ ॠ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>짮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>⥪<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,
\ colon-sys <EFBFBD>㤥<EFBFBD> <EFBFBD><EFBFBD><EFBFBD>孨<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>⮬ <EFBFBD><EFBFBD> <EFBFBD>⥪<EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.
\ <20><><EFBFBD>樠<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: ( i*x -- i*x ) ( R: -- nest-sys )
\ <20><><EFBFBD>࠭<EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> ॠ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>樨 <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ଠ<EFBFBD><EFBFBD><EFBFBD> nest-sys <EFBFBD> <EFBFBD>맮<EFBFBD><EFBFBD>
\ <20><>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>⥪<EFBFBD> i*x <EFBFBD>।<EFBFBD>⠢<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD>㬥<EFBFBD><EFBFBD><EFBFBD> xt.
\ xt <EFBFBD>믮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: ( i*x -- j*x )
\ <20>믮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>।<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> xt. <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>⥪<EFBFBD> i*x <EFBFBD> j*x
\ <20>।<EFBFBD>⠢<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD>㬥<EFBFBD><EFBFBD><EFBFBD> <EFBFBD> १<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> xt ᮮ⢥<EFBFBD><EFBFBD>⢥<EFBFBD><EFBFBD><EFBFBD>.
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 ;
Copy Permalink