1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-30 20:28:05 +11:00

forth: fix readln overflow handling

It was badly handled.
This commit is contained in:
Virgil Dupras 2020-04-02 13:24:25 -04:00
parent 941791d609
commit e284081c79

View File

@ -24,6 +24,9 @@
H@ IN( ! H@ IN( !
INBUFSZ ALLOT INBUFSZ ALLOT
H@ IN) ! H@ IN) !
( We need two extra bytes. 1 for the last typed 0x0a and
one for the following NULL. )
2 ALLOT
(infl) (infl)
; ;
@ -39,24 +42,22 @@
( read one char into input buffer and returns whether we ( read one char into input buffer and returns whether we
should continue, that is, whether newline was not met. ) should continue, that is, whether newline was not met. )
: (rdlnc) ( -- f ) : (rdlnc) ( -- f )
( buffer overflow? stop now ) ( buffer overflow? same as if we typed a newline )
IN> @ IN) @ = IF 0 EXIT THEN IN> @ IN) @ = IF 0x0a ELSE KEY THEN ( c )
( get and echo back )
KEY DUP ( c c )
( del? same as backspace ) ( del? same as backspace )
DUP 0x7f = IF DROP DROP 0x8 DUP THEN DUP 0x7f = IF DROP 0x8 THEN
EMIT ( c ) ( echo back )
DUP EMIT ( c )
( bacspace? handle and exit ) ( bacspace? handle and exit )
DUP 0x8 = IF (inbs) EXIT THEN DUP 0x8 = IF (inbs) EXIT THEN
( write and advance ) ( write and advance )
DUP ( keep as result ) ( c c ) DUP ( keep as result ) ( c c )
( Here, we take advantage of the fact that c's MSB is
always zero and thus ! automatically null-terminates
our string )
IN> @ ! 1 IN> +! ( c ) IN> @ ! 1 IN> +! ( c )
( not newline? exit now ) ( if newline, replace with zero to indicate EOL )
DUP 0xa = NOT IF EXIT THEN ( c ) DUP 0xa = IF DROP 0 THEN
( newline? make our result 0 and write it to indicate
EOL )
DROP 0
DUP IN> @ ! ( c )
; ;
( Read one line in input buffer and make IN> point to it ) ( Read one line in input buffer and make IN> point to it )
@ -75,5 +76,5 @@
( not EOL? good, inc and return ) ( not EOL? good, inc and return )
DUP IF 1 IN> +! EXIT THEN ( c ) DUP IF 1 IN> +! EXIT THEN ( c )
( EOL ? readline. we still return typed char though ) ( EOL ? readline. we still return typed char though )
(rdln) ( c ) (rdln) (<c) ( c )
; ;