Small optimization and block compaction

This commit is contained in:
Virgil Dupras 2021-01-02 16:20:38 -05:00
parent 7dff93f2ff
commit 495537b7f3
2 changed files with 15 additions and 25 deletions

40
blk.fs
View File

@ -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 ;

Binary file not shown.