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

Capitalized branching.

Browse Source
This commit is contained in:
Brad Nelson
2022-07-30 12:38:39 -07:00
parent fdf8b760d1
commit 73d7181da2
3 changed files with 33 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
common/boot.fs
View File

@ -30,16 +30,16 @@ fp@ constant fp0
: [char] char aliteral ; immediate : [char] char aliteral ; immediate
( Core Control Flow ) ( Core Control Flow )
create begin ' nop @ ' begin ! : begin ['] begin , here ; immediate create BEGIN ' nop @ ' begin ! : begin ['] begin , here ; immediate
create again ' branch @ ' again ! : again ['] again , , ; immediate create AGAIN ' branch @ ' again ! : again ['] again , , ; immediate
create until ' 0branch @ ' until ! : until ['] until , , ; immediate create UNTIL ' 0branch @ ' until ! : until ['] until , , ; immediate
create ahead ' branch @ ' ahead ! : ahead ['] ahead , here 0 , ; immediate create AHEAD ' branch @ ' ahead ! : ahead ['] ahead , here 0 , ; immediate
create then ' nop @ ' then ! : then ['] then , here swap ! ; immediate create THEN ' nop @ ' then ! : then ['] then , here swap ! ; immediate
create if ' 0branch @ ' if ! : if ['] if , here 0 , ; immediate create IF ' 0branch @ ' if ! : if ['] if , here 0 , ; immediate
create else ' branch @ ' else ! : else ['] else , here 0 , swap here swap ! ; immediate create ELSE ' branch @ ' else ! : else ['] else , here 0 , swap here swap ! ; immediate
create while ' 0branch @ ' while ! : while ['] while , here 0 , swap ; immediate create WHILE ' 0branch @ ' while ! : while ['] while , here 0 , swap ; immediate
create repeat ' branch @ ' repeat ! : repeat ['] repeat , , here swap ! ; immediate create REPEAT ' branch @ ' repeat ! : repeat ['] repeat , , here swap ! ; immediate
create aft ' branch @ ' aft ! : aft drop ['] aft , here 0 , here swap ; immediate create AFT ' branch @ ' aft ! : aft drop ['] aft , here 0 , here swap ; immediate
( Recursion ) ( Recursion )
: recurse current @ @ aliteral ['] execute , ; immediate : recurse current @ @ aliteral ['] execute , ; immediate
@ -52,8 +52,8 @@ create aft ' branch @ ' aft ! : aft drop ['] aft , here 0 , here swap
variable nest-depth variable nest-depth
( FOR..NEXT ) ( FOR..NEXT )
create for ' >r @ ' for ! : for 1 nest-depth +! ['] for , here ; immediate create FOR ' >r @ ' for ! : for 1 nest-depth +! ['] for , here ; immediate
create next ' donext @ ' next ! : next -1 nest-depth +! ['] next , , ; immediate create NEXT ' donext @ ' next ! : next -1 nest-depth +! ['] next , , ; immediate
( DO..LOOP ) ( DO..LOOP )
variable leaving variable leaving
@ -72,9 +72,9 @@ variable leaving
: +loop ( n -- ) postpone (+loop) postpone until : +loop ( n -- ) postpone (+loop) postpone until
postpone unloop )leaving ; immediate postpone unloop )leaving ; immediate
: loop 1 aliteral postpone +loop ; immediate : loop 1 aliteral postpone +loop ; immediate
create i ' r@ @ ' i ! ( i is same as r@ ) create I ' r@ @ ' i ! ( i is same as r@ )
: j ( -- n ) rp@ 3 cells - @ ; : J ( -- n ) rp@ 3 cells - @ ;
: k ( -- n ) rp@ 5 cells - @ ; : K ( -- n ) rp@ 5 cells - @ ;
( Exceptions ) ( Exceptions )
variable handler variable handler

6
common/forth_namespace_tests.fs
View File

@ -97,9 +97,9 @@ e: check-boot
out: throw out: throw
out: catch out: catch
out: handler out: handler
out: k out: K
out: j out: J
out: i out: I
out: loop out: loop
out: +loop out: +loop
out: leave out: leave

30
common/utils_tests.fs
View File

@ -56,37 +56,37 @@ e: test-see-string
e: test-see-begin-again e: test-see-begin-again
: test begin again ; : test begin again ;
see test see test
out: : test begin again ; out: : test BEGIN AGAIN ;
;e ;e
e: test-see-begin-until e: test-see-begin-until
: test begin until ; : test begin until ;
see test see test
out: : test begin until ; out: : test BEGIN UNTIL ;
;e ;e
e: test-see-begin-while-repeat e: test-see-begin-while-repeat
: test begin while repeat ; : test begin while repeat ;
see test see test
out: : test begin while repeat ; out: : test BEGIN WHILE REPEAT ;
;e ;e
e: test-see-ahead-then e: test-see-ahead-then
: test ahead then ; : test ahead then ;
see test see test
out: : test ahead then ; out: : test AHEAD THEN ;
;e ;e
e: test-see-for-next e: test-see-for-next
: test for i . next ; : test for i . next ;
see test see test
out: : test for i . next ; out: : test FOR I . NEXT ;
;e ;e
e: test-see-for-aft-next e: test-see-for-aft-next
: test for aft i . then next ; : test for aft i . then next ;
see test see test
out: : test for aft i . then next ; out: : test FOR AFT I . THEN NEXT ;
;e ;e
e: test-see-string-strides e: test-see-string-strides
@ -100,23 +100,23 @@ e: test-see-string-strides
: test7 1 if ." ------>" then ; : test7 1 if ." ------>" then ;
: test8 1 if ." ------->" then ; : test8 1 if ." ------->" then ;
see test0 see test0
out: : test0 1 if s" " type then ; out: : test0 1 IF s" " type THEN ;
see test1 see test1
out: : test1 1 if s" >" type then ; out: : test1 1 IF s" >" type THEN ;
see test2 see test2
out: : test2 1 if s" ->" type then ; out: : test2 1 IF s" ->" type THEN ;
see test3 see test3
out: : test3 1 if s" -->" type then ; out: : test3 1 IF s" -->" type THEN ;
see test4 see test4
out: : test4 1 if s" --->" type then ; out: : test4 1 IF s" --->" type THEN ;
see test5 see test5
out: : test5 1 if s" ---->" type then ; out: : test5 1 IF s" ---->" type THEN ;
see test6 see test6
out: : test6 1 if s" ----->" type then ; out: : test6 1 IF s" ----->" type THEN ;
see test7 see test7
out: : test7 1 if s" ------>" type then ; out: : test7 1 IF s" ------>" type THEN ;
see test8 see test8
out: : test8 1 if s" ------->" type then ; out: : test8 1 IF s" ------->" type THEN ;
;e ;e
e: test-noname e: test-noname