kernel.mu4

| This file is part of muforth: https://muforth.dev/
|
| Copyright 2002-2025 David Frech. (Read the LICENSE for details.)

| These are more noodlings than anything "serious" at this point.
|
| I wanted to explore how hard it would be to get something Forth-like onto
| the 8051. Forth-lite? Forthish?
|
| TODO: comparisons, flags, and conditional jumps are still needed in order
| for this to really be the basis of a Forth kernel.


| Register conventions:
|
| The register pair r6:r7 functions as the top of stack; r4:r5 is a
| temporary - also called w - which, among other things, is a place to
| temporarily hold literal values; r1 is the data stack pointer.
|
| r0, r2, and r3 are scratch registers; and if w is not being used, so are
| r4 and r5.
|
| To *return* a literal value, first load it into w using load-literal,
| then call w-is-new-top.
|
| To *use* a literal value as one operand of a binary operation - + and or
| xor etc - first load it using load-literal, then call the binary op's code
| + 2, to skip the acall to wpop.
|
| Ideally there should be target compiler support that does this
| automagically. ;-)


( Support for inline asm in any colon word.)
compiler
: asm{   __inline-asm ;  ( start assembling a macro)
: }      ] ;  ( exit assembler mode and restart host colon compiler)

assembler
: load-literal   >lohi  asm{  # r4 mov  # r5 mov } ;
: nip   ( a b - b)  asm{  r1 inc  r1 inc } ;
: push2  ( reg)
   dup 1+ ( rhi rlo)
   asm{  a mov  r1 dec  a @r1 mov
         a mov  r1 dec  a @r1 mov } ;

: pop2  ( reg)
   dup 1+ swap ( rlo rhi)
   asm{  @r1 a mov  r1 inc  a \f swap mov
         @r1 a mov  r1 inc  a \f swap mov } ;

| op1 computes the low byte; op2 the high byte. For logical operations these
| will be the same.

: binop  ( op2 op1)
   asm{  r7 a mov  r5 +op,  a r7 mov
         r6 a mov  r4 +op,  a r6 mov } ;
forth


__meta

( Push top - aka dup.)
label dup   r6 push2  ret  ;c

( Pop top - aka drop.)
label drop  r6 pop2  ret  ;c

( Push top, then move w into top.)
label w-is-new-top
   ( Push top)  dup acall
   ( Move w to top)
   r5 a mov ( lo)  a r7 mov
   r4 a mov ( hi)  a r6 mov  ret  ;c

( Push the value in w - r4:r5 - onto the stack.)
label wpush  r4 push2  ret  ;c

( Pop the top value on the data stack into r4:r5 - aka w.)
label wpop   r4 pop2  ret  ;c

label xpush  r2 push2  ret  ;c
label xpop   r2 pop2  ret  ;c

label over  ( a b - a b a)
   wpop acall  r1 dec  r1 dec  w-is-new-top ajmp  ;c

label tuck  ( a b - b a b)
   wpop acall  dup acall  wpush ajmp  ;c

label rot   ( a b c - b c a)
   ( Pop b into r2:r3.)  xpop acall
   ( Pop a into w.)  wpop acall
   ( Push b.)  xpush acall
   ( Push c - aka top - and make a - aka w - new top.)
   w-is-new-top ajmp  ;c


label negate  ( negate the value in top - aka r6:r7.)
   c clr  a clr  r7 a subb  a r7 mov
          a clr  r6 a subb  a r6 mov  ret  ;c

| Except for "-", all the binary operations can operate on an immediate
| value held in w. To call this "alternative" version, just skip the acall
| to wpop (which is 2 bytes long.)

label -
   negate acall  ( fall thru)  ;c

label +
   wpop acall
   "30 "20 ( addc add) binop  ret  ;c

label or
   wpop acall
   "40 "40 ( orl orl) binop  ret  ;c

label and
   wpop acall
   "50 "50 ( anl anl) binop  ret  ;c

label xor
   wpop acall
   "60 "60 ( xrl xrl) binop  ret  ;c