~vdupras/duskos

37a2f72e78defdd4e983df22e754822c2580e2a5 — Virgil Dupras 21 days ago 3dfdbd3
bootlo: optimize a few words through the HAL

Also, add r! and some "mirror compiler words". See doc/dict
2 files changed, 26 insertions(+), 24 deletions(-)

M fs/doc/dict.txt
M fs/xcomp/bootlo.fs
M fs/doc/dict.txt => fs/doc/dict.txt +11 -3
@@ 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

M fs/xcomp/bootlo.fs => fs/xcomp/bootlo.fs +15 -21
@@ 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