~vdupras/duskos

8cdd6c5a54127a46ec91e517346b22f9d7965946 — Virgil Dupras 5 days ago e5b003d
rpi: add PS Top Of Stack register (r9)
2 files changed, 63 insertions(+), 56 deletions(-)

M fs/asm/arm.fs
M fs/xcomp/arm/rpi/kernel.fs
M fs/asm/arm.fs => fs/asm/arm.fs +7 -6
@@ 5,6 5,7 @@

\ RSP=rSP (r13)
\ PSP=r10
\ PS Top of Stack=r9

: ,) ( op -- ) le, ;



@@ 12,7 13,7 @@
4 const r4         5 const r5          6 const r6          7 const r7
8 const r8         9 const r9          10 const r10        11 const r11
12 const r12       13 const r13        14 const r14        15 const r15
11 const rFP
                   9 const rTOP        10 const rPSP       11 const rFP
12 const rIP       13 const rSP        14 const rLR        15 const rPC
: rn) ( op r -- op ) 16 lshift or ;
: rd) ( op r -- op ) 12 lshift or ;


@@ 73,9 74,9 @@ $e5000000 const str)         $e5100000 const ldr)
\ Macros

: lret, ( -- ) mov) rPC rd) rLR rm) ,) ;
: push, ( r -- ) str) swap rd) rSP rn) 4 -i) pre) !) ,) ;
: pop, ( r -- ) ldr) swap rd) rSP rn) 4 +i) post) ,) ;
: ppush, ( r -- ) str) swap rd) r10 rn) 4 -i) pre) !) ,) ;
: ppop, ( r -- ) ldr) swap rd) r10 rn) 4 +i) post) ,) ;
: call, ( rel -- ) rLR push, 4 - bl) ,) rLR pop, ;
: push, ( r -- ) str) swap rd) rSP rn) CELLSZ -i) pre) !) ,) ;
: pop, ( r -- ) ldr) swap rd) rSP rn) CELLSZ +i) post) ,) ;
: ppush, ( r -- ) str) swap rd) rPSP rn) CELLSZ -i) pre) !) ,) ;
: ppop, ( r -- ) ldr) swap rd) rPSP rn) CELLSZ +i) post) ,) ;
: call, ( rel -- ) rLR push, CELLSZ - bl) ,) rLR pop, ;
: abscall, ( tgt -- ) abs>rel call, ;

M fs/xcomp/arm/rpi/kernel.fs => fs/xcomp/arm/rpi/kernel.fs +56 -50
@@ 16,6 16,12 @@ $30 const UART0_CR
$38 const UART0_IMSC
$44 const UART0_ICR

\ Macros
: xnip, add) rPSP rd) rPSP rn) CELLSZ i) ,) ;
: xdrop, rTOP ppop, ;
: xnip, sub) rPSP rd) rPSP rn) CELLSZ i) ,) ;
: xdup, rTOP ppush, ;

: delay, ( ncycles -- )
  mov) r0 rd) swap ( ncycles ) i) ,)
  pc sub) r0 rd) r0 rn) 1 i) f) ,) ( pc ) abs>rel b) ne) ,) ;


@@ 45,85 51,88 @@ pc to lblemit ( c -- )
    ldr) r3 rd) r8 rn) UART0_FR +i) ,)
    tst) r3 rn) $20 i) ,)
    lblemit abs>rel b) ne) ,)
  r0 ppop,
  str) r0 rd) r8 rn) UART0_DR +i) ,)
  str) rTOP rd) r8 rn) UART0_DR +i) ,)
  xdrop,
  lret,

pc to lblkey ( -- c )
    ldr) r3 rd) r8 rn) UART0_FR +i) ,)
    tst) r3 rn) $10 i) ,)
    lblkey abs>rel b) ne) ,)
  ldr) r0 rd) r8 rn) UART0_DR +i) 8b) ,)
  r0 ppush,
  xdup,
  ldr) rTOP rd) r8 rn) UART0_DR +i) 8b) ,)
  lret,

