mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 12:58:06 +11:00
Remove one level of C< override
Two was too many.
This commit is contained in:
parent
d09de0a0d3
commit
421ca5112f
101
blk.fs
101
blk.fs
@ -1684,11 +1684,9 @@ with "390 LOAD"
|
|||||||
: IN> 0x30 RAM+ ; ( current position in INBUF )
|
: IN> 0x30 RAM+ ; ( current position in INBUF )
|
||||||
: IN( 0x60 RAM+ ; ( points to INBUF )
|
: IN( 0x60 RAM+ ; ( points to INBUF )
|
||||||
: IN$ 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
: IN$ 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
||||||
: QUIT
|
: C<* 0x0c RAM+ ;
|
||||||
(resRS) 0 0x08 RAM+ ! ( C<* override ) IN$
|
: QUIT (resRS) 0 C<* ! IN$ LIT" (main)" FIND DROP EXECUTE ;
|
||||||
LIT" (main)" FIND DROP EXECUTE
|
1 28 LOADR+
|
||||||
;
|
|
||||||
1 31 LOADR+
|
|
||||||
( ----- 354 )
|
( ----- 354 )
|
||||||
: ABORT (resSP) QUIT ;
|
: ABORT (resSP) QUIT ;
|
||||||
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
||||||
@ -1784,31 +1782,49 @@ XCURRENT @ _xapply ORG @ 0x13 ( stable ABI oflw ) + !
|
|||||||
DUP '0' '1' =><= NOT IF 2DROP 0 UNLOOP EXIT THEN
|
DUP '0' '1' =><= NOT IF 2DROP 0 UNLOOP EXIT THEN
|
||||||
'0' - SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
'0' - SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||||
NIP 1 ;
|
NIP 1 ;
|
||||||
( ----- 362 )
|
: (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 ) (wnf) ;
|
||||||
(wnf)
|
( ----- 362 )
|
||||||
;
|
: EOT? EOT = ;
|
||||||
|
SYSVARS 0x55 + :** KEY?
|
||||||
|
: KEY BEGIN KEY? UNTIL ;
|
||||||
|
( del is same as backspace )
|
||||||
|
: BS? DUP 0x7f = SWAP BS = OR ;
|
||||||
|
: RDLN ( Read 1 line in input buff and make IN> point to it )
|
||||||
|
IN$ BEGIN
|
||||||
|
( buffer overflow? same as if we typed a newline )
|
||||||
|
IN> @ IN( - 0x3e = IF CR ELSE KEY THEN ( c )
|
||||||
|
DUP BS? IF
|
||||||
|
IN> @ IN( > IF -1 IN> +! BS EMIT THEN SPC> BS EMIT
|
||||||
|
ELSE DUP LF = IF DROP CR THEN ( same as CR )
|
||||||
|
DUP EMIT ( echo back )
|
||||||
|
DUP IN> @ ! 1 IN> +! THEN ( c )
|
||||||
|
DUP CR = SWAP EOT? OR UNTIL IN( IN> ! ;
|
||||||
( ----- 363 )
|
( ----- 363 )
|
||||||
|
: RDLN<
|
||||||
|
IN> @ C@ ( c )
|
||||||
|
DUP IF ( not EOL? good, inc and return )
|
||||||
|
1 IN> +!
|
||||||
|
ELSE ( EOL ? readline. we still return null though )
|
||||||
|
RDLN
|
||||||
|
THEN ( c )
|
||||||
|
( update C<? flag )
|
||||||
|
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? ) ;
|
||||||
|
( ----- 364 )
|
||||||
: C<? 0x06 RAM+ @ ;
|
: C<? 0x06 RAM+ @ ;
|
||||||
SYSVARS 0x0c + :** C<*
|
: C< C<* @ ?DUP NOT IF RDLN< ELSE EXECUTE THEN ;
|
||||||
: C<
|
|
||||||
0x08 RAM+ ( C<* override ) @
|
|
||||||
?DUP NOT IF C<* ELSE EXECUTE THEN ;
|
|
||||||
: , H@ ! H@ 2+ HERE ! ;
|
: , H@ ! H@ 2+ HERE ! ;
|
||||||
: C, H@ C!+ HERE ! ;
|
: C, H@ C!+ HERE ! ;
|
||||||
: ,"
|
: ,"
|
||||||
BEGIN
|
BEGIN
|
||||||
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
|
||||||
AGAIN ;
|
AGAIN ;
|
||||||
( ----- 364 )
|
|
||||||
: WS? SPC <= ;
|
|
||||||
: EOT? EOT = ;
|
|
||||||
: EOT, EOT C, ;
|
: EOT, EOT C, ;
|
||||||
|
: WS? SPC <= ;
|
||||||
|
|
||||||
: TOWORD ( -- c, c being the first letter of the word )
|
: TOWORD ( -- c, c being the first letter of the word )
|
||||||
0 ( dummy ) BEGIN
|
0 ( dummy ) BEGIN
|
||||||
@ -1969,32 +1985,6 @@ SYSVARS 0x0c + :** C<*
|
|||||||
SWAP 8 /MOD SWAP IF 1+ THEN
|
SWAP 8 /MOD SWAP IF 1+ THEN
|
||||||
0 DO _ LOOP ;
|
0 DO _ LOOP ;
|
||||||
( ----- 378 )
|
( ----- 378 )
|
||||||
SYSVARS 0x55 + :** KEY?
|
|
||||||
: KEY BEGIN KEY? UNTIL ;
|
|
||||||
( del is same as backspace )
|
|
||||||
: BS? DUP 0x7f = SWAP BS = OR ;
|
|
||||||
( ----- 379 )
|
|
||||||
: RDLN ( Read 1 line in input buff and make IN> point to it )
|
|
||||||
IN$ BEGIN
|
|
||||||
( buffer overflow? same as if we typed a newline )
|
|
||||||
IN> @ IN( - 0x3e = IF CR ELSE KEY THEN ( c )
|
|
||||||
DUP BS? IF
|
|
||||||
IN> @ IN( > IF -1 IN> +! BS EMIT THEN SPC> BS EMIT
|
|
||||||
ELSE DUP LF = IF DROP CR THEN ( same as CR )
|
|
||||||
DUP EMIT ( echo back )
|
|
||||||
DUP IN> @ ! 1 IN> +! THEN ( c )
|
|
||||||
DUP CR = SWAP EOT? OR UNTIL IN( IN> ! ;
|
|
||||||
( ----- 380 )
|
|
||||||
: RDLN<
|
|
||||||
IN> @ C@ ( c )
|
|
||||||
DUP IF ( not EOL? good, inc and return )
|
|
||||||
1 IN> +!
|
|
||||||
ELSE ( EOL ? readline. we still return null though )
|
|
||||||
RDLN
|
|
||||||
THEN ( c )
|
|
||||||
( update C<? flag )
|
|
||||||
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? ) ;
|
|
||||||
( ----- 381 )
|
|
||||||
: LIST
|
: LIST
|
||||||
BLK@
|
BLK@
|
||||||
16 0 DO
|
16 0 DO
|
||||||
@ -2004,7 +1994,7 @@ SYSVARS 0x55 + :** KEY?
|
|||||||
LOOP
|
LOOP
|
||||||
NL>
|
NL>
|
||||||
LOOP ;
|
LOOP ;
|
||||||
( ----- 382 )
|
( ----- 379 )
|
||||||
: INTERPRET
|
: INTERPRET
|
||||||
BEGIN
|
BEGIN
|
||||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
||||||
@ -2016,28 +2006,20 @@ SYSVARS 0x55 + :** KEY?
|
|||||||
( 2e == BOOT C< PTR )
|
( 2e == BOOT C< PTR )
|
||||||
0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
|
0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
|
||||||
SWAP 1 + 0x2e RAM+ ! ( c ) ;
|
SWAP 1 + 0x2e RAM+ ! ( c ) ;
|
||||||
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
|
( ----- 380 )
|
||||||
is to check whether we're restoring to "_", the word above.
|
|
||||||
if yes, then we're in a nested load. Also, the 1 in 0x06 is
|
|
||||||
to avoid tons of "ok" displays. )
|
|
||||||
( ----- 383 )
|
|
||||||
: LOAD
|
: LOAD
|
||||||
BLK> @ >R ( save restorable variables to RSP )
|
BLK> @ >R ( save restorable variables to RSP )
|
||||||
0x08 RAM+ @ >R ( 08 == C<* override )
|
C<* @ >R
|
||||||
0x06 RAM+ @ >R ( C<? )
|
0x06 RAM+ @ >R ( C<? )
|
||||||
0x2e RAM+ @ >R ( boot ptr )
|
0x2e RAM+ @ >R ( boot ptr )
|
||||||
BLK@
|
BLK@
|
||||||
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
||||||
['] (boot<) 0x08 RAM+ !
|
['] (boot<) 0x0c RAM+ !
|
||||||
1 0x06 RAM+ ! ( 06 == C<? )
|
1 0x06 RAM+ ! ( 06 == C<? )
|
||||||
INTERPRET
|
INTERPRET
|
||||||
R> 0x2e RAM+ ! R> 0x06 RAM+ !
|
R> 0x2e RAM+ ! R> 0x06 RAM+ !
|
||||||
I 0x08 RAM+ @ = IF ( nested load )
|
R> C<* ! R> BLK@ ;
|
||||||
R> DROP ( C<* ) R> BLK@
|
( ----- 381 )
|
||||||
ELSE ( not nested )
|
|
||||||
R> 0x08 RAM+ ! R> DROP ( BLK> )
|
|
||||||
THEN ;
|
|
||||||
( ----- 384 )
|
|
||||||
: LOAD+ BLK> @ + LOAD ;
|
: LOAD+ BLK> @ + LOAD ;
|
||||||
( b1 b2 -- )
|
( b1 b2 -- )
|
||||||
: LOADR 1+ SWAP DO I DUP . SPC> LOAD LOOP ;
|
: LOADR 1+ SWAP DO I DUP . SPC> LOAD LOOP ;
|
||||||
@ -2048,13 +2030,12 @@ SYSVARS 0x55 + :** KEY?
|
|||||||
: BOOT
|
: BOOT
|
||||||
0x02 RAM+ CURRENT* !
|
0x02 RAM+ CURRENT* !
|
||||||
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
|
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
|
||||||
0 0x08 RAM+ ! ( 08 == C<* override )
|
|
||||||
0 0x50 RAM+ C! ( NL> )
|
0 0x50 RAM+ C! ( NL> )
|
||||||
['] (emit) ['] EMIT **! ['] (key?) ['] KEY? **!
|
['] (emit) ['] EMIT **! ['] (key?) ['] KEY? **!
|
||||||
['] (boot<) ['] C<* **!
|
['] (boot<) C<* !
|
||||||
( 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< ['] C<* **! IN$
|
0 C<* ! IN$
|
||||||
LIT" _sys" [entry]
|
LIT" _sys" [entry]
|
||||||
LIT" Collapse OS" STYPE NL> (main) ;
|
LIT" Collapse OS" STYPE NL> (main) ;
|
||||||
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
|
XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
|
||||||
|
BIN
cvm/stage.bin
BIN
cvm/stage.bin
Binary file not shown.
@ -165,7 +165,7 @@ SYSVARS FUTURE USES +3c BLK(*
|
|||||||
+02 CURRENT +3e ~C!*
|
+02 CURRENT +3e ~C!*
|
||||||
+04 HERE +41 ~C!ERR
|
+04 HERE +41 ~C!ERR
|
||||||
+06 C<? +42 FUTURE USES
|
+06 C<? +42 FUTURE USES
|
||||||
+08 C<* override +50 NL> character
|
+08 FUTURE USES +50 NL> character
|
||||||
+0a FUTURE USES +51 CURRENTPTR
|
+0a FUTURE USES +51 CURRENTPTR
|
||||||
+0c C<* +53 EMIT ialias
|
+0c C<* +53 EMIT ialias
|
||||||
+0e WORDBUF +55 KEY? ialias
|
+0e WORDBUF +55 KEY? ialias
|
||||||
|
Loading…
Reference in New Issue
Block a user