izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Pack core words blks a bit tighter

Browse Source 
With all this recent movements, we had a bit of a fragmentation
issue.
This commit is contained in:
Virgil Dupras 2020-05-02 21:47:32 -04:00
parent 3373f53997
commit f023f9bcb4
32 changed files with 223 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
blk/420
View File

@ -8,7 +8,6 @@ a full intepreter, which can then be relinked with the
Relinker. There is no loader for these libraries because you
will typically XPACK (B267) them.
422 core 438 cmp
442 print 446 parse
453 readln 459 fmt
464 blk
422 core 438 print
442 fmt 447 readln
453 blk

13
blk/438 Normal file
View File

@ -0,0 +1,13 @@
: EMIT
( 0x53==(emit) override )
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null )
DUP NOT IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;

16
blk/439 Normal file
View File

@ -0,0 +1,16 @@
: ,"
BEGIN
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
AGAIN ;
: ."
34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: (uflw) ABORT" stack underflow" ;

9
blk/440 Normal file
View File

@ -0,0 +1,9 @@
: BS 8 EMIT ;
: LF 10 EMIT ;
: CR 13 EMIT ;
: CRLF CR LF ;
: SPC 32 EMIT ;
: (wnf) (print) SPC ABORT" word not found" ;
: (ok) SPC ." ok" CRLF ;

27
blk/442
View File

@ -1,13 +1,16 @@
: EMIT
( 0x53==(emit) override )
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: (print)
: _
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
C@+ ( a+1 c )
( exit if null )
DUP NOT IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;
DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
SWAP '0' + SWAP ( d q )
AGAIN ;
: . ( n -- )
( handle negative )
DUP 0< IF '-' EMIT -1 * THEN
_
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator )
EMIT
AGAIN ;

32
blk/443
View File

@ -1,16 +1,16 @@
: ,"
BEGIN
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
AGAIN ;
: ."
34 , ( 34 == litWord ) ," 0 C,
COMPILE (print)
; IMMEDIATE
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: (uflw) ABORT" stack underflow" ;
: ? @ . ;
: _
DUP 9 > IF 10 - 'a' +
ELSE '0' + THEN
;
( For hex display, there are no negatives )
: .x
256 MOD ( ensure < 0x100 )
16 /MOD ( l h )
_ EMIT ( l )
_ EMIT
;
: .X
256 /MOD ( l h )
.x .x
;

25
blk/444
View File

@ -1,9 +1,16 @@
: BS 8 EMIT ;
: LF 10 EMIT ;
: CR 13 EMIT ;
: CRLF CR LF ;
: SPC 32 EMIT ;
: (wnf) (print) SPC ABORT" word not found" ;
: (ok) SPC ." ok" CRLF ;
: _ ( a -- a+8 )
DUP ( save for 2nd loop )
':' EMIT DUP .x SPC
4 0 DO
DUP @ 256 /MOD SWAP
.x .x SPC 2+
LOOP
DROP
8 0 DO
C@+
DUP 0x20 < OVER 0x7e > OR
IF DROP '.' THEN
EMIT
LOOP
CRLF
;

0
blk/462 → blk/445
View File

13
blk/447 Normal file
View File

