1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 08:30:55 +11:00

Compare commits

...

5 Commits

Author SHA1 Message Date
Virgil Dupras
f023f9bcb4 Pack core words blks a bit tighter
With all this recent movements, we had a bit of a fragmentation
issue.
2020-05-02 21:47:32 -04:00
Virgil Dupras
3373f53997 tidy up blk and fix tests 2020-05-02 21:25:35 -04:00
Virgil Dupras
3d908cef3a Move all parsing words to Inner core
This allows us to get rid of the (parse*) indirection.
2020-05-02 21:21:47 -04:00
Virgil Dupras
8009270e79 Optimize parsing words 2020-05-02 20:32:20 -04:00
Virgil Dupras
931c812394 Remove cmp
Not worth the complexity and space.
2020-05-02 19:57:56 -04:00
66 changed files with 419 additions and 510 deletions

View File

@ -8,8 +8,8 @@ reference.
Contents Contents
4 DOES> 6 Compilation vs meta-comp. 4 DOES> 6 Compilation vs meta-comp.
8 I/O 11 Chained comparisons 8 I/O 14 Addressed devices
14 Addressed devices 18 Signed-ness 18 Signed-ness

16
blk/011
View File

@ -1,16 +0,0 @@
Chained comparisons
The unit "cmp.fs" contains words to facilitate chained
comparisons with a single reference number. This allows, for
example, to easily express "a == b or a == c" or "a > b and a <
c".
The way those chained comparison words work is that, unlike
single comparison operators, they don't have a "n1 n2 -- f"
signature, but rather a "n1 f n2 -- n1 f" signature. That is,
each operator "carries over" the reference number in addition
to the latest flag.
(cont.)

16
blk/012
View File

@ -1,16 +0,0 @@
(cont.) You open a chain with "<>{" and you close a chain with
"<>}". Then, in between those words, you can chain operators.
For example, to check whether A == B or A == C, you would
write:
A <>{ B &= C |= <>}
The first operator must be of the "&" type because the chain
starts with its flag to true. For example, "<>{ <>}" yields
true.
To check whether A is in between B and C inclusively, you would
write:
A <>{ B 1 - &> C 1 + &< <>}

View File

@ -4,8 +4,6 @@ I/O
result in n as well as whether parsing was a result in n as well as whether parsing was a
success in f (false = failure, true = success in f (false = failure, true =
success) success)
(parse*) -- a Variable holding the current pointer for
system number parsing. By default, (parse).
(print) a -- Print string at addr a. (print) a -- Print string at addr a.
. n -- Print n in its decimal form . n -- Print n in its decimal form
.x n -- Print n's LSB in hex form. Always 2 .x n -- Print n's LSB in hex form. Always 2
@ -13,4 +11,6 @@ I/O
.X n -- Print n in hex form. Always 4 characters. .X n -- Print n in hex form. Always 4 characters.
Numbers are never considered negative. Numbers are never considered negative.
"-1 .X" --> ffff "-1 .X" --> ffff
(cont.) (cont.)

View File

@ -4,7 +4,7 @@ RAMSTART INITIAL_SP +55 (key) override
+04 HERE +59 blk's variables +04 HERE +59 blk's variables
+06 C<? +5b z80a's variables +06 C<? +5b z80a's variables
+08 C<* override +5d adev's variables +08 C<* override +5d adev's variables
+0a PARSEPTR +5f FUTURE USES +0a RESERVED +5f FUTURE USES
+0c C<* +70 DRIVERS +0c C<* +70 DRIVERS
+0e WORDBUF +80 RAMEND +0e WORDBUF +80 RAMEND
+2e BOOT C< PTR +2e BOOT C< PTR

View File

@ -10,7 +10,7 @@ very few things.
In a normal system, BOOT is in icore and does a few things: In a normal system, BOOT is in icore and does a few things:
1. Find "(parse)" and set "(parse*)" to it. 1. Find "(c<)" a set CINPTR to it (what C< calls).
2. Find "(c<)" a set CINPTR to it (what C< calls). 2. Initialize all overrides to 0.
3. Write LATEST in SYSTEM SCRATCHPAD ( see below ) 3. Write LATEST in BOOT C< PTR ( see below )
4. Find "INIT". If found, execute. Otherwise, "INTERPRET"(cont) 4. Find "INIT". If found, execute. Otherwise, "INTERPRET"(cont)

