duskos

commit 37a2f72e78defdd4e983df22e754822c2580e2a5
parent 3dfdbd35a12fb256598eece04422d34b5dee9edc
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue,  9 May 2023 17:54:44 -0400

bootlo: optimize a few words through the HAL

Also, add r! and some "mirror compiler words". See doc/dict

Diffstat:
M
fs/doc/dict.txt
 | 
14
+++++++++++---
M
fs/xcomp/bootlo.fs
 | 
36
+++++++++++++++---------------------

2 files changed, 26 insertions(+), 24 deletions(-)
diff --git a/fs/doc/dict.txt b/fs/doc/dict.txt
@@ -121,9 +121,9 @@ rot>       a b c -- c a b
 rdrop      --              *I* Compile a RS shrink of 4 bytes.
 2rdrop     --              *I* Compile a RS shrink of 8 bytes.
 r@         --              *I* Compile a push of current RS top to PS.
-r>         --              *I* Equivalent to r@ rdrop
->r         --              *I* Compiles a RS grow of 4 bytes followed by a pop
-                           of PS into that new RS space.
+r!         --              *I* Compile a push of current PS top to RS.
+r>         --              *I* Equivalent to r@ rdrop.
+>r         --              *I* Equivalent to r! drop.
 scnt       -- n            Number of elements in PS, excluding "n".
 rcnt       -- n            Number of elementS in RS, excluding this call.
 stack?     --              Error out if scnt < 0.
@@ -366,6 +366,14 @@ chain      w1 w2 -- w
   are allowed to be zero or "noop", in which case no new word is defined and the
   "other" word is returned.
 
+## Mirror compilers
+
+There are also some compiler words that all have the same ( -- ) signature and
+that compile the same operation as their name, without the "," part. You can use
+them to create a "code" word or to inline an operation instead of calling it.
+
+dup, swap, nip, drop, 2drop, rot, over,
+
 ## "to" words
 
 The way "to" words work is that they compile their associated word right
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -3,17 +3,13 @@ code : ] code ] ;
 : :16b code16b ] ;
 : noop ;
 code dup dup, exit,
-code swap PSP) @!, exit,
-: nip, 4 ps+, ;
-code nip nip, exit,
-: drop, PSP) @, nip, ;
-code drop drop, exit,
-: 2drop, PSP) 4 +) @, 8 ps+, ;
-code 2drop 2drop, exit,
-code rot PSP) @!, PSP) 4 +) @!, exit,
+: swap, PSP) @!, ; code swap swap, exit,
+: nip, 4 ps+, ; code nip nip, exit,
+: drop, PSP) @, nip, ; code drop drop, exit,
+: 2drop, PSP) 4 +) @, 8 ps+, ; code 2drop 2drop, exit,
+: rot, PSP) @!, PSP) 4 +) @!, ; code rot rot, exit,
 code rot> PSP) 4 +) @!, PSP) @!, exit,
-: over, dup, PSP) 4 +) @, ;
-code over over, exit,
+: over, dup, PSP) 4 +) @, ; code over over, exit,
 code tuck W>A, PSP) @, dup, W<>A, PSP) 4 +) !, exit,
 code 2dup W>A, PSP) @, -8 ps+, PSP) !, W<>A, PSP) 4 +) !, exit,
 
@@ -121,9 +117,10 @@ code neg -W, exit,
 \ Stack
 : rdrop 4 rs+, ; immediate
 : 2rdrop 8 rs+, ; immediate
+: r! -4 rs+, RSP) !, ; immediate
 : r@ dup, RSP) @, ; immediate
 : r> [compile] r@ [compile] rdrop ; immediate
-: >r -4 rs+, RSP) !, drop, ; immediate
+: >r [compile] r! drop, ; immediate
 code scnt dup, PSP) addr, ] PSTOP -^ >> >> 1- ;
 code rcnt dup, RSP) addr, ] RSTOP -^ >> >> ;
 
@@ -192,10 +189,10 @@ alias @ llnext
 : lladd ( ll -- newll ) here swap llappend here 0 , ;
 
 \ Entry metadata
-: &+ ( n -- ) doer , does> @ + ;
-: &+@ ( n -- ) doer , does> @ + @ ;
-: &+w@ ( n -- ) doer , does> @ + w@ ;
-: &+c@ ( n -- ) doer , does> @ + c@ ;
+: &+ ( n -- ) code W+n, exit, ;
+: &+@ ( n -- ) code W+n, W) @, exit, ;
+: &+w@ ( n -- ) code W+n, W) 16b) @, exit, ;
+: &+c@ ( n -- ) code W+n, W) 8b) @, exit, ;
 -4 &+@ emeta
 -4 &+  'emeta
 : metaadd ( id entry -- ) 'emeta lladd drop , ;
@@ -208,12 +205,9 @@ alias @ llnext
 alias noop idle
 
 alias execute | immediate
-: _ compile swap ;
-: bi compile dup ['] _ ; immediate
-: _ compile over ;
-: bi+ compile dup ['] _ ; immediate
-: _1 compile over ; : _2 compile rot ;
-: tri compile dup ['] _2 ['] _1 ; immediate
+: bi dup, ['] swap, ; immediate
+: bi+ dup, ['] over, ; immediate
+: tri dup, ['] rot, ['] over, ; immediate
 : _ [compile] r> ;
 : dip [compile] >r ['] _ ; immediate