duskos

commit c7450d49bd99efd802a2c7303555182722b9f6b3
parent 892d307d5fbabfac4c45b13f0cdcff7481318a53
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue, 10 Jan 2023 16:14:20 -0500

Add "and?" "or?" and readd "chain"

Diffstat:
M
fs/comp/c/vm/forth.fs
 | 
6
++----
M
fs/doc/dict.txt
 | 
7
+++++++
M
fs/tests/kernel.fs
 | 
15
+++++++++++++++
M
fs/xcomp/bootlo.fs
 | 
5
+++++

4 files changed, 29 insertions(+), 4 deletions(-)
diff --git a/fs/comp/c/vm/forth.fs b/fs/comp/c/vm/forth.fs
@@ -151,15 +151,13 @@ ARIOPCNT 1+ ( for = ) wordtbl _tbl
   vmop :>reg ;
 
 : _s $80000000 + swap $80000000 + swap ;
-: _&& bool swap bool and ;
-: _|| or bool ;
 LOGOPCNT wordtbl _tblsigned
 :w _s < ;          :w _s > ;           :w _s <= ;          :w _s >= ;
-'w =               'w <>               'w _&&              'w _||
+'w =               'w <>               'w and?             'w or?
 
 LOGOPCNT wordtbl _tblunsigned
 'w <               'w >                'w <=               'w >=
-'w =               'w <>               'w _&&              'w _||
+'w =               'w <>               'w and?             'w or?
 
 : logop, ( opid -- )
   vmop type typeunsigned? if _tblunsigned else _tblsigned then _binop, ;
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -211,6 +211,8 @@ Other conditions yield f=0.
 0>=        a -- f       f=1 if a is not negative
 not        a -- f       f=1 if a is zero
 bool       a -- f       f=1 if a is nonzero
+and?       a b -- f     boolean "and"
+or?        a b -- f     boolean "or"
 min        a b -- n     n is the lowest number between a and b.
 max        a b -- n     n is the highest number between a and b.
 =><=       n l h -- f   f=1 if n >= l and n <= h.
@@ -343,6 +345,11 @@ alias      "x y" -- Find word "x" in system dictionary and create entry "y" of
 realias    w t --   Make target word "t" into an alias to word "w".
 S"         x" --    *IC* Yield string literal with contents "x".
 
+chain      w1 w2 -- w
+  Defines (to "here") and returns a new word that calls w1, then w2. w1 or w2
+  are allowed to be zero or "noop", in which case no new word is defined and the
+  "other" word is returned.
+
 ## "to" words
 
 The way "to" words work is that they compile their associated word right
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -8,6 +8,21 @@ testbegin
 3 5 * 15 #eq
 11 3 /mod 3 #eq ( q ) 2 #eq ( r )
 
+\ logic
+
+1 2 and 0 #eq
+1 2 and? 1 #eq
+1 0 and? 0 #eq
+2 0 or? 1 #eq
+0 0 or? 0 #eq
+
+\ chain
+
+2 ' noop ' 1+ chain execute 3 #eq
+2 ' 1+ ' noop chain execute 3 #eq
+2 ' 1+ ' << chain execute 6 #eq
+2 ' << ' 1+ chain execute 5 #eq
+
 \ I/O
 : wordmaker word" hello" code 42 litn exit, ;
 wordmaker hello 42 #eq
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -63,6 +63,8 @@ code 2drop 8 p+, exit,
 : =><= ( n l h -- f ) over - rot> ( h n l ) - >= ;
 : neg 0 -^ ;
 : ^ -1 xor ;
+: and? bool swap bool and ;
+: or? or bool ;
 : upcase ( c -- c ) dup 'a' - 26 < if $df and then ;
 
 : rfree 0 [rcnt] @! neg r+, ; immediate
@@ -108,6 +110,9 @@ create _ 0 ,
 : here HERE ['] @ toexec ; immediate
 : alias ' code alias, ;
 : realias ( 'new 'tgt -- ) to@! here swap alias, to here ;
+: _ ( w -- w-or-0 ) dup ['] noop = if drop 0 then ;
+: chain ( w1 w2 -- w )
+  _ swap _ tuck over and? if here rot execute, swap alias, else ?swap nip then ;
 alias noop idle
 
 : &+ ( n -- ) doer , does> @ + ;