aabc2/KOS_qrcodes
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

KolSPForth12 uploaded to SVN

Browse Source 
git-svn-id: svn://kolibrios.org@4867 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Kiril Lipatov
2014-04-21 19:22:58 +00:00
parent b3031965cc
commit 09488af869
91 changed files with 58885 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
programs/develop/SPForth/devel/~mak/lib/csr.f Normal file
View File

@@ -0,0 +1,25 @@
[IFNDEF] CSP
VARIABLE CSP \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
[THEN]
6 CONSTANT L-CAS# \ <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>
CREATE S-CSP L-CAS# CELLS ALLOT \ <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
S-CSP CSP !
: +CSP ( -> P) \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
CSP @ DUP CELL+ CSP !
;
: -CSP ( -> ) \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
CSP @ 1 CELLS - CSP !
;
: !CSP ( -> ) \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SP@ +CSP !
;
: CSP@ ( -> A)
CSP @ 1 CELLS - @
;
: ?CSP ( -> ) \ <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>
SP@ CSP@ <> 37 ?ERROR ( ABORT" <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD> CSP !")
-CSP
;

39
programs/develop/SPForth/devel/~mak/lib/locals-ans2.f Normal file
View File

@@ -0,0 +1,39 @@
\ $Id: locals-ans.f,v 1.2 2003/01/10 16:44:16 anfilat Exp $
\ Work in spf3, spf4
\ LOCALS <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 94.
\ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> -
\ LOCALS| n1 n2 n3 |
REQUIRE { ~mak/lib/locals4.f
GET-CURRENT ALSO vocLocalsSupport_M DEFINITIONS
: CompileANSLocInit
uPrevCurrent @ SET-CURRENT
uLocalsUCnt @ ?DUP
IF NEGATE CELLS R_ALLOT,
THEN
uLocalsCnt @ uLocalsUCnt @ - ?DUP
IF DUP CELLS NEGATE uAddDepth +!
DUP 0
DO uLocalsCnt @ uLocalsUCnt @ - I - 1-
LIT, S" PICK >R " EVALUATE LOOP
0 DO POSTPONE DROP LOOP
THEN
;;
SET-CURRENT
: LOCALS|
LocalsStartup
BEGIN
BL PSKIP PeekChar
[CHAR] | <>
WHILE
CREATE LocalsDoes@ IMMEDIATE
REPEAT
[CHAR] | PARSE 2DROP
CompileANSLocInit
;; IMMEDIATE
PREVIOUS

401
programs/develop/SPForth/devel/~mak/lib/locals4.f Normal file
View File

@@ -0,0 +1,401 @@
( 28.Mar.2000 Andrey Cherezov Copyright [C] RU FIG
<20>ᯮ<EFBFBD>짮<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD> ᫥<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD>஢:
Ruvim Pinka; Dmitry Yakimov; Oleg Shalyopa; Yuriy Zhilovets;
Konstantin Tarasov; Michail Maximov.
!! <20><><EFBFBD><EFBFBD>⠥<EFBFBD> ⮫쪮 <20> SPF4.
)
( <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>묨.
<20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD>ᯮ<EFBFBD>짮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> LOCALS <EFBFBD>⠭<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 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> <EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD>맮<EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
᫮<><E1ABAE> <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>
᫮<><E1ABAE> <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>
{ ᯨ᮪_<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>:
{ a b c d \ e f -- i j }
<20><><EFBFBD> { a b c d \ e f[ EVALUATE_<EFBFBD><EFBFBD>ࠦ<EFBFBD><EFBFBD><EFBFBD><EFBFBD> ] -- i j }
<20><><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> f[ <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> n <EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <EFBFBD>ᯮ<EFBFBD>짮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> f[ <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>砫<EFBFBD> <EFBFBD>⮣<EFBFBD>
<20><><EFBFBD><EFBFBD>⪠. \<EFBFBD> <EFBFBD>⨫<EFBFBD> MPE\
<20><><EFBFBD> { a b c d \ e [ 12 ] f -- i j }
<20><><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> f <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> 12 <EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <EFBFBD>ᯮ<EFBFBD>짮<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> f <EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>砫<EFBFBD> <EFBFBD>⮣<EFBFBD>
<20><><EFBFBD><EFBFBD>⪠.
<20><><EFBFBD><EFBFBD><EFBFBD> "\ <20><>.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.<2E><><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>:
{ item1 item2 -- }
<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>
<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>
<20> <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>.
<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> VALUE-<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> "^ <20><><EFBFBD>"
<20><><EFBFBD> "AT <20><><EFBFBD>".
<20><><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> TO
<20>ਬ<EFBFBD><EFBFBD><EFBFBD>:
: TEST { a b c d \ e f -- } a . b . c . b c + -> e e . f . ^ a @ . ;
Ok
1 2 3 4 TEST
1 2 3 5 0 1 Ok
: TEST { a b -- } a . b . CR 5 0 DO I . a . b . CR LOOP ;
Ok
12 34 TEST
12 34
0 12 34
1 12 34
2 12 34
3 12 34
4 12 34
Ok
: TEST { a b } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { a b -- } a . b . ;
Ok
1 2 TEST
1 2 Ok
: TEST { a b \ c -- d } a . b . c . ;
Ok
1 2 TEST
1 2 0 Ok
: TEST { \ a b } a . b . 1 -> a 2 -> b a . b . ;
Ok
TEST
0 0 1 2 Ok
<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>
<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>
<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>.
<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><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>樨
<20><><EFBFBD>쪮 <EFBFBD><EFBFBD><EFBFBD> ᫮<EFBFBD><EFBFBD>:
᫮<><E1ABAE><EFBFBD><EFBFBD> "vocLocalsSupport" <EFBFBD> "{"
<20><><EFBFBD> <EFBFBD><EFBFBD>⠫<EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>⠫<EFBFBD> "<22><><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>.
)
REQUIRE [IF] ~MAK\CompIF.f
C" 'DROP_V" FIND NIP 0=
[IF] ' DROP VALUE 'DROP_V
: 'DROP 'DROP_V ;
[THEN]
C" 'DUP_V" FIND NIP 0=
[IF] ' DUP VALUE 'DUP_V
: 'DUP 'DUP_V ;
[THEN]
C" 'DROP" FIND NIP 0=
[IF] ' DROP VALUE 'DROP
[THEN]
C" 'DUP" FIND NIP 0=
[IF] ' DUP VALUE 'DUP
[THEN]
\ C" '(LocalsExit)_V" FIND NIP 0=
\ [IF] ' (LocalsExit)_V VALUE '(LocalsExit)_V
\ [THEN]
MODULE: vocLocalsSupport_M
VARIABLE uLocalsCnt
VARIABLE uLocalsUCnt
VARIABLE uPrevCurrent
VARIABLE uAddDepth
: LocalOffs ( n -- offs )
2+ CELLS uAddDepth @ +
;
BASE @ HEX
' RP@ 7 + @ 0xC3042444 =
[IF]
: R_ALLOT,
DUP SHORT?
OPT_INIT SetOP
IF 8D C, 64 C, 24 C, C, \ mov esp, offset [esp]
ELSE 8D C, A4 C, 24 C, , \ mov esp, offset [esp]
THEN
OPT_CLOSE
;
C" MACRO," FIND NIP 0=
[IF] : MACRO, INLINE, ;
[THEN]
: CompileLocalRec ( u -- )
LocalOffs DUP
'DUP MACRO,
SHORT?
OPT_INIT SetOP
IF 8D C, 44 C, 24 C, C, \ lea eax, offset [esp]
ELSE 8D C, 84 C, 24 C, , \ lea eax, offset [esp]
THEN OPT
OPT_CLOSE
;
: CompileLocal@ ( n -- )
'DUP MACRO,
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 8B C, 44 C, 24 C, C, \ mov eax, offset [esp]
ELSE 8B C, 84 C, 24 C, , \ mov eax, offset [esp]
THEN OPT
OPT_CLOSE
;
: CompileLocal! ( n -- )
LocalOffs DUP SHORT?
OPT_INIT SetOP
IF 89 C, 44 C, 24 C, C, \ mov offset [esp], eax
ELSE 89 C, 84 C, 24 C, , \ mov offset [esp], eax
THEN OPT
OPT_CLOSE
'DROP MACRO,
;
\ : CompileLocal@ ( n -- )
\ LocalOffs LIT, POSTPONE RP+@
\ ;
[ELSE]
: R_ALLOT,
] POSTPONE LITERAL S" RP@ + RP! " EVALUATE
POSTPONE [ ;
: CompileLocalRec ( u -- )
LocalOffs
POSTPONE LITERAL
\ S" RP@ + " EVALUATE
;
: CompileLocal@ ( n -- )
CompileLocalRec
S" @ " EVALUATE
;
: CompileLocal! ( n -- )
CompileLocalRec
S" ! " EVALUATE
;
[THEN]
VARIABLE TEMP-DP
: CompileLocalsInit
TEMP-DP @ DP !
uPrevCurrent @ SET-CURRENT
uLocalsUCnt @ ?DUP
IF NEGATE CELLS R_ALLOT,
THEN
uLocalsCnt @ uLocalsUCnt @ - ?DUP
IF DUP CELLS NEGATE uAddDepth +! 0 DO S" >R " EVALUATE LOOP THEN
uLocalsCnt @ ?DUP
IF CELLS POSTPONE LITERAL S" >R ['] (LocalsExit) >R" EVALUATE
-2 CELLS uAddDepth +!
THEN
;
\ : CompileLocal@ ( n -- )
\ LocalOffs LIT, POSTPONE RP+@
\ ;
BASE !
WORDLIST CONSTANT widLocals@
CREATE TEMP-BUF 1000 ALLOT
: LocalsStartup
GET-CURRENT uPrevCurrent !
ALSO vocLocalsSupport_M
ALSO widLocals@ CONTEXT ! DEFINITIONS
HERE TEMP-DP !
TEMP-BUF DP !
widLocals@ 0!
uLocalsCnt 0!
uLocalsUCnt 0!
uAddDepth 0!
;
: LocalsCleanup
PREVIOUS PREVIOUS
;
: ProcessLocRec ( "name" -- u )
[CHAR] ] PARSE
STATE 0!
EVALUATE CELL 1- + CELL / \ <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 4
-1 STATE !
\ DUP uLocalsCnt +!
uLocalsCnt @
;
: CreateLocArray
[CHAR] [ PSKIP
ProcessLocRec
CREATE ,
DUP uLocalsCnt +!
;
: LocalsRecDoes@ ( -- u )
DOES> @ CompileLocalRec
;
: LocalsRecDoes@2 ( -- u )
ProcessLocRec ,
DUP uLocalsCnt +!
DOES> @ CompileLocalRec
;
: LocalsDoes@
uLocalsCnt @ ,
uLocalsCnt 1+!
DOES> @ CompileLocal@
;
: ;; POSTPONE ; ; IMMEDIATE
: ^
' >BODY @
CompileLocalRec
; IMMEDIATE
: -> ' >BODY @ CompileLocal! ; IMMEDIATE
WARNING DUP @ SWAP 0!
: AT
[COMPILE] ^
; IMMEDIATE
: TO ( "name" -- )
>IN @ NextWord widLocals@ SEARCH-WORDLIST 1 =
IF >BODY @ CompileLocal! DROP
ELSE >IN ! [COMPILE] TO
THEN
; IMMEDIATE
WARNING !
: <20> POSTPONE -> ; IMMEDIATE
WARNING @ WARNING 0!
\ ===
\ <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>
\ <20>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD>६<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 横<EFBFBD><EFBFBD> DO LOOP <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> >R R>
C" DO_SIZE" FIND NIP 0=
[IF] 3 CELLS CONSTANT DO_SIZE
[THEN]
: DO POSTPONE DO DO_SIZE uAddDepth +! ; IMMEDIATE
: ?DO POSTPONE ?DO DO_SIZE uAddDepth +! ; IMMEDIATE
: LOOP POSTPONE LOOP DO_SIZE NEGATE uAddDepth +! ; IMMEDIATE
: +LOOP POSTPONE +LOOP DO_SIZE NEGATE uAddDepth +! ; IMMEDIATE
: >R POSTPONE >R [ 1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: R> POSTPONE R> [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: RDROP POSTPONE RDROP [ -1 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2>R POSTPONE 2>R [ 2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
: 2R> POSTPONE 2R> [ -2 CELLS ] LITERAL uAddDepth +! ; IMMEDIATE
\ ===
\ uLocalsCnt @ ?DUP
\ IF CELLS RLIT, ['] (LocalsExit) RLIT, THEN
: ; LocalsCleanup
S" ;" EVAL-WORD
; IMMEDIATE
WARNING !
\ =====================================================================
EXPORT
: {
LocalsStartup
BEGIN
BL PSKIP PeekChar DUP [CHAR] \ <>
OVER [CHAR] - <> AND
OVER [CHAR] } <> AND
OVER [CHAR] | <> AND
SWAP [CHAR] ) XOR AND
WHILE
CREATE LocalsDoes@ IMMEDIATE
REPEAT
PeekChar >IN 1+! DUP [CHAR] } <>
IF
DUP [CHAR] \ =
SWAP [CHAR] | = OR
IF
BEGIN
BL PSKIP PeekChar DUP
DUP [CHAR] - <>
SWAP [CHAR] } <> AND
SWAP [CHAR] ) XOR AND
WHILE
PeekChar [CHAR] [ =
IF CreateLocArray LocalsRecDoes@
ELSE
CREATE LATEST DUP C@ + C@
[CHAR] [ =
IF
LocalsRecDoes@2
ELSE
LocalsDoes@ 1
THEN
THEN DUP U.
uLocalsUCnt +!
IMMEDIATE
REPEAT
THEN
[CHAR] } PARSE 2DROP
ELSE DROP THEN
CompileLocalsInit
;; IMMEDIATE
;MODULE

35
programs/develop/SPForth/devel/~mak/lib/map.f Normal file
View File

@@ -0,0 +1,35 @@
\ ~mak/want.f WANT #define
0 VALUE M#define-CODE
: M#define CREATE PARSE-WORD EVALUATE ,
DOES> [ HERE 5 - TO M#define-CODE ] @ ;
: Archive_
PARSE-WORD EVALUATE
' DUP 1+ REL@ CELL+ M#define-CODE =
IF
>BODY ! EXIT
THEN 1 THROW ;
: Archive \ F7_ED
BEGIN
PARSE-WORD DUP 0=
IF NIP REFILL 0= IF DROP TRUE THEN
ELSE S" size" COMPARE 0= THEN
UNTIL
REFILL DROP
BEGIN REFILL 0= IF \EOF EXIT THEN
SOURCE NIP
WHILE M#define
REPEAT
BEGIN REFILL
WHILE SOURCE NIP 40 >
IF
['] Archive_ CATCH DROP
THEN
REPEAT POSTPONE \
;

15
programs/develop/SPForth/devel/~mak/lib/vt/colors.f Normal file
View File

@@ -0,0 +1,15 @@
: (ESC) 27 EMIT TYPE ;
: CLEAR S" [2J" (ESC) ; : HOME CLEAR S" [1;1H" (ESC) ;
: NORMAL S" [0m" (ESC) ; : BOLD S" [1m" (ESC) ;
: BLACK S" [30m" (ESC) ; : RED S" [31m" (ESC) ;
: GREEN S" [32m" (ESC) ; : YELLOW S" [33m" (ESC) ;
: BLUE S" [34m" (ESC) ; : MAGENTA S" [35m" (ESC) ;
: CYAN S" [36m" (ESC) ; : WHITE S" [37m" (ESC) ;
: ONBLACK S" [40m" (ESC) ; : ONRED S" [41m" (ESC) ;
: ONGREEN S" [42m" (ESC) ; : ONYELLOW S" [43m" (ESC) ;
: ONBLUE S" [44m" (ESC) ; : ONMAGENTA S" [45m" (ESC) ;
: ONCYAN S" [46m" (ESC) ; : ONWHITE S" [47m" (ESC) ;