pc to lblrtype ( a u -- )
  r2 ppop, r1 ppop,
  r1 ppop, mov) r2 rd) rTOP rm) ,) \ r1=a r2=u
  pc
    ldr) r0 rd) r1 rn) 8b) 1 +i) post) ,)
    r0 ppush,
    ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
    xdup,
    lblemit abscall,
    sub) r2 rd) r2 rn) 1 i) f) ,)
    ( pc ) abs>rel b) ne) ,)
  xdrop,
  lret,

pc to lblstype ( str -- )
  r1 ppop,
  ldr) r2 rd) r1 rn) 8b) 1 +i) post) ,)
  r1 ppush, r2 ppush,
  ldr) r0 rd) rTOP rn) 8b) 1 +i) post) ,)
  xdup, mov) rTOP rd) r0 rm) ,)
  lblrtype abs>rel b) ,)

pc to lblword ( -- str )
  xdup,
  pc
    lblkey abscall,
    r0 ppop,
    cmp) r0 rn) SPC i) ,)
    ( pc ) abs>rel b) ls) ,) \ r0=first non-ws
    xnip,
    cmp) rTOP rn) SPC i) ,)
    ( pc ) abs>rel b) ls) ,) \ rTOP=first non-ws
  mov) r2 rd) 0 i) ,)
  r1 SYSVARS CURWORD movi2,
  pc
    add) r2 rd) r2 rn) 1 i) ,)
    str) r0 rd) r1 rn) 8b) 1 +i) pre) !) ,)
    str) rTOP rd) r1 rn) 8b) 1 +i) pre) !) ,)
    lblkey abscall,
    r0 ppop,
    cmp) r0 rn) SPC i) ,)
    xnip,
    cmp) rTOP rn) SPC i) ,)
    ( pc ) abs>rel b) hi) ,)
  r1 SYSVARS CURWORD movi2,
  str) r2 rd) r1 rn) 8b) ,)
  r1 ppush,
  rTOP SYSVARS CURWORD movi2,
  str) r2 rd) rTOP rn) 8b) ,)
  lret,

pc 12 c, ," Hello World!" 0 align4
pc to lblprompt
  ( pc ) r0 pc>reg,
  r0 ppush,
  xdup,
  ( pc ) rTOP pc>reg,
  lblstype abs>rel b) ,)

pc 15 c, ,"  word not found" 0 align4
pc to lblwnf
  r0 SYSVARS CURWORD movi2,
  r0 ppush,
  xdup,
  rTOP SYSVARS CURWORD movi2,
  lblstype abscall,
  ( pc ) r0 pc>reg,
  r0 ppush,
  xdup,
  ( pc ) rTOP pc>reg,
  lblstype abs>rel b) ,)

pc to lblexecute ( a -- )
  r0 ppop,
  mov) r0 rd) rTOP rm) ,)
  xdrop,
  r0 bx) ,)

pc 4 c, ," foo!" 0 align4
xcode foo
  ( pc ) r0 pc>reg,
  r0 ppush,
  xdup,
  ( pc ) rTOP pc>reg,
  lblstype abs>rel b) ,)

pc 4 c, ," bar!" 0 align4
xcode bar pc w>e to lbllastentry
  ( pc ) r0 pc>reg,
  r0 ppush,
  xdup,
  ( pc ) rTOP pc>reg,
  lblstype abs>rel b) ,)

pc to lblfind ( name -- w-or-0 )
  r0 ppop,
  ldr) r1 rd) r0 rn) 8b) 1 +i) post) ,) \ r0=a r1=len
  ldr) r1 rd) rTOP rn) 8b) 1 +i) post) ,) \ rTOP=a r1=len
  lbllastentry r2 pc>reg, \ r2=dict
pc \ loop1
  ldr) r3 rd) r2 rn) 8b) 5 -i) ,) \ entry len


