mirror of
https://github.com/hsoft/collapseos.git
synced 2024-12-25 05:28:06 +11:00
Remove LIT< in favor of LIT" exclusively
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:
parent
0b11979b5e
commit
68dd800bd1
10
blk/263
10
blk/263
@ -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
7
blk/264
@ -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
2
blk/270
@ -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
2
blk/353
@ -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
2
blk/354
@ -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
4
blk/363
@ -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
2
blk/369
@ -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
2
blk/372
@ -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
2
blk/374
@ -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
1
blk/381
@ -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
6
blk/382
@ -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
2
blk/392
@ -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
4
blk/396
@ -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
4
blk/397
@ -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
8
blk/399
@ -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
BIN
cvm/forth.bin
Binary file not shown.
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user