View File

@ -1,7 +1,7 @@
(cont.) On a bare system (only boot+icore), this sequence will On a bare system (only boot+icore), this sequence will result
result in "(parse)" reading only decimals and (c<) reading in (c<) reading characters from memory starting from CURRENT
characters from memory starting from CURRENT (this is why we (this is why we put CURRENT in BOOT C< PTR, it tracks current
put CURRENT in SYSTEM SCRATCHPAD, it tracks current pos ). pos ).
This means that you can put initialization code in source form This means that you can put initialization code in source form
right into your binary, right after your last compiled dict right into your binary, right after your last compiled dict

View File

@ -2,7 +2,7 @@
: ASKIP ( a -- a+n ) : ASKIP ( a -- a+n )
DUP @ ( a n ) DUP @ ( a n )
( ?br or br or NUMBER ) ( ?br or br or NUMBER )
DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>} DUP 0x67 = OVER 0x53 = OR OVER 0x20 = OR OVER 0x24 = OR
IF DROP 4 + EXIT THEN IF DROP 4 + EXIT THEN
( regular word ) ( regular word )
0x22 = NOT IF 2+ EXIT THEN 0x22 = NOT IF 2+ EXIT THEN

View File

@ -1,7 +1,7 @@
: RLWORD ( ol o a1 a2 -- ) : RLWORD ( ol o a1 a2 -- )
SWAP DUP C@ ( ol o a2 a1 n ) SWAP DUP C@ ( ol o a2 a1 n )
DUP <>{ 0x0e &= 0x2b |= <>} NOT IF ( unwind all args ) DUP 0x0e = OVER 0x2b = OR NOT IF
2DROP 2DROP EXIT THEN ( unwind all args ) 2DROP 2DROP EXIT THEN
0x2b = IF 2+ THEN ( ol o a2 a1 ) 0x2b = IF 2+ THEN ( ol o a2 a1 )
1+ ( ol o a2 a1+1 ) 1+ ( ol o a2 a1+1 )
BEGIN ( ol o a2 a1 ) BEGIN ( ol o a2 a1 )

View File

@ -8,7 +8,7 @@
ELSE ( w ) ELSE ( w )
0x02 RAM+ @ SWAP ( cur w ) _find ( a f ) 0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
IF DUP IMMED? NOT IF ABORT THEN EXECUTE IF DUP IMMED? NOT IF ABORT THEN EXECUTE
ELSE (parse*) @ EXECUTE LITN THEN ELSE (parse) LITN THEN
THEN THEN
AGAIN AGAIN
; ;

View File

View File

View File