@ -0,0 +1,13 @@
64 CONSTANT INBUFSZ
: RDLNMEM+ 0x57 RAM+ @ + ;
( current position in INBUF )
: IN> 0 RDLNMEM+ ;
( points to INBUF )
: IN( 2 RDLNMEM+ ;
( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )
: (infl) 0 IN( DUP IN> ! ! ;

16
blk/448 Normal file
View File

@ -0,0 +1,16 @@
( handle backspace: go back one char in IN>, if possible, then
emit SPC + BS )
: (inbs)
( already at IN( ? )
IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> !
SPC BS
;
: KEY
85 RAM+ @ ( (key) override )
DUP IF EXECUTE ELSE DROP (key) THEN ;
( cont.: read one char into input buffer and returns whether we
should continue, that is, whether CR was not met. )

16
blk/449 Normal file
View File

@ -0,0 +1,16 @@
: (rdlnc) ( -- f )
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
( echo back )
DUP EMIT ( c )
( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN
( write and advance )
DUP ( keep as result ) ( c c )
( We take advantage of the fact that c's MSB is always zero and
thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ;

16
blk/450 Normal file
View File

@ -0,0 +1,16 @@
( Read one line in input buffer and make IN> point to it )
: (rdln)
(infl) BEGIN (rdlnc) NOT UNTIL
LF IN( IN> ! ;
( And finally, implement C<* )
: RDLN<
IN> @ C@
DUP IF ( not EOL? good, inc and return )
1 IN> +!
ELSE ( EOL ? readline. we still return null though )
(rdln)
THEN
( update C<? flag )
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
;

12
blk/451 Normal file
View File

@ -0,0 +1,12 @@
( Initializes the readln subsystem )
: RDLN$
( 57 == rdln's memory )
H@ 0x57 RAM+ !
( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. )
INBUFSZ 4 + ALLOT
(infl)
['] RDLN< 0x0c RAM+ !
1 0x06 RAM+ ! ( 06 == C<? )
;

22
blk/453
View File

@ -1,13 +1,13 @@
64 CONSTANT INBUFSZ
: RDLNMEM+ 0x57 RAM+ @ + ;
( current position in INBUF )
: IN> 0 RDLNMEM+ ;
( points to INBUF )
: IN( 2 RDLNMEM+ ;
( points to INBUF's end )
: IN) INBUFSZ 2+ RDLNMEM+ ;
: BLKMEM+ 0x59 RAM+ @ + ;
( n -- Fetches block n and write it to BLK( )
: BLK@* 0 BLKMEM+ ;
( n -- Write back BLK( to storage at block n )
: BLK!* 2 BLKMEM+ ;
( Current blk pointer in ( )
: BLK> 4 BLKMEM+ ;
( Whether buffer is dirty )
: BLKDTY 6 BLKMEM+ ;
: BLK( 8 BLKMEM+ ;
: BLK) BLK( 1024 + ;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )
: (infl) 0 IN( DUP IN> ! ! ;

22
blk/454
View File

@ -1,16 +1,12 @@
( handle backspace: go back one char in IN>, if possible, then
emit SPC + BS )
: (inbs)
( already at IN( ? )
IN> @ IN( = IF EXIT THEN
IN> @ 1- IN> !
SPC BS
: BLK$
H@ 0x59 RAM+ !
( 1024 for the block, 8 for variables )
1032 ALLOT
( LOAD detects end of block with ASCII EOT. This is why
we write it there. EOT == 0x04 )
4 C,
0 BLKDTY !
-1 BLK> !
;
: KEY
85 RAM+ @ ( (key) override )
DUP IF EXECUTE ELSE DROP (key) THEN ;
( cont.: read one char into input buffer and returns whether we
should continue, that is, whether CR was not met. )

29
blk/455
View File

@ -1,16 +1,13 @@
: (rdlnc) ( -- f )
( buffer overflow? same as if we typed a newline )
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
( echo back )
DUP EMIT ( c )
( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN
( write and advance )
DUP ( keep as result ) ( c c )
( We take advantage of the fact that c's MSB is always zero and
thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ;
: BLK! ( -- )
BLK> @ BLK!* @ EXECUTE
0 BLKDTY !
;
: FLUSH BLKDTY @ IF BLK! THEN ;
: BLK@ ( n -- )
FLUSH
DUP BLK> @ = IF DROP EXIT THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: BLK!! 1 BLKDTY ! ;

23
blk/456
View File

@ -1,16 +1,11 @@
( Read one line in input buffer and make IN> point to it )
: (rdln)
(infl) BEGIN (rdlnc) NOT UNTIL
LF IN( IN> ! ;
: .2 DUP 10 < IF SPC THEN . ;
( And finally, implement C<* )
: RDLN<
IN> @ C@
DUP IF ( not EOL? good, inc and return )
1 IN> +!
ELSE ( EOL ? readline. we still return null though )
(rdln)
THEN
( update C<? flag )
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
: LIST
BLK@
16 0 DO
I 1+ .2 SPC
64 I * BLK( + (print)
CRLF
LOOP
;

24
blk/457
View File

@ -1,12 +1,16 @@
( Initializes the readln subsystem )
: RDLN$
( 57 == rdln's memory )
H@ 0x57 RAM+ !
( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
the last typed 0x0a and one for the following NULL. )
INBUFSZ 4 + ALLOT
(infl)
['] RDLN< 0x0c RAM+ !
1 0x06 RAM+ ! ( 06 == C<? )
: _
(boot<)
DUP 4 = IF
( We drop our char, but also "a" from WORD: it won't
have the opportunity to balance PSP because we're
EXIT!ing. )
2DROP
( We're finished interpreting )
EXIT!
THEN
;
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
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. )

0
blk/469 → blk/458
View File

18
blk/459
View File

@ -1,16 +1,2 @@
: _
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
SWAP '0' + SWAP ( d q )
AGAIN ;
: . ( n -- )
( handle negative )
DUP 0< IF '-' EMIT -1 * THEN
_
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator )
EMIT
AGAIN ;
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

16
blk/460
View File

@ -1,16 +0,0 @@
: ? @ . ;
: _
DUP 9 > IF 10 - 'a' +
ELSE '0' + THEN
;
( For hex display, there are no negatives )
: .x
256 MOD ( ensure < 0x100 )
16 /MOD ( l h )
_ EMIT ( l )
_ EMIT
;
: .X
256 /MOD ( l h )
.x .x
;

16
blk/461
View File

@ -1,16 +0,0 @@
: _ ( a -- a+8 )
DUP ( save for 2nd loop )
':' EMIT DUP .x SPC
4 0 DO
DUP @ 256 /MOD SWAP
.x .x SPC 2+
LOOP
DROP
8 0 DO
C@+
DUP 0x20 < OVER 0x7e > OR
IF DROP '.' THEN
EMIT
LOOP
CRLF
;

13
blk/464
View File

@ -1,13 +0,0 @@
: BLKMEM+ 0x59 RAM+ @ + ;
( n -- Fetches block n and write it to BLK( )
: BLK@* 0 BLKMEM+ ;
( n -- Write back BLK( to storage at block n )
: BLK!* 2 BLKMEM+ ;
( Current blk pointer in ( )
: BLK> 4 BLKMEM+ ;
( Whether buffer is dirty )
: BLKDTY 6 BLKMEM+ ;
: BLK( 8 BLKMEM+ ;
: BLK) BLK( 1024 + ;

12
blk/465
View File

@ -1,12 +0,0 @@
: BLK$
H@ 0x59 RAM+ !
( 1024 for the block, 8 for variables )
1032 ALLOT
( LOAD detects end of block with ASCII EOT. This is why
we write it there. EOT == 0x04 )
4 C,
0 BLKDTY !
-1 BLK> !
;

13
blk/466
View File

@ -1,13 +0,0 @@
: BLK! ( -- )
BLK> @ BLK!* @ EXECUTE
0 BLKDTY !
;
: FLUSH BLKDTY @ IF BLK! THEN ;
: BLK@ ( n -- )
FLUSH
DUP BLK> @ = IF DROP EXIT THEN
DUP BLK> ! BLK@* @ EXECUTE
;
: BLK!! 1 BLKDTY ! ;

11
blk/467
View File

@ -1,11 +0,0 @@
: .2 DUP 10 < IF SPC THEN . ;
: LIST
BLK@
16 0 DO
I 1+ .2 SPC
64 I * BLK( + (print)
CRLF
LOOP
;

16
blk/468
View File

@ -1,16 +0,0 @@
: _
(boot<)
DUP 4 = IF
( We drop our char, but also "a" from WORD: it won't
have the opportunity to balance PSP because we're
EXIT!ing. )
2DROP
( We're finished interpreting )
EXIT!
THEN
;
( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
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. )

2
blk/470
View File

@ -1,2 +0,0 @@
( b1 b2 -- )
: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

BIN
emul/forth.bin
View File

Binary file not shown.

2
emul/xcomp.fs
View File

@ -17,6 +17,6 @@ H@ 256 /MOD 2 PC! 2 PC!
PC ORG @ 8 + !
," CURRENT @ HERE ! "
," : (emit) 0 PC! ; : (key) 0 PC@ ; "
422 470 XPACKR
422 459 XPACKR
," ' (key) 12 RAM+ ! "
H@ 256 /MOD 2 PC! 2 PC!

6
recipes/rc2014/xcomp.fs
View File

@ -23,11 +23,9 @@ H@ 256 /MOD 2 PC! 2 PC!
(entry) _
( Update LATEST )
PC ORG @ 8 + !
422 441 XPACKR ( core )
446 452 XPACKR ( parse )
422 437 XPACKR ( core )
358 360 XPACKR ( acia.fs )
442 445 XPACKR ( print )
453 463 XPACKR ( readln fmt )
438 452 XPACKR ( print fmt readln )
123 132 XPACKR ( linker )
," : _ ACIA$ RDLN$ (ok) ; _ "
H@ 256 /MOD 2 PC! 2 PC!

2
recipes/trs80/xcomp.fs
View File

@ -18,7 +18,7 @@ H@ 256 /MOD 2 PC! 2 PC!
( Update LATEST )
PC ORG @ 8 + !
," CURRENT @ HERE ! "
422 470 XPACKR ( core cmp print parse readln fmt blk )
422 459 XPACKR ( core print readln fmt blk )
499 500 XPACKR ( trs80.fs )
," : _ BLK$ FD$ (ok) RDLN$ ; _ "
H@ 256 /MOD 2 PC! 2 PC!