@@ 136,41 145,40 @@ pc \ loop1
  mov) r5 rd) 0 i) ,)
pc \ loop2
  ldr) r6 rd) r4 rn) 8b) r5 +r) ,)
  ldr) r7 rd) r0 rn) 8b) r5 +r) ,)
  cmp) r6 rn) r7 rm) ,)
  ldr) r0 rd) rTOP rn) 8b) r5 +r) ,)
  cmp) r6 rn) r0 rm) ,)
  forward b) ne) ,) to L2
  add) r5 rd) r5 rn) 1 i) ,)
  cmp) r5 rn) r1 rm) ,)
  ( loop2 ) abs>rel b) cs) ,)
  \ same contents
  add) r2 rd) r2 rn) 4 i) ,) \ e>w
  r2 ppush,
  add) rTOP rd) r2 rn) 4 i) ,) \ e>w
  lret,
L2 forward! L1 forward! \ not matching, try next
  ldr) r2 rd) r2 rn) 0 +i) ,)
  cmp) r2 rn) 0 i) ,)
  ( loop1 ) abs>rel b) ne) ,)
  \ not found
  r2 ppush,
  mov) rTOP rd) 0 i) ,)
  lret,

forward!
mov) rSP rd) RSTOP i) ,) \ RSP
mov) r10 rd) PSTOP i) ,) \ PSP
r9 MMIO_BASE GPIO_BASE movi2, \ r9 = GPIO_BASE
add) r8 rd) r9 rn) UART0_BASE i) ,) \ r8 = UART0_BASE
mov) rSP rd) RSTOP i) ,)
mov) rPSP rd) PSTOP i) ,)
r7 MMIO_BASE GPIO_BASE movi2, \ r7 = GPIO_BASE
add) r8 rd) r7 rn) UART0_BASE i) ,) \ r8 = UART0_BASE
\ Disable UART0
mov) r1 rd) 0 i) ,) str) r1 rd) r8 rn) UART0_CR +i) ,)
\ Disable pull up/down for all GPIO pins & delay for 150 cycles.
( r1=0 ) str) r1 rd) r9 rn) GPPUD +i) ,)
( r1=0 ) str) r1 rd) r7 rn) GPPUD +i) ,)
150 delay,
\ Disable pull up/down for pin 14,15 & delay for 150 cycles.
mov) r1 rd) $c000 i) ,) str) r1 rd) r9 rn) GPPUDCLK0 +i) ,)
mov) r1 rd) $c000 i) ,) str) r1 rd) r7 rn) GPPUDCLK0 +i) ,)
150 delay,
\ Write 0 to GPPUD and GPPUDCLK0 to make it take effect.
mov) r1 rd) 0 i) ,)
str) r1 rd) r9 rn) GPPUD +i) ,)
str) r1 rd) r9 rn) GPPUDCLK0 +i) ,)
str) r1 rd) r7 rn) GPPUD +i) ,)
str) r1 rd) r7 rn) GPPUDCLK0 +i) ,)
\ Clear pending interrupts.
mov) r1 rd) $700 i) ,) add) r1 rd) r1 rn) $ff i) ,)
str) r1 rd) r8 rn) UART0_ICR +i) ,)


@@ 195,10 203,8 @@ lblprompt abs>rel bl) ,)
pc
  lblword abs>rel bl) ,)
  lblfind abs>rel bl) ,)
  r0 ppop,
  teq) r0 rn) 0 i) ,)
  mov) eq) r0 rd) binstart i) ,)
  add) eq) r0 rd) r0 rn) lblwnf binstart - i) ,)
  r0 ppush,
  teq) rTOP rn) 0 i) ,)
  mov) eq) rTOP rd) binstart i) ,)
  add) eq) rTOP rd) rTOP rn) lblwnf binstart - i) ,)
  lblexecute abs>rel bl) ,)
  abs>rel b) ,)