kernel.mu4

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

loading AVR Forth kernel

__meta

label kstart  ;c

( Stack ops.)
code dup  ( a - a a)
   t dpushw  ret  ;c

code over  ( a b - a b a)
   0 ,y kl ld  1 ,y kh ld  ( fall thru)

label push-literal
   t dpushw  k t movw  ret  ;c

code nip  ( a b - b)
   k dpopw  ret  ;c

code 2drop
   here 2 + rcall
   ( fall thru)
code drop
   t dpopw  ret  ;c

code swap  ( a b - b a)
   k dpopw  push-literal rjmp  ;c

( Return stack ops.)
code >r
   g0 popw  ( ra)  t pushw  g0 pushw  ' drop rjmp  ;c

code r>
   g0 popw  ( ra)  k popw   g0 pushw  push-literal rjmp  ;c

code -rot  ( a b c - c a b)
   here 2 + rcall  ;c
   ( fall thru)

: rot  ( a b c - b c a)   >r swap  r> swap ;


( Unary ops.)
code invert
   tl com  th com  ret  ;c

code negate
   tl neg  g0 g0 eor  th g0 sbc  g0 th mov  ret  ;c

code 2*
   tl tl add  th th adc  ret  ;c

code 2/
   th asr  begin  tl ror  ret  ;c

code u2/
   th lsr  again  ;c


0 .if
code dnegate
   2 dpopw  2 neg  0 0 eor   3 0 sbc   0 3 mov  2 dpushw
                   0 0 eor  tl 0 sbc  0 tl mov   again  ;c
.then


( Binary ops.)
code -
   ' negate rcall  ( fall thru)  ;c

    code +
litbinop +     kl tl add  kh th adc  ret  ;c

    code and
litbinop and   kl tl and  kh th and  ret  ;c

    code or
litbinop or    kl tl or   kh th or   ret  ;c

    code xor
litbinop xor   kl tl eor  kh th eor  ret  ;c


( Fetch and store.)
litfetch @
    code @   ( addr - w)
   t z movw  z+ tl ld  z+ th ld  ret  ;c

litfetch c@
    code c@  ( addr - b)
   t z movw  z+ tl ld  th clr  ret  ;c

litstore !
    code !   ( w addr)
   t z movw  <drop>  z+ tl st  z+ th st  ' drop rjmp  ;c

litstore c!
    code c!  ( b addr)
   t z movw  <drop>  z+ tl st            ' drop rjmp  ;c


( Tests and compares.)
code 0=
   th tl or  1 tl subi ( Z -> C)
label makeflag  ( C -> -1; NC -> 0)
   tl tl sbc ( C -> 0ff)  tl th mov  ret  ;c

code 0<
   th th add ( N -> C)  makeflag rjmp  ;c

label do-compare
   k dpopw  tl kl sub  th kh sbc ( k - t)  ret  ;c

litcompare u<
      code u<
   do-compare rcall ( k - t)  makeflag rjmp  ;c

litcompare <
      code <
   do-compare rcall ( k - t)
   < if .C bset  makeflag rjmp  then
        .C bclr  makeflag rjmp  ;c

label kend  ;c

kstart kend replicate-kernel

( Program memory fetch, word and byte.)
( XXX any point in having literal versions?)
code pm@   ( addr - w)
   t z movw  pmz+ tl ld  pmz+ th ld  ret  ;c

code pmc@  ( addr - b)
   t z movw  pmz+ tl ld  th clr  ret  ;c


| Multitasker!
|
| User area is pretty small and simple: one byte status, one byte offset to
| bottom of D stack; 2 byte link to next task; 2 byte saved D stack pointer.
|
| Offset  Field   Size  Comments
| ======  ======  ====  ===================================
| 0       ustatus  1     0 means stopped; !0 means running
| 1       ubot     1     offset subtracted from u to get to d stack bottom
| 2       ulink    2     pointer to next task
| 4       utop     2     pointer to top of D stack

0 equ ustatus
1 equ ubot
2 equ ulink
4 equ utop

code pause  ( yield?)
   t dpushw  ( push top)
   .I bclr   SPL tl lds   SPH th lds   .I bset   t dpushw  ( push rsp)
   u z movw   utop ,z yl st   utop 1+ ,z yh st  ( save dsp in user area)

   ( look for another task to run)
   begin   ulink ,z ul ld   ulink 1+ ,z uh ld  ( load user ptr from link)
           u z movw   ustatus ,z tl ld   tl tst   0= not until

   ( found a task; load it and go!)
   utop ,z yl ld   utop 1+ ,z yh ld  ( get dsp from user area)
   t dpopw   .I bclr   SPL tl sts   SPH th sts   .I bset  ( pop rsp)
   t dpopw  ( pop top)   ret  ;c

( XXX test code)
: d0   "000f and ;
: d1   "00f0 and ;
: d2   "0f00 and ;
: d3   "f000 and ;

: fetching
   "005d  @
   "005f  c@
   "cafe  "0010  !
   "be  "0012  c!
   "ba  "0013  c!
;

: s8?  "80 +  "100 u< ;