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

Bump version + refine crlf nil handling in accept more.

Browse Source
This commit is contained in:
Brad Nelson
2022-06-07 23:11:01 -07:00
parent d97a6915a5
commit c2d9615833
5 changed files with 20 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -12,7 +12,7 @@
# See the License for the specific language governing permissions and # See the License for the specific language governing permissions and
# limitations under the License. # limitations under the License.
VERSION=7.0.6.17 VERSION=7.0.6.18
STABLE_VERSION=7.0.5.4 STABLE_VERSION=7.0.5.4
REVISION=$(shell git rev-parse HEAD | head -c 20) REVISION=$(shell git rev-parse HEAD | head -c 20)
REVSHORT=$(shell echo $(REVISION) | head -c 7) REVSHORT=$(shell echo $(REVISION) | head -c 7)

6
common/base_tests.fs
View File

@ -104,13 +104,15 @@ e: test-accept
pad 10 accept pad 10 accept
pad swap type cr pad swap type cr
out:\ --> 1234567890 out:\ --> 1234567890
out:crlf out:cr!
out:cr
out: 1234567890 out: 1234567890
in: foo in: foo
pad 10 accept pad 10 accept
pad swap type cr pad swap type cr
out:\ --> foo out:\ --> foo
out:crlf out:cr!
out:cr
out: foo out: foo
;e ;e

18
common/boot.fs
View File

@ -115,7 +115,7 @@ defer key
defer key? defer key?
defer bye defer bye
: emit ( n -- ) >r rp@ 1 type rdrop ; : emit ( n -- ) >r rp@ 1 type rdrop ;
: space bl emit ; : cr nl emit ; : space bl emit ; : cr 13 emit nl emit ;
( Numeric Output ) ( Numeric Output )
variable hld variable hld
@ -158,13 +158,20 @@ variable hld
( Input ) ( Input )
: raw.s depth 0 max for aft sp@ r@ cells - @ . then next ; : raw.s depth 0 max for aft sp@ r@ cells - @ . then next ;
variable echo -1 echo ! variable arrow -1 arrow ! variable wascr variable echo -1 echo ! variable arrow -1 arrow ! 0 value wascr
: *emit ( n -- ) dup emit 13 = if cr then ; : *emit ( n -- ) dup emit 13 = if cr then ;
: ?echo ( n -- ) echo @ if *emit else drop then ; : ?echo ( n -- ) echo @ if *emit else drop then ;
: ?arrow. arrow @ if >r >r raw.s r> r> ." --> " then ; : ?arrow. arrow @ if >r >r raw.s r> r> ." --> " then ;
: *key ( -- n ) : *key ( -- n )
begin key dup nl = wascr @ 0= and if drop 13 exit then dup until begin
dup 13 = wascr ! ; key
dup nl = if
drop wascr if 0 else 13 exit then
then
dup 13 = to wascr
dup if exit else drop then
again ;
: eat-till-cr begin *key dup 13 = if ?echo exit else drop then again ;
: accept ( a n -- n ) ?arrow. 0 swap begin 2dup < while : accept ( a n -- n ) ?arrow. 0 swap begin 2dup < while
*key *key
dup 13 = if ?echo drop nip exit then dup 13 = if ?echo drop nip exit then
@ -175,8 +182,7 @@ variable echo -1 echo ! variable arrow -1 arrow ! variable wascr
>r rot r> over c! 1+ -rot swap 1+ swap >r rot r> over c! 1+ -rot swap 1+ swap
then then
repeat drop nip repeat drop nip
( Eat rest of the line if buffer too small ) eat-till-cr
begin *key dup 13 = if ?echo exit else drop then again
; ;
200 constant input-limit 200 constant input-limit
: tib ( -- a ) 'tib @ ; : tib ( -- a ) 'tib @ ;

4
common/testing.fs
View File

@ -45,8 +45,8 @@ variable expect-used variable result-used
: result-type ( a n -- ) for aft dup c@ result-emit 1+ then next drop ; : result-type ( a n -- ) for aft dup c@ result-emit 1+ then next drop ;
: expected ( -- a n ) expect-buffer expect-used @ ; : expected ( -- a n ) expect-buffer expect-used @ ;
: resulted ( -- a n ) result-buffer result-used @ ; : resulted ( -- a n ) result-buffer result-used @ ;
: out:cr nl expect-emit ; : out:cr! 13 expect-emit ;
: out:crlf 13 expect-emit nl expect-emit ; : out:cr 13 expect-emit nl expect-emit ;
: out:\ ( "line" -- ) nl parse expect-type ; : out:\ ( "line" -- ) nl parse expect-type ;
: out: ( "line" -- ) out:\ out:cr ; : out: ( "line" -- ) out:\ out:cr ;
variable confirm-old-type variable confirm-old-type

2
common/vocabulary.fs
View File

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