Revisit RDLN words
It's been a long while since I visited this part of the code and it has become a bit messy after having gone through all evolutions of the core code. It is now simpler, more compact.
This commit is contained in:
parent
527f5977d7
commit
3d47c28a28
67
blk.fs
67
blk.fs
@ -812,7 +812,7 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
|
|||||||
3 OVER AT-XY KEY DUP EMIT
|
3 OVER AT-XY KEY DUP EMIT
|
||||||
DUP SPC < IF 2DROP DROP EXIT THEN
|
DUP SPC < IF 2DROP DROP EXIT THEN
|
||||||
( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
|
( buf ln c ) 4 col- nspcs SWAP 4 SWAP AT-XY ( buf c )
|
||||||
SWAP C!+ IN( _zbuf (rdln) IN( SWAP 63 MOVE ;
|
SWAP C!+ IN( _zbuf RDLN IN( SWAP 63 MOVE ;
|
||||||
: bufp ( buf -- )
|
: bufp ( buf -- )
|
||||||
DUP 3 col- + SWAP DO I @emit LOOP ;
|
DUP 3 col- + SWAP DO I @emit LOOP ;
|
||||||
: bufs
|
: bufs
|
||||||
@ -872,7 +872,7 @@ CREATE PREVPOS 0 , CREATE PREVBLK 0 , CREATE xoff 0 ,
|
|||||||
: VE
|
: VE
|
||||||
1 XYMODE C! clrscr 0 ACC ! 0 PREVPOS ! nums bufs contents
|
1 XYMODE C! clrscr 0 ACC ! 0 PREVPOS ! nums bufs contents
|
||||||
BEGIN xoff? status setpos KEY handle UNTIL
|
BEGIN xoff? status setpos KEY handle UNTIL
|
||||||
0 XYMODE C! 19 aty (infl) ;
|
0 XYMODE C! 19 aty IN$ ;
|
||||||
( ----- 160 )
|
( ----- 160 )
|
||||||
( AVR Programmer, load range 160-163. doc/avr.txt )
|
( AVR Programmer, load range 160-163. doc/avr.txt )
|
||||||
( page size in words, 64 is default on atmega328P )
|
( page size in words, 64 is default on atmega328P )
|
||||||
@ -1684,9 +1684,9 @@ with "390 LOAD"
|
|||||||
: IN> 0x30 RAM+ ; ( current position in INBUF )
|
: IN> 0x30 RAM+ ; ( current position in INBUF )
|
||||||
: IN( 0x32 RAM+ @ ; ( points to INBUF )
|
: IN( 0x32 RAM+ @ ; ( points to INBUF )
|
||||||
: IN) 0x40 ( buffer size ) IN( + ; ( INBUF's end )
|
: IN) 0x40 ( buffer size ) IN( + ; ( INBUF's end )
|
||||||
: (infl) 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
: IN$ 0 IN( DUP IN> ! ! ; ( flush input buffer )
|
||||||
: QUIT
|
: QUIT
|
||||||
(resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
|
(resRS) 0 0x08 RAM+ ! ( C<* override ) IN$
|
||||||
LIT" (main)" FIND DROP EXECUTE
|
LIT" (main)" FIND DROP EXECUTE
|
||||||
;
|
;
|
||||||
1 33 LOADR+
|
1 33 LOADR+
|
||||||
@ -1972,63 +1972,38 @@ 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 )
|
||||||
( handle backspace: go back one char in IN>, if possible, then
|
|
||||||
emit BS + SPC + BS )
|
|
||||||
: _bs
|
|
||||||
( already at IN( ? )
|
|
||||||
IN> @ IN( = IF EXIT THEN
|
|
||||||
IN> @ 1- IN> !
|
|
||||||
BS EMIT SPC> BS EMIT
|
|
||||||
;
|
|
||||||
( del is same as backspace )
|
|
||||||
: BS? DUP 0x7f = SWAP BS = OR ;
|
|
||||||
SYSVARS 0x55 + :** KEY?
|
SYSVARS 0x55 + :** KEY?
|
||||||
: KEY BEGIN KEY? UNTIL ;
|
: KEY BEGIN KEY? UNTIL ;
|
||||||
( cont.: read one char into input buffer and returns whether we
|
( del is same as backspace )
|
||||||
should continue, that is, whether CR was not met. )
|
: BS? DUP 0x7f = SWAP BS = OR ;
|
||||||
( ----- 379 )
|
( ----- 379 )
|
||||||
: (rdlnc) ( -- c )
|
: RDLN ( Read 1 line in input buff and make IN> point to it )
|
||||||
|
IN$ BEGIN
|
||||||
( buffer overflow? same as if we typed a newline )
|
( buffer overflow? same as if we typed a newline )
|
||||||
IN> @ IN) = IF LF ELSE KEY THEN ( c )
|
IN> @ IN) 1- = IF CR ELSE KEY THEN ( c )
|
||||||
DUP LF = IF DROP CR THEN ( lf? same as cr )
|
DUP BS? IF
|
||||||
( backspace? handle and exit )
|
IN> @ IN( > IF -1 IN> +! BS EMIT THEN SPC> BS EMIT
|
||||||
DUP BS? IF _bs EXIT THEN
|
ELSE DUP LF = IF DROP CR THEN ( same as CR )
|
||||||
( echo back )
|
DUP EMIT ( echo back )
|
||||||
DUP EMIT ( c )
|
DUP IN> @ ! 1 IN> +! THEN ( c )
|
||||||
( write and advance )
|
DUP CR = SWAP EOT? OR UNTIL IN( IN> ! ;
|
||||||
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 CR = IF DROP 0 THEN ;
|
|
||||||
( ----- 380 )
|
( ----- 380 )
|
||||||
( Read one line in input buffer and make IN> point to it )
|
|
||||||
: (rdln)
|
|
||||||
( EOT or less triggers line flush )
|
|
||||||
(infl) BEGIN (rdlnc) 5 < UNTIL IN( IN> ! ;
|
|
||||||
( And finally, implement C<* )
|
|
||||||
: RDLN<
|
: RDLN<
|
||||||
IN> @ C@
|
IN> @ C@ ( c )
|
||||||
DUP IF ( not EOL? good, inc and return )
|
DUP IF ( not EOL? good, inc and return )
|
||||||
1 IN> +!
|
1 IN> +!
|
||||||
ELSE ( EOL ? readline. we still return null though )
|
ELSE ( EOL ? readline. we still return null though )
|
||||||
(rdln)
|
RDLN
|
||||||
THEN
|
THEN ( c )
|
||||||
( update C<? flag )
|
( update C<? flag )
|
||||||
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? )
|
IN> @ C@ 0 > 0x06 RAM+ ! ( 06 == C<? ) ;
|
||||||
;
|
|
||||||
( ----- 381 )
|
( ----- 381 )
|
||||||
( Initializes the readln subsystem )
|
( Initializes the readln subsystem )
|
||||||
: RDLN$
|
: RDLN$
|
||||||
H@ 0x32 ( IN(* ) RAM+ !
|
H@ 0x32 ( IN(* ) RAM+ !
|
||||||
( plus 2 for extra bytes after buffer: 1 for
|
IN) IN( - ALLOT IN$
|
||||||
the last typed LF and one for the following NULL. )
|
|
||||||
IN) IN( - ALLOT
|
|
||||||
(infl)
|
|
||||||
['] RDLN< ['] C<* **!
|
['] RDLN< ['] C<* **!
|
||||||
1 0x06 RAM+ ! ( 06 == C<? )
|
1 0x06 RAM+ ! ( 06 == C<? ) ;
|
||||||
;
|
|
||||||
( ----- 382 )
|
( ----- 382 )
|
||||||
: LIST
|
: LIST
|
||||||
BLK@
|
BLK@
|
||||||
|
BIN
cvm/stage.bin
BIN
cvm/stage.bin
Binary file not shown.
@ -249,6 +249,7 @@ C< -- c Read one char from buffered input.
|
|||||||
EMIT c -- Spit char c to output stream
|
EMIT c -- Spit char c to output stream
|
||||||
IN> -- a Address of variable containing current pos in
|
IN> -- a Address of variable containing current pos in
|
||||||
input buffer.
|
input buffer.
|
||||||
|
IN$ -- Flush input buffer
|
||||||
KEY? -- c? f Polls the keyboard for a key. If a key is
|
KEY? -- c? f Polls the keyboard for a key. If a key is
|
||||||
pressed, f is true and c is the char. Other-
|
pressed, f is true and c is the char. Other-
|
||||||
wise, f is false and c is *not* on the stack.
|
wise, f is false and c is *not* on the stack.
|
||||||
@ -256,6 +257,7 @@ KEY -- c Get char c from direct input
|
|||||||
NL> -- Emit newline
|
NL> -- Emit newline
|
||||||
PC! c a -- Spit c to port a
|
PC! c a -- Spit c to port a
|
||||||
PC@ a -- c Fetch c from port a
|
PC@ a -- c Fetch c from port a
|
||||||
|
RDLN -- Read a line in IN(
|
||||||
SPC> -- Emit space character
|
SPC> -- Emit space character
|
||||||
WORD -- a Read one word from buffered input and push its
|
WORD -- a Read one word from buffered input and push its
|
||||||
addr. Always null terminated. If ASCII EOT is
|
addr. Always null terminated. If ASCII EOT is
|
||||||
|
Loading…
Reference in New Issue
Block a user