alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make CRLF handling in accept more robust.

Browse Source
This commit is contained in:
Brad Nelson
2022-06-07 20:32:01 -07:00
parent 30707ee7d8
commit d97a6915a5
4 changed files with 19 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
common/base_tests.fs
View File

@ -103,8 +103,15 @@ e: test-accept
in: 1234567890xxxxxx
pad 10 accept
pad swap type cr
out: --> 1234567890
out:\ --> 1234567890
out:crlf
out: 1234567890
in: foo
pad 10 accept
pad swap type cr
out:\ --> foo
out:crlf
out: foo
;e
e: test-key

14
common/boot.fs
View File

@ -158,12 +158,16 @@ variable hld
( Input )
: raw.s depth 0 max for aft sp@ r@ cells - @ . then next ;
variable echo -1 echo ! variable arrow -1 arrow !
: ?echo ( n -- ) echo @ if emit else drop then ;
variable echo -1 echo ! variable arrow -1 arrow ! variable wascr
: *emit ( n -- ) dup emit 13 = if cr then ;
: ?echo ( n -- ) echo @ if *emit else drop then ;
: ?arrow. arrow @ if >r >r raw.s r> r> ." --> " then ;
: *key ( -- n )
begin key dup nl = wascr @ 0= and if drop 13 exit then dup until
dup 13 = wascr ! ;
: accept ( a n -- n ) ?arrow. 0 swap begin 2dup < while
key
dup nl = over 13 = or if ?echo drop nip exit then
*key
dup 13 = if ?echo drop nip exit then
dup 8 = over 127 = or if
drop over if rot 1- rot 1- rot 8 ?echo bl ?echo 8 ?echo then
else
@ -172,7 +176,7 @@ variable echo -1 echo ! variable arrow -1 arrow !
then
repeat drop nip
( Eat rest of the line if buffer too small )
begin key dup nl = over 13 = or if ?echo exit else drop then again
begin *key dup 13 = if ?echo exit else drop then again
;
200 constant input-limit
: tib ( -- a ) 'tib @ ;

1
common/testing.fs
View File

@ -46,6 +46,7 @@ variable expect-used variable result-used
: expected ( -- a n ) expect-buffer expect-used @ ;
: resulted ( -- a n ) result-buffer result-used @ ;
: out:cr nl expect-emit ;
: out:crlf 13 expect-emit nl expect-emit ;
: out:\ ( "line" -- ) nl parse expect-type ;
: out: ( "line" -- ) out:\ out:cr ;
variable confirm-old-type

1
common/vocabulary.fs
View File

@ -53,6 +53,7 @@ variable scope scope context cell - !
transfer{
xt-find& xt-hide xt-transfer
voc-stack-end last-vocabulary notfound
*key *emit wascr
immediate? input-buffer ?echo ?arrow. arrow
evaluate-buffer aliteral value-bind
leaving( )leaving leaving leaving,