izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-23 16:28:05 +11:00
Code Issues Releases Wiki Activity

Revisit RDLN words

Browse Source 
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:
Virgil Dupras 2021-01-02 13:30:32 -05:00
parent 527f5977d7
commit 3d47c28a28
3 changed files with 23 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
blk.fs
View File

@ -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
View File

Binary file not shown.

2
doc/dict.txt
View File

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