mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 17:48:07 +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 ;
|
: XFIND XCURRENT @ SWAP _find DROP _xapply ;
|
||||||
: X' XCON ' XCOFF ; : X['] XCON ' _xapply LITN XCOFF ;
|
: X' XCON ' XCOFF ; : X['] XCON ' _xapply LITN XCOFF ;
|
||||||
: XCOMPILE XCON ' _xapply LITN
|
: XCOMPILE XCON ' _xapply LITN
|
||||||
LIT< , FIND DROP _xapply , XCOFF ;
|
LIT" ," FIND DROP _xapply , XCOFF ;
|
||||||
: X[COMPILE] XCON ' _xapply , XCOFF ;
|
: X[COMPILE] XCON ' _xapply , XCOFF ;
|
||||||
: XDO LIT< 2>R XFIND , H@ ;
|
: XDO LIT" 2>R" XFIND , H@ ;
|
||||||
: XLOOP LIT< (loop) XFIND , H@ - C, ;
|
: XLOOP LIT" (loop)" XFIND , H@ - C, ;
|
||||||
: XIF LIT< (?br) XFIND , H@ 1 ALLOT ;
|
: XIF LIT" (?br)" XFIND , H@ 1 ALLOT ;
|
||||||
: XELSE LIT< (br) XFIND , 1 ALLOT [COMPILE] THEN H@ 1- ;
|
: 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, ;
|
: XAGAIN LIT" (br)" XFIND , H@ - C, ;
|
||||||
: XUNTIL LIT< (?br) XFIND , H@ - C, ;
|
: XUNTIL LIT" (?br)" XFIND , H@ - C, ;
|
||||||
: XLIT< LIT< (s) XFIND , WORD DUP C@ 1+ MOVE, ;
|
|
||||||
: XLIT"
|
: XLIT"
|
||||||
LIT< (s) XFIND , H@ 0 C, ,"
|
LIT" (s)" XFIND , H@ 0 C, ,"
|
||||||
DUP H@ -^ 1- SWAP C!
|
DUP H@ -^ 1- SWAP C!
|
||||||
;
|
;
|
||||||
|
2
blk/270
2
blk/270
@ -5,7 +5,7 @@
|
|||||||
: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE
|
: DO XDO ; IMMEDIATE : LOOP XLOOP ; IMMEDIATE
|
||||||
: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE
|
: IF XIF ; IMMEDIATE : ELSE XELSE ; IMMEDIATE
|
||||||
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE
|
: AGAIN XAGAIN ; IMMEDIATE : UNTIL XUNTIL ; IMMEDIATE
|
||||||
: LIT< XLIT< ; IMMEDIATE : LIT" XLIT" ; IMMEDIATE
|
: LIT" XLIT" ; IMMEDIATE
|
||||||
: IMMEDIATE XIMM ;
|
: IMMEDIATE XIMM ;
|
||||||
: (entry) (xentry) ;
|
: (entry) (xentry) ;
|
||||||
: CREATE XCREATE ;
|
: CREATE XCREATE ;
|
||||||
|
2
blk/353
2
blk/353
@ -9,6 +9,6 @@
|
|||||||
: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
||||||
: QUIT
|
: QUIT
|
||||||
(resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
|
(resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
|
||||||
LIT< (main) FIND DROP EXECUTE
|
LIT" (main)" FIND DROP EXECUTE
|
||||||
;
|
;
|
||||||
1 25 LOADR+ ( xcomp core low )
|
1 25 LOADR+ ( xcomp core low )
|
||||||
|
2
blk/354
2
blk/354
@ -1,5 +1,5 @@
|
|||||||
: ABORT (resSP) QUIT ;
|
: 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 = ;
|
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
||||||
: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
|
: 0< 32767 > ; : >= < NOT ; : <= > NOT ; : 0>= 0< NOT ;
|
||||||
: >< ( n l h -- f ) 2 PICK > ( n l f ) ROT ROT > AND ;
|
: >< ( 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 )
|
: (parse) ( a -- n )
|
||||||
_pc IF EXIT THEN
|
_pc IF EXIT THEN
|
||||||
_ph IF EXIT THEN
|
_ph IF EXIT THEN
|
||||||
_pb IF EXIT THEN
|
_pb IF EXIT THEN
|
||||||
_pd IF EXIT THEN
|
_pd IF EXIT THEN
|
||||||
( nothing works )
|
( nothing works )
|
||||||
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
|
(wnf)
|
||||||
;
|
;
|
||||||
|
2
blk/369
2
blk/369
@ -1,5 +1,5 @@
|
|||||||
: '? WORD FIND ;
|
: '? WORD FIND ;
|
||||||
: ' '? NOT IF LIT< (wnf) FIND DROP EXECUTE THEN ;
|
: ' '? NOT IF (wnf) THEN ;
|
||||||
: ROLL
|
: ROLL
|
||||||
?DUP NOT IF EXIT THEN
|
?DUP NOT IF EXIT THEN
|
||||||
1+ DUP PICK ( n val )
|
1+ DUP PICK ( n val )
|
||||||
|
2
blk/372
2
blk/372
@ -11,4 +11,4 @@
|
|||||||
WORD( HERE ! ( w )
|
WORD( HERE ! ( w )
|
||||||
PREV CURRENT !
|
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]
|
||||||
IF EXIT THEN
|
IF EXIT THEN
|
||||||
LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
|
LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
|
||||||
: [THEN] ;
|
: [THEN] ;
|
||||||
|
1
blk/381
1
blk/381
@ -9,4 +9,3 @@
|
|||||||
XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + !
|
XCURRENT @ _xapply ORG @ 0x06 ( stable ABI uflw ) + !
|
||||||
: (oflw) LIT" stack overflow" ERR ;
|
: (oflw) LIT" stack overflow" ERR ;
|
||||||
XCURRENT @ _xapply ORG @ 0x13 ( stable ABI oflw ) + !
|
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
|
BEGIN
|
||||||
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
||||||
AGAIN ;
|
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
|
BEGIN
|
||||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
||||||
FIND NOT IF (parse) ELSE EXECUTE 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 ;
|
AGAIN ;
|
||||||
( Read from BOOT C< PTR and inc it. )
|
( Read from BOOT C< PTR and inc it. )
|
||||||
: (boot<)
|
: (boot<)
|
||||||
|
4
blk/396
4
blk/396
@ -11,6 +11,6 @@
|
|||||||
['] C@ A@* ! ['] C! A!* !
|
['] C@ A@* ! ['] C! A!* !
|
||||||
( boot< always has a char waiting. 06 == C<?* )
|
( boot< always has a char waiting. 06 == C<?* )
|
||||||
1 0x06 RAM+ ! INTERPRET
|
1 0x06 RAM+ ! INTERPRET
|
||||||
RDLN$ LIT< _sys [entry]
|
RDLN$ LIT" _sys" [entry]
|
||||||
LIT< CollapseOS (print) NL (main) ;
|
LIT" Collapse OS" (print) NL (main) ;
|
||||||
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
|
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. )
|
( 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
|
: DO COMPILE 2>R H@ ; IMMEDIATE
|
||||||
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
|
: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
|
||||||
( LEAVE is implemented in low xcomp )
|
( LEAVE is implemented in low xcomp )
|
||||||
: LITN 0x23 ( n ) , , ;
|
: LITN 0x23 ( n ) , , ;
|
||||||
( gets its name at the very end. can't comment afterwards )
|
( 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 )
|
: _ ( : will get its name almost at the very end )
|
||||||
(entry) 1 ( compiled ) C,
|
(entry) 1 ( compiled ) C,
|
||||||
BEGIN
|
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
|
: BEGIN H@ ; IMMEDIATE
|
||||||
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
|
: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
|
||||||
: UNTIL 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
|
# Strings
|
||||||
|
|
||||||
LIT< x -- Read following word and write to HERE as a
|
LIT" x" -- Read following characters and write to HERE
|
||||||
string literal.
|
as a string literal.
|
||||||
LIT" x" -- Same as LIT<, but can contain whitespaces.
|
|
||||||
S= a1 a2 -- f Returns whether string a1 == a2.
|
S= a1 a2 -- f Returns whether string a1 == a2.
|
||||||
|
|
||||||
# I/O
|
# I/O
|
||||||
|
Loading…
Reference in New Issue
Block a user