Compare commits

...

2 Commits

Author SHA1 Message Date
Clyne 08e9b769f4
add create, does>, etc 3 weeks ago
Clyne bf8436019d
add test suite 3 weeks ago

3
.gitmodules vendored

@ -0,0 +1,3 @@
[submodule "forth2012-test-suite"]
path = forth2012-test-suite
url = https://github.com/gerryjackson/forth2012-test-suite

@ -85,24 +85,34 @@
: decimal 10 base ! ; : decimal 10 base ! ;
: hex 16 base ! ; : hex 16 base ! ;
: begin 0 here ; immediate : begin 0 here ; immediate
: while swap 1+ swap postpone if -rot ; immediate : while swap 1+ swap postpone if -rot ; immediate
: repeat ['] _jmp , , if postpone then then ; immediate : repeat ['] _jmp , , if postpone then then ; immediate
: until ['] _jmp0 , , drop ; immediate : until ['] _jmp0 , , drop ; immediate
: do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate : do ['] _lit , here 0 , ['] >r , postpone 2>r here ; immediate
: unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; immediate
: leave postpone 2r> ['] 2drop , ['] exit , ; immediate : leave postpone 2r> ['] 2drop , ['] exit , ; immediate
: +loop ['] r> , ['] 2dup , ['] + , : +loop ['] r> , ['] 2dup , ['] + ,
postpone r@ ['] swap , ['] >r , postpone r@ ['] swap , ['] >r ,
['] - , ['] 2dup , ['] + , ['] over , ['] xor , ['] - , ['] 2dup , ['] + , ['] over , ['] xor ,
['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 , ['] rot , ['] rot , ['] xor , ['] and , ['] _lit , 0 ,
['] < , ['] _jmp0 , , ['] < , ['] _jmp0 , ,
postpone unloop here 1 cells - swap ! ; immediate postpone unloop here 1 cells - swap ! ; immediate
: loop postpone 2r> ['] 1+ , ['] 2dup , : loop postpone 2r> ['] 1+ , ['] 2dup ,
postpone 2>r ['] = , ['] _jmp0 , , postpone 2>r ['] = , ['] _jmp0 , ,
postpone unloop here 1 cells - swap ! ; immediate postpone unloop here 1 cells - swap ! ; immediate
: i postpone r@ ; immediate : i postpone r@ ; immediate
: j postpone 2r> ['] r> , postpone r@ ['] swap , : j postpone 2r> ['] r> , postpone r@ ['] swap ,
['] >r , ['] -rot , postpone 2>r ; immediate ['] >r , ['] -rot , postpone 2>r ; immediate
: create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ;
: >body [ 2 cells ] literal + @ ;
: _does> latest dup cell+ @ [ 5 cells ] literal + +
['] _jmp over ! cell+ ! ;
: does> here 4 cells + postpone literal ['] _does> , 0 , ; immediate
: variable create cell allot ;
: constant create , does> @ ;

@ -0,0 +1 @@
Subproject commit 45b7ecc1e37d8fdd1bd9a29ec52a15bf7ac69d7f
Loading…
Cancel
Save