@ -1,6 +1,5 @@
: RAM+ [ RAMSTART LITN ] + ; : RAM+ [ RAMSTART LITN ] + ;
: BIN+ [ BIN( @ LITN ] + ; : BIN+ [ BIN( @ LITN ] + ;
: (parse*) 0x0a RAM+ ;
: HERE 0x04 RAM+ ; : HERE 0x04 RAM+ ;
: CURRENT* 0x51 RAM+ ; : CURRENT* 0x51 RAM+ ;
: CURRENT CURRENT* @ ; : CURRENT CURRENT* @ ;
@ -13,4 +12,4 @@
0 0x08 RAM+ ! ( 08 == C<* override ) 0 0x08 RAM+ ! ( 08 == C<* override )
LIT< INTERPRET (find) DROP EXECUTE LIT< INTERPRET (find) DROP EXECUTE
; ;
394 407 LOADR 394 413 LOADR

View File

@ -4,5 +4,11 @@
: < CMP -1 = ; : < CMP -1 = ;
: > CMP 1 = ; : > CMP 1 = ;
: 0< 32767 > ; : 0< 32767 > ;
: >= < NOT ;
: <= > NOT ;
: 0>= 0< NOT ;
( a -- a+1 c )
: C@+ DUP C@ SWAP 1+ SWAP ;
( c a -- a+1 )
: C!+ SWAP OVER C! 1+ ;

21
blk/398
View File

@ -1,16 +1,11 @@
( This is only the "early parser" in earlier stages. No need ( strings being sent to parse routines are always null
for an abort message ) terminated )
: (parse) (parsed) NOT IF ABORT THEN ;
: C<? 0x06 RAM+ @ ; : (parsec) ( a -- n f )
: C< ( apostrophe is ASCII 39 )
0x08 RAM+ @ ( 08 == C<* override ) DUP C@ 39 = OVER 2+ C@ 39 = AND ( a f )
DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* ) NOT IF 0 EXIT THEN ( a 0 )
EXECUTE ( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
; ;
: , HERE @ ! HERE @ 2+ HERE ! ;
: C, HERE @ C! HERE @ 1+ HERE ! ;

20
blk/399
View File

@ -1,12 +1,14 @@
( The NOT is to normalize the negative/positive numbers to 1 ( returns negative value on error )
or 0. Hadn't we wanted to normalize, we'd have written: : _ ( c -- n )
32 CMP 1 - ) ( '0' is ASCII 48 )
: WS? 33 CMP 1+ NOT ; 48 -
DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN
: TOWORD ( 'a' is ASCII 97. 59 = 97 - 48 )
BEGIN 49 -
C< DUP WS? NOT IF EXIT THEN DROP DUP 0< IF EXIT THEN ( bad )
AGAIN DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
; ;

29
blk/400
View File

@ -1,16 +1,15 @@
( Read word from C<, copy to WORDBUF, null-terminate, and : (parseh) ( a -- n f )
return, make HL point to WORDBUF. ) ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
: WORD DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
0x0e RAM+ ( 0e == WORDBUF ) ( We have "0x" prefix )
TOWORD ( a c ) 2+
0 ( a r )
BEGIN BEGIN
( We take advantage of the fact that char MSB is SWAP C@+ ( r a+1 c )
always zero to pre-write our null-termination ) DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
OVER ! 1+ ( a+1 ) _ ( r a n )
C< ( a c ) DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
DUP WS? ROT 16 * + ( a r*16+n )
UNTIL AGAIN
( a this point, PS is: a WS ) ;
( null-termination is already written )
2DROP
0x0e RAM+ ;

14
blk/401
View File

@ -1,10 +1,10 @@
: SCPY ( returns negative value on error )
BEGIN ( a ) : _ ( c -- n )
DUP C@ ( a c ) ( '0' is ASCII 48 )
DUP C, ( a c ) 48 -
NOT IF DROP EXIT THEN DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN
1+ ( a+1 ) ( bad )
AGAIN 255 -
; ;

27
blk/402
View File

@ -1,15 +1,16 @@
: [entry] : (parseb) ( a -- n f )
HERE @ ( w h ) ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
SWAP SCPY ( h ) DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 )
( Adjust HERE -1 because SCPY copies the null ) ( We have "0b" prefix )
HERE @ 1- ( h h' ) 2+
DUP HERE ! ( h h' ) 0 ( a r )
SWAP - ( sz ) BEGIN
( write prev value ) SWAP C@+ ( r a+1 c )
HERE @ CURRENT @ - , DUP NOT IF 2DROP 1 EXIT THEN ( r 1 )
( write size ) _ ( r a n )
C, DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
HERE @ CURRENT ! ROT 2 * + ( a r*2+n )
AGAIN
; ;
: (entry) WORD [entry] ;

15
blk/403
View File

@ -1,9 +1,8 @@
: INTERPRET : (parse) ( a -- n )
BEGIN (parsec) IF EXIT THEN
WORD (parseh) IF EXIT THEN
(find) (parseb) IF EXIT THEN
NOT IF (parse*) @ THEN EXECUTE (parsed) IF EXIT THEN
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN ( nothing works )
AGAIN LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
; ;

17
blk/404
View File

@ -1,11 +1,12 @@
( system c< simply reads source from binary, starting at : C<? 0x06 RAM+ @ ;
LATEST. Convenient way to bootstrap a new system. ) : C<
: (boot<) 0x08 RAM+ @ ( 08 == C<* override )
( 2e == BOOT C< PTR ) DUP NOT IF DROP 0x0c RAM+ @ THEN ( 0c == C<* )
0x2e RAM+ @ ( a ) EXECUTE
DUP C@ ( a c )
SWAP 1 + ( c a+1 )
0x2e RAM+ ! ( c )
; ;
: , HERE @ ! HERE @ 2+ HERE ! ;
: C, HERE @ C! HERE @ 1+ HERE ! ;

23
blk/405
View File

@ -1,15 +1,12 @@
: BOOT ( The NOT is to normalize the negative/positive numbers to 1
0x02 RAM+ CURRENT* ! or 0. Hadn't we wanted to normalize, we'd have written:
LIT< (parse) (find) DROP (parse*) ! 32 CMP 1 - )
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR ) : WS? 33 CMP 1+ NOT ;
0 0x08 RAM+ ! ( 08 == C<* override )
0 0x53 RAM+ ! ( 53 == (emit) override ) : TOWORD
0 0x55 RAM+ ! ( 55 == (key) override ) BEGIN
( 0c == C<* ) C< DUP WS? NOT IF EXIT THEN DROP
LIT< (boot<) (find) DROP 0x0c RAM+ ! AGAIN
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ !
LIT< INIT (find)
IF EXECUTE ELSE DROP INTERPRET THEN
; ;

30
blk/406
View File

@ -1,14 +1,16 @@
( LITN has to be defined after the last immediate usage of ( Read word from C<, copy to WORDBUF, null-terminate, and
it to avoid bootstrapping issues ) return, make HL point to WORDBUF. )
: LITN 32 , , ( 32 == NUMBER ) ; : WORD
0x0e RAM+ ( 0e == WORDBUF )
: IMMED? 1- C@ 0x80 AND ; TOWORD ( a c )
BEGIN
( ';' can't have its name right away because, when created, it ( We take advantage of the fact that char MSB is
is not an IMMEDIATE yet and will not be treated properly by always zero to pre-write our null-termination )
xcomp. ) OVER ! 1+ ( a+1 )
: _ C< ( a c )
['] EXIT , DUP WS?
R> DROP ( exit : ) UNTIL
; IMMEDIATE ( a this point, PS is: a WS )
( null-termination is already written )
2DROP
0x0e RAM+ ;

26
blk/407
View File

@ -1,16 +1,10 @@
XCURRENT @ ( to PSP ) : SCPY
: : BEGIN ( a )
(entry) DUP C@ ( a c )
( We cannot use LITN as IMMEDIATE because of bootstrapping DUP C, ( a c )
issues. Same thing for ",". NOT IF DROP EXIT THEN
32 == NUMBER 14 == compiledWord ) 1+ ( a+1 )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C, AGAIN
BEGIN ;
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse*) @ EXECUTE LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!

15
blk/408 Normal file
View File

@ -0,0 +1,15 @@
: [entry]
HERE @ ( w h )
SWAP SCPY ( h )
( Adjust HERE -1 because SCPY copies the null )
HERE @ 1- ( h h' )
DUP HERE ! ( h h' )
SWAP - ( sz )
( write prev value )
HERE @ CURRENT @ - ,
( write size )
C,
HERE @ CURRENT !
;
: (entry) WORD [entry] ;

9
blk/409 Normal file
View File

@ -0,0 +1,9 @@
: INTERPRET
BEGIN
WORD
(find)
NOT IF (parse) ELSE EXECUTE THEN
C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
AGAIN
;

11
blk/410 Normal file
View File

@ -0,0 +1,11 @@
( system c< simply reads source from binary, starting at
LATEST. Convenient way to bootstrap a new system. )
: (boot<)
( 2e == BOOT C< PTR )
0x2e RAM+ @ ( a )
DUP C@ ( a c )
SWAP 1 + ( c a+1 )
0x2e RAM+ ! ( c )
;

14
blk/411 Normal file
View File

@ -0,0 +1,14 @@
: BOOT
0x02 RAM+ CURRENT* !
CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
0 0x08 RAM+ ! ( 08 == C<* override )
0 0x53 RAM+ ! ( 53 == (emit) override )
0 0x55 RAM+ ! ( 55 == (key) override )
( 0c == C<* )
LIT< (boot<) (find) DROP 0x0c RAM+ !
( boot< always has a char waiting. 06 == C<?* )
1 0x06 RAM+ !
LIT< INIT (find)
IF EXECUTE ELSE DROP INTERPRET THEN
;

14
blk/412 Normal file
View File

@ -0,0 +1,14 @@
( LITN has to be defined after the last immediate usage of
it to avoid bootstrapping issues )
: LITN 32 , , ( 32 == NUMBER ) ;
: IMMED? 1- C@ 0x80 AND ;
( ';' can't have its name right away because, when created, it
is not an IMMEDIATE yet and will not be treated properly by
xcomp. )
: _
['] EXIT ,
R> DROP ( exit : )
; IMMEDIATE

16
blk/413 Normal file
View File

@ -0,0 +1,16 @@
XCURRENT @ ( to PSP )
: :
(entry)
( We cannot use LITN as IMMEDIATE because of bootstrapping
issues. Same thing for ",".
32 == NUMBER 14 == compiledWord )
[ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
BEGIN
WORD
(find)
( is word )
IF DUP IMMED? IF EXECUTE ELSE , THEN
( maybe number )
ELSE (parse) LITN THEN
AGAIN ;
( from PSP ) ';' SWAP 4 - C!

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 Relinker. There is no loader for these libraries because you
will typically XPACK (B267) them. will typically XPACK (B267) them.
422 core 438 cmp 422 core 438 print
442 print 446 parse 442 fmt 447 readln
453 readln 459 fmt 453 blk
464 blk

View File

@ -8,7 +8,3 @@
DROP DROP
; ;
( a -- a+1 c )
: C@+ DUP C@ SWAP 1+ SWAP ;
( c a -- a+1 )
: C!+ SWAP OVER C! 1+ ;

22
blk/438
View File

@ -1,13 +1,13 @@
( Words useful for complex comparison operations ) : EMIT
( 0x53==(emit) override )
: >= < NOT ; 83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
: <= > NOT ;
: 0>= 0< NOT ;
( n1 -- n1 true )
: <>{ 1 ;
( n1 f -- f )
: <>} SWAP DROP ;
: (print)
BEGIN
C@+ ( a+1 c )
( exit if null )
DUP NOT IF 2DROP EXIT THEN
EMIT ( a )
AGAIN
;

25
blk/439
View File

@ -1,15 +1,16 @@
: ,"
BEGIN
C<
( 34 is ASCII for " )
DUP 34 = IF DROP EXIT THEN C,
AGAIN ;
: _|& : ."
( n1 n2 cell ) 34 , ( 34 == litWord ) ," 0 C,
>R >R DUP R> R> ( n1 n1 n2 cell ) COMPILE (print)
@ EXECUTE ( n1 f ) ; IMMEDIATE
;
( n1 f n2 -- n1 f ) : ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
: _|
CREATE , DOES> : (uflw) ABORT" stack underflow" ;
( n1 f n2 cell )
ROT IF 2DROP 1 EXIT THEN ( n1 true )
_|&
;

22
blk/440
View File

@ -1,15 +1,9 @@
: _& : BS 8 EMIT ;
CREATE , DOES> : LF 10 EMIT ;
( n1 f n2 cell ) : CR 13 EMIT ;
ROT NOT IF 2DROP 0 EXIT THEN ( n1 true ) : CRLF CR LF ;
_|& : SPC 32 EMIT ;
;
: (wnf) (print) SPC ABORT" word not found" ;
: (ok) SPC ." ok" CRLF ;
( All words below have this signature:
n1 f n2 -- n1 f )
' = _| |=
' = _& &=
' > _| |>
' > _& &>
' < _| |<
' < _& &<

27
blk/442
View File

@ -1,13 +1,16 @@
: EMIT : _
( 0x53==(emit) override ) 999 SWAP ( stop indicator )
83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ; DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
: (print)
BEGIN BEGIN
C@+ ( a+1 c ) DUP 0 = IF DROP EXIT THEN
( exit if null ) 10 /MOD ( r q )
DUP NOT IF 2DROP EXIT THEN SWAP '0' + SWAP ( d q )
EMIT ( a ) AGAIN ;
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< DUP 9 > IF 10 - 'a' +
( 34 is ASCII for " ) ELSE '0' + THEN
DUP 34 = IF DROP EXIT THEN C, ;
AGAIN ; ( For hex display, there are no negatives )
: .x
: ." 256 MOD ( ensure < 0x100 )
34 , ( 34 == litWord ) ," 0 C, 16 /MOD ( l h )
COMPILE (print) _ EMIT ( l )
; IMMEDIATE _ EMIT
;
: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE : .X
256 /MOD ( l h )
: (uflw) ABORT" stack underflow" ; .x .x
;

25
blk/444
View File

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

View File

11
blk/446
View File

@ -1,11 +0,0 @@
( strings being sent to parse routines are always null
terminated )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
DUP 2+ C@ 39 = NOT IF 0 EXIT THEN ( a 0 )
( surrounded by apos, good, return )
1+ C@ 1 ( n 1 )
;

24
blk/447
View File

@ -1,15 +1,13 @@
( returns negative value on error ) 64 CONSTANT INBUFSZ
: _ ( c -- n ) : RDLNMEM+ 0x57 RAM+ @ + ;
( '0' is ASCII 48 ) ( current position in INBUF )
48 - : IN> 0 RDLNMEM+ ;
DUP 0< IF EXIT THEN ( bad ) ( points to INBUF )
DUP 10 < IF EXIT THEN ( good ) : IN( 2 RDLNMEM+ ;
( 'a' is ASCII 97. 59 = 97 - 48 ) ( points to INBUF's end )
49 - : IN) INBUFSZ 2+ RDLNMEM+ ;
DUP 0< IF EXIT THEN ( bad )
DUP 6 < IF 10 + EXIT THEN ( good )
( bad )
255 -
;
( flush input buffer )
( set IN> to IN( and set IN> @ to null )
: (infl) 0 IN( DUP IN> ! ! ;

27
blk/448
View File

@ -1,15 +1,16 @@
: (parseh) ( a -- n f ) ( handle backspace: go back one char in IN>, if possible, then
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 ) emit SPC + BS )
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 ) : (inbs)
( We have "0x" prefix ) ( already at IN( ? )
2+ IN> @ IN( = IF EXIT THEN
0 ( a r ) IN> @ 1- IN> !
BEGIN SPC BS
SWAP C@+ ( r a+1 c )
DUP NOT IF 2DROP 1 EXIT THEN ( r, 1 )
_ ( r a n )
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 )
ROT 16 * + ( a r*16+n )
AGAIN
; ;
: 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. )

27
blk/449
View File

@ -1,11 +1,16 @@
( returns negative value on error ) : (rdlnc) ( -- f )
: _ ( c -- n ) ( buffer overflow? same as if we typed a newline )
( '0' is ASCII 48 ) IN> @ IN) = IF 0x0a ELSE KEY THEN ( c )
48 - DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
DUP 0< IF EXIT THEN ( bad ) DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
DUP 2 < IF EXIT THEN ( good ) ( echo back )
( bad ) DUP EMIT ( c )
255 - ( 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 ;

30
blk/450
View File

@ -1,16 +1,16 @@
: (parseb) ( a -- n f ) ( Read one line in input buffer and make IN> point to it )
( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 ) : (rdln)
DUP @ 25136 = NOT IF 0 EXIT THEN ( a 0 ) (infl) BEGIN (rdlnc) NOT UNTIL
( We have "0b" prefix ) LF IN( IN> ! ;
2+
0 ( a r ) ( And finally, implement C<* )
BEGIN : RDLN<
SWAP C@+ ( r a+1 c ) IN> @ C@
DUP NOT IF 2DROP 1 EXIT THEN ( r 1 ) DUP IF ( not EOL? good, inc and return )
_ ( r a n ) 1 IN> +!
DUP 0< IF ROT 2DROP 0 EXIT THEN ( a 0 ) ELSE ( EOL ? readline. we still return null though )
ROT 2 * + ( a r*2+n ) (rdln)
AGAIN THEN
( update C<? flag )
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
; ;

18
blk/451
View File

@ -1,10 +1,12 @@
: (parse) ( a -- n ) ( Initializes the readln subsystem )
(parsec) IF EXIT THEN : RDLN$
(parseh) IF EXIT THEN ( 57 == rdln's memory )
(parseb) IF EXIT THEN H@ 0x57 RAM+ !
(parsed) IF EXIT THEN ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
( nothing works ) the last typed 0x0a and one for the following NULL. )
LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN INBUFSZ 4 + ALLOT
(infl)
['] RDLN< 0x0c RAM+ !
1 0x06 RAM+ ! ( 06 == C<? )
; ;
' (parse) (parse*) !

22
blk/453
View File

@ -1,13 +1,13 @@
64 CONSTANT INBUFSZ : BLKMEM+ 0x59 RAM+ @ + ;
: RDLNMEM+ 0x57 RAM+ @ + ; ( n -- Fetches block n and write it to BLK( )
( current position in INBUF ) : BLK@* 0 BLKMEM+ ;
: IN> 0 RDLNMEM+ ; ( n -- Write back BLK( to storage at block n )
( points to INBUF ) : BLK!* 2 BLKMEM+ ;
: IN( 2 RDLNMEM+ ; ( Current blk pointer in ( )
( points to INBUF's end ) : BLK> 4 BLKMEM+ ;
: IN) INBUFSZ 2+ RDLNMEM+ ; ( 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 : BLK$
emit SPC + BS ) H@ 0x59 RAM+ !
: (inbs) ( 1024 for the block, 8 for variables )
( already at IN( ? ) 1032 ALLOT
IN> @ IN( = IF EXIT THEN ( LOAD detects end of block with ASCII EOT. This is why
IN> @ 1- IN> ! we write it there. EOT == 0x04 )
SPC BS 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 ) : BLK! ( -- )
( buffer overflow? same as if we typed a newline ) BLK> @ BLK!* @ EXECUTE
IN> @ IN) = IF 0x0a ELSE KEY THEN ( c ) 0 BLKDTY !
DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace ) ;
DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr ) : FLUSH BLKDTY @ IF BLK! THEN ;
( echo back ) : BLK@ ( n -- )
DUP EMIT ( c ) FLUSH
( bacspace? handle and exit ) DUP BLK> @ = IF DROP EXIT THEN
DUP 0x8 = IF (inbs) EXIT THEN DUP BLK> ! BLK@* @ EXECUTE
( write and advance ) ;
DUP ( keep as result ) ( c c )
( We take advantage of the fact that c's MSB is always zero and : BLK!! 1 BLKDTY ! ;
thus ! automatically null-terminates our string )
IN> @ ! 1 IN> +! ( c )
( if newline, replace with zero to indicate EOL )
DUP 0xd = IF DROP 0 THEN ;

23
blk/456
View File

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

24
blk/457
View File

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

View File

18
blk/459
View File

@ -1,16 +1,2 @@
: _ ( b1 b2 -- )
999 SWAP ( stop indicator ) : LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;
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 ;

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 &< 0x7e |> <>}
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. )

View File

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

View File

@ -1 +0,0 @@

Binary file not shown.

View File

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

View File

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

View File

@ -18,7 +18,7 @@ H@ 256 /MOD 2 PC! 2 PC!
( Update LATEST ) ( Update LATEST )
PC ORG @ 8 + ! PC ORG @ 8 + !
," CURRENT @ HERE ! " ," 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 ) 499 500 XPACKR ( trs80.fs )
," : _ BLK$ FD$ (ok) RDLN$ ; _ " ," : _ BLK$ FD$ (ok) RDLN$ ; _ "
H@ 256 /MOD 2 PC! 2 PC! H@ 256 /MOD 2 PC! 2 PC!

View File

@ -1,6 +1,2 @@
0x70 <>{ 0x70 &= 0x58 |= 0x20 |= <>} #
0x71 <>{ 0x70 &= 0x58 |= 0x20 |= <>} NOT #
0x42 <>{ 0x40 &> 0x44 &< <>} #
0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
0x22 0x8065 < # 0x22 0x8065 < #
-1 0 > # -1 0 > #