mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 16:08:06 +11:00
Small optimization and block compaction
This commit is contained in:
parent
7dff93f2ff
commit
495537b7f3
40
blk.fs
40
blk.fs
@ -1686,7 +1686,7 @@ with "390 LOAD"
|
|||||||
: IN$ 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
: IN$ 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
||||||
: C<* 0x0c RAM+ ;
|
: C<* 0x0c RAM+ ;
|
||||||
: QUIT (resRS) 0 C<* ! IN$ LIT" (main)" FIND DROP EXECUTE ;
|
: QUIT (resRS) 0 C<* ! IN$ LIT" (main)" FIND DROP EXECUTE ;
|
||||||
1 28 LOADR+
|
1 25 LOADR+
|
||||||
( ----- 354 )
|
( ----- 354 )
|
||||||
: ABORT (resSP) QUIT ;
|
: ABORT (resSP) QUIT ;
|
||||||
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
: = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ;
|
||||||
@ -1901,15 +1901,13 @@ SYSVARS 0x55 + :** KEY?
|
|||||||
( HERE points to where we should write R> )
|
( HERE points to where we should write R> )
|
||||||
R> ,
|
R> ,
|
||||||
( We're done. Because we've popped RS, we'll exit parent
|
( We're done. Because we've popped RS, we'll exit parent
|
||||||
definition )
|
definition ) ;
|
||||||
;
|
|
||||||
: CONSTANT CREATE , DOES> @ ;
|
: CONSTANT CREATE , DOES> @ ;
|
||||||
( ----- 371 )
|
|
||||||
: [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] ;
|
||||||
( ----- 372 )
|
( ----- 371 )
|
||||||
( n -- Fetches block n and write it to BLK( )
|
( n -- Fetches block n and write it to BLK( )
|
||||||
SYSVARS 0x34 + :** BLK@*
|
SYSVARS 0x34 + :** BLK@*
|
||||||
( n -- Write back BLK( to storage at block n )
|
( n -- Write back BLK( to storage at block n )
|
||||||
@ -1920,17 +1918,13 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
: BLKDTY 0x3a RAM+ ;
|
: BLKDTY 0x3a RAM+ ;
|
||||||
: BLK( 0x3c RAM+ @ ;
|
: BLK( 0x3c RAM+ @ ;
|
||||||
: BLK) BLK( 1024 + ;
|
: BLK) BLK( 1024 + ;
|
||||||
( ----- 373 )
|
|
||||||
: BLK$
|
: BLK$
|
||||||
H@ 0x3c ( BLK(* ) RAM+ !
|
H@ 0x3c ( BLK(* ) RAM+ !
|
||||||
1024 ALLOT
|
1024 ALLOT
|
||||||
( LOAD detects end of block with ASCII EOT. This is why
|
( LOAD detects end of block with ASCII EOT. This is why
|
||||||
we write it there. )
|
we write it there. )
|
||||||
EOT,
|
EOT, 0 BLKDTY ! -1 BLK> ! ;
|
||||||
0 BLKDTY !
|
( ----- 372 )
|
||||||
-1 BLK> !
|
|
||||||
;
|
|
||||||
( ----- 374 )
|
|
||||||
: BLK! ( -- ) BLK> @ BLK!* 0 BLKDTY ! ;
|
: BLK! ( -- ) BLK> @ BLK!* 0 BLKDTY ! ;
|
||||||
: FLUSH BLKDTY @ IF BLK! THEN -1 BLK> ! ;
|
: FLUSH BLKDTY @ IF BLK! THEN -1 BLK> ! ;
|
||||||
: BLK@ ( n -- )
|
: BLK@ ( n -- )
|
||||||
@ -1943,7 +1937,7 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
||||||
: COPY ( src dst -- )
|
: COPY ( src dst -- )
|
||||||
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
||||||
( ----- 375 )
|
( ----- 373 )
|
||||||
: . ( n -- )
|
: . ( n -- )
|
||||||
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
||||||
( handle negative )
|
( handle negative )
|
||||||
@ -1954,7 +1948,7 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
SWAP '0' + SWAP ( d q )
|
SWAP '0' + SWAP ( d q )
|
||||||
?DUP NOT UNTIL
|
?DUP NOT UNTIL
|
||||||
BEGIN EMIT DUP '9' > UNTIL DROP ( drop stop ) ;
|
BEGIN EMIT DUP '9' > UNTIL DROP ( drop stop ) ;
|
||||||
( ----- 376 )
|
( ----- 374 )
|
||||||
: ? @ . ;
|
: ? @ . ;
|
||||||
: _
|
: _
|
||||||
DUP 9 > IF 10 - 'a' +
|
DUP 9 > IF 10 - 'a' +
|
||||||
@ -1964,7 +1958,7 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
0xff AND 16 /MOD ( l h )
|
0xff AND 16 /MOD ( l h )
|
||||||
_ EMIT _ EMIT ;
|
_ EMIT _ EMIT ;
|
||||||
: .X |M .x .x ;
|
: .X |M .x .x ;
|
||||||
( ----- 377 )
|
( ----- 375 )
|
||||||
: _ ( a -- a+8 )
|
: _ ( a -- a+8 )
|
||||||
DUP ( a a )
|
DUP ( a a )
|
||||||
':' EMIT DUP .x SPC>
|
':' EMIT DUP .x SPC>
|
||||||
@ -1976,7 +1970,7 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
: DUMP ( n a -- )
|
: DUMP ( n a -- )
|
||||||
SWAP 8 /MOD SWAP IF 1+ THEN
|
SWAP 8 /MOD SWAP IF 1+ THEN
|
||||||
0 DO _ LOOP ;
|
0 DO _ LOOP ;
|
||||||
( ----- 378 )
|
( ----- 376 )
|
||||||
: LIST
|
: LIST
|
||||||
BLK@
|
BLK@
|
||||||
16 0 DO
|
16 0 DO
|
||||||
@ -1986,7 +1980,7 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
LOOP
|
LOOP
|
||||||
NL>
|
NL>
|
||||||
LOOP ;
|
LOOP ;
|
||||||
( ----- 379 )
|
( ----- 377 )
|
||||||
: INTERPRET
|
: INTERPRET
|
||||||
BEGIN
|
BEGIN
|
||||||
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
|
||||||
@ -1995,23 +1989,19 @@ SYSVARS 0x36 + :** BLK!*
|
|||||||
AGAIN ;
|
AGAIN ;
|
||||||
( Read from BOOT C< PTR and inc it. )
|
( Read from BOOT C< PTR and inc it. )
|
||||||
: (boot<)
|
: (boot<)
|
||||||
( 2e == BOOT C< PTR )
|
0x2e ( BOOT C< PTR ) RAM+ @ C@+ ( a+1 c )
|
||||||
0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
|
SWAP 0x2e RAM+ ! ( c ) ;
|
||||||
SWAP 1 + 0x2e RAM+ ! ( c ) ;
|
( ----- 378 )
|
||||||
( ----- 380 )
|
|
||||||
: LOAD
|
: LOAD
|
||||||
BLK> @ >R ( save restorable variables to RSP )
|
BLK> @ >R ( save restorable variables to RSP )
|
||||||
C<* @ >R
|
C<* @ >R
|
||||||
0x06 RAM+ @ >R ( C<? )
|
0x06 RAM+ ( C<? ) @ >R 0x2e RAM+ ( boot ptr ) @ >R
|
||||||
0x2e RAM+ @ >R ( boot ptr )
|
BLK@ BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
||||||
BLK@
|
|
||||||
BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
|
|
||||||
['] (boot<) 0x0c 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+ !
|
||||||
R> C<* ! R> BLK@ ;
|
R> C<* ! R> BLK@ ;
|
||||||
( ----- 381 )
|
|
||||||
: 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 ;
|
||||||
|
BIN
cvm/stage.bin
BIN
cvm/stage.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user