izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove LIT< in favor of LIT" exclusively

Browse Source 
This duplicated feature existed because of bootstrapping issues
with LIT", but again, with careful threading, we can clean things
up.

We can now have a proper "Collapse OS" prompt :)
This commit is contained in:
Virgil Dupras 2020-09-19 18:51:29 -04:00
parent 0b11979b5e
commit 68dd800bd1
17 changed files with 31 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
blk/263
View File

@ -7,9 +7,9 @@ CREATE XCURRENT 0 ,
: XFIND XCURRENT @ SWAP _find DROP _xapply ;
: X' XCON ' XCOFF ; : X['] XCON ' _xapply LITN XCOFF ;
: XCOMPILE XCON ' _xapply LITN
LIT< , FIND DROP _xapply , XCOFF ;
LIT" ," FIND DROP _xapply , XCOFF ;
: X[COMPILE] XCON ' _xapply , XCOFF ;
: XDO LIT< 2>R XFIND , H@ ;
: XLOOP LIT< (loop) XFIND , H@ - C, ;
: XIF LIT< (?br) XFIND , H@ 1 ALLOT ;
: XELSE LIT< (br) XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ;
: XDO LIT" 2>R" XFIND , H@ ;
: XLOOP LIT" (loop)" XFIND , H@ - C, ;
: XIF LIT" (?br)" XFIND , H@ 1 ALLOT ;
: XELSE LIT" (br)" XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ;

7
blk/264
View File

@ -1,7 +1,6 @@
: XAGAIN LIT< (br) XFIND , H@ - C, ;
: XUNTIL LIT< (?br) XFIND , H@ - C, ;
: XLIT< LIT< (s) XFIND , WORD DUP C@ 1+ MOVE, ;
: XAGAIN LIT" (br)" XFIND , H@ - C, ;
: XUNTIL LIT" (?br)" XFIND , H@ - C, ;
: XLIT"
LIT< (s) XFIND , H@ 0 C, ,"
LIT" (s)" XFIND , H@ 0 C, ,"
DUP H@ -^ 1- SWAP C!
;

2
blk/270
View File

@ -5,7 +5,7 @@
: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE
: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE
: LIT< XLIT< ; IMMEDIATE : LIT" XLIT" ; IMMEDIATE
: LIT" XLIT" ; IMMEDIATE
: IMMEDIATE XIMM ;
: (entry) (xentry) ;
: CREATE XCREATE ;

2
blk/353
View File

@ -9,6 +9,6 @@
: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer )
: QUIT
(resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
LIT< (main) FIND DROP EXECUTE
LIT" (main)" FIND DROP EXECUTE
;
1 25 LOADR+ ( xcomp core low )

2
blk/354
View File

@ -1,5 +1,5 @@
: ABORT (resSP) QUIT ;
: ERR LIT< (print) FIND IF EXECUTE THEN ABORT ;
: ERR LIT" (print)" FIND IF EXECUTE THEN ABORT ;
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ;

4
blk/363
View File

@ -1,8 +1,10 @@
: (wnf) LIT" (print)" FIND DROP EXECUTE
LIT" word not found" ERR ;
: (parse) ( a -- n )
_pc IF EXIT THEN
_ph IF EXIT THEN
_pb IF EXIT THEN
_pd IF EXIT THEN
( nothing works )
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
(wnf)
;

2
blk/369
View File

@ -1,5 +1,5 @@
: '? WORD FIND ;
: ' '? NOT IF LIT< (wnf) FIND DROP EXECUTE THEN ;
: ' '? NOT IF (wnf) THEN ;
: ROLL
?DUP NOT IF EXIT THEN
1+ DUP PICK ( n val )

2
blk/372
View File

@ -11,4 +11,4 @@
WORD( HERE ! ( w )
PREV CURRENT !
;
: EMPTY LIT< _sys FIND IF DUP HERE ! CURRENT ! THEN ;
: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;

2
blk/374
View File

@ -1,4 +1,4 @@
: [IF]
IF EXIT THEN
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
: [THEN] ;

1
blk/381
View File

@ -9,4 +9,3 @@
XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + !
: (oflw) LIT" stack overflow" ERR ;
XCURRENT @ _xapply ORG @ 0x13 ( stable ABI oflw ) + !
: (wnf) (print) SPC LIT" word not found" ERR ;

6
blk/382
View File

@ -2,9 +2,3 @@
BEGIN
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
AGAIN ;
: LIT"
COMPILE (s) H@ 0 C, ,"
DUP H@ -^ 1- ( a len ) SWAP C!
; IMMEDIATE
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

2
blk/392
View File

@ -2,7 +2,7 @@
BEGIN
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
FIND NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF SPC LIT< ok (print) NL THEN
C<? NOT IF SPC LIT" ok" (print) NL THEN
AGAIN ;
( Read from BOOT C< PTR and inc it. )
: (boot<)

4
blk/396
View File

@ -11,6 +11,6 @@
['] C@ A@* ! ['] C! A!* !
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ ! INTERPRET
RDLN$ LIT< _sys [entry]
LIT< CollapseOS (print) NL (main) ;
RDLN$ LIT" _sys" [entry]
LIT" Collapse OS" (print) NL (main) ;
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !

4
blk/397
View File

@ -1,11 +1,11 @@
( Now we have "as late as possible" stuff. See bootstrap doc. )
: _bchk DUP 0x7f + 0xff > IF LIT< br-ovfl (print) ABORT THEN ;
: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
: DO COMPILE 2>R H@ ; IMMEDIATE
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
( LEAVE is implemented in low xcomp )
: LITN 0x23 ( n ) , , ;
( gets its name at the very end. can't comment afterwards )
: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
: _ ( : will get its name almost at the very end )
(entry) 1 ( compiled ) C,
BEGIN

8
blk/399
View File

@ -1,4 +1,10 @@
: LIT< COMPILE (s) WORD DUP C@ 1+ MOVE, ; IMMEDIATE
: LIT"
COMPILE (s) H@ 0 C, ,"
DUP H@ -^ 1- ( a len ) SWAP C!
; IMMEDIATE
( We don't use ." and ABORT in core, they're not xcomp-ed )
: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: BEGIN H@ ; IMMEDIATE
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE

BIN
cvm/forth.bin
View File

Binary file not shown.

5
doc/dict.txt
View File

@ -221,9 +221,8 @@ NOT f -- f Push the logical opposite of f
# Strings
LIT< x -- Read following word and write to HERE as a
string literal.
LIT" x" -- Same as LIT<, but can contain whitespaces.
LIT" x" -- Read following characters and write to HERE
as a string literal.
S= a1 a2 -- f Returns whether string a1 == a2.
# I/O