@@ 1,4 1,5 @@
?f<< /asm/arm.fs
+?f<< /xcomp/tools.fs
\ For RPI model 1
$20000000 const MMIO_BASE
@@ 15,9 16,6 @@ $30 const UART0_CR
$38 const UART0_IMSC
$44 const UART0_ICR
-$10000 const CURWORD
-$11000 const DICTIONARY
-
: delay, ( ncycles -- )
mov) r0 rd) swap ( ncycles ) i) ,)
pc sub) r0 rd) r0 rn) 1 i) f) ,) ( pc ) abs>rel b) ne) ,) ;
@@ 25,26 23,36 @@ $11000 const DICTIONARY
: pc>reg, ( pc r -- )
dip pc -^ 8 + | ( off r )
mov) over rd) rPC rm) ,)
- sub) swap rd) swap i) ,) ;
+ sub) over rd) swap rn) swap i) ,) ;
-: values ( n -- ) for 0 value next ;
-7 values lblemit lblkey lblrtype lblword lblstype lblprompt lblwnf
+: movi2, ( r n1 n2 -- )
+ rot mov) over rd) rot i) ,) ( n1 r )
+ add) over rd) swap rn) swap i) ,) ;
+: values ( n -- ) for 0 value next ;
+10 values lblemit lblkey lblrtype lblword lblstype lblprompt lblwnf lblfind
+ lblexecute lbllastentry
$8000 to binstart
+binstart $100 - const SYSVARS
+$00 const SYSDICT
+$04 const CURWORD
+binstart $1000 - const RSTOP
+RSTOP $1000 - const PSTOP
+
0 align4 here to org
forward b) ,)
pc to lblemit ( c -- )
- ldr) r3 rd) r7 rn) UART0_FR +i) ,)
+ ldr) r3 rd) r8 rn) UART0_FR +i) ,)
tst) r3 rn) $20 i) ,)
lblemit abs>rel b) ne) ,)
r0 ppop,
- str) r0 rd) r7 rn) UART0_DR +i) ,)
+ str) r0 rd) r8 rn) UART0_DR +i) ,)
lret,
pc to lblkey ( -- c )
- ldr) r3 rd) r7 rn) UART0_FR +i) ,)
+ ldr) r3 rd) r8 rn) UART0_FR +i) ,)
tst) r3 rn) $10 i) ,)
lblkey abs>rel b) ne) ,)
- ldr) r0 rd) r7 rn) UART0_DR +i) 8b) ,)
+ ldr) r0 rd) r8 rn) UART0_DR +i) 8b) ,)
r0 ppush,
lret,
pc to lblrtype ( a u -- )
@@ 62,14 70,14 @@ pc to lblstype ( str -- )
r1 ppush, r2 ppush,
lblrtype abs>rel b) ,)
-pc to lblword \ str in CURWORD
+pc to lblword ( -- str )
pc
lblkey abscall,
r0 ppop,
cmp) r0 rn) SPC i) ,)
( pc ) abs>rel b) ls) ,) \ r0=first non-ws
mov) r2 rd) 0 i) ,)
- mov) r1 rd) CURWORD i) ,)
+ r1 SYSVARS CURWORD movi2,
pc
add) r2 rd) r2 rn) 1 i) ,)
str) r0 rd) r1 rn) 8b) 1 +i) pre) !) ,)
@@ 77,8 85,9 @@ pc to lblword \ str in CURWORD
r0 ppop,
cmp) r0 rn) SPC i) ,)
( pc ) abs>rel b) hi) ,)
- mov) r1 rd) CURWORD i) ,)
+ r1 SYSVARS CURWORD movi2,
str) r2 rd) r1 rn) 8b) ,)
+ r1 ppush,
lret,
pc 12 c, ," Hello World!" 0 align4
@@ 89,52 98,107 @@ pc to lblprompt
pc 15 c, ," word not found" 0 align4
pc to lblwnf
- mov) r0 rd) CURWORD i) ,)
+ r0 SYSVARS CURWORD movi2,
r0 ppush,
lblstype abscall,
( pc ) r0 pc>reg,
r0 ppush,
lblstype abs>rel b) ,)
+
+pc to lblexecute ( a -- )
+ r0 ppop,
+ r0 bx) ,)
+
+pc 4 c, ," foo!" 0 align4
+xcode foo
+ ( pc ) r0 pc>reg,
+ r0 ppush,
+ lblstype abs>rel b) ,)
+
+pc 4 c, ," bar!" 0 align4
+xcode bar pc w>e to lbllastentry
+ ( pc ) r0 pc>reg,
+ r0 ppush,
+ 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
+ lbllastentry r2 pc>reg, \ r2=dict
+pc \ loop1
+ ldr) r3 rd) r2 rn) 8b) 5 -i) ,) \ entry len
+ and) r3 rd) r3 rn) $3f i) ,) \ remove flags
+ cmp) r1 rn) r3 rm) ,)
+ forward b) ne) ,) to L1
+ \ same length
+ sub) r4 rd) r2 rn) 5 i) ,)
+ sub) r4 rd) r4 rn) r1 rm) ,) \ beginning of name range
+ 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) ,)
+ 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,
+ 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,
+ lret,
+
forward!
-mov) rSP rd) binstart i) ,) \ RSP
-sub) r10 rd) rSP rn) $1000 i) ,) \ PSP
-mov) r9 rd) MMIO_BASE i) ,) \ r9 = MMIO_BASE
-add) r8 rd) r9 rn) GPIO_BASE i) ,) \ r8 = GPIO_BASE
-add) r7 rd) r8 rn) UART0_BASE i) ,) \ r7 = UART0_BASE
+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
\ Disable UART0
-mov) r1 rd) 0 i) ,) str) r1 rd) r7 rn) UART0_CR +i) ,)
+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) r8 rn) GPPUD +i) ,)
+( r1=0 ) str) r1 rd) r9 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) r8 rn) GPPUDCLK0 +i) ,)
+mov) r1 rd) $c000 i) ,) str) r1 rd) r9 rn) GPPUDCLK0 +i) ,)
150 delay,
\ Write 0 to GPPUD and GPPUDCLK0 to make it take effect.
mov) r1 rd) 0 i) ,)
-str) r1 rd) r8 rn) GPPUD +i) ,)
-str) r1 rd) r8 rn) GPPUDCLK0 +i) ,)
+str) r1 rd) r9 rn) GPPUD +i) ,)
+str) r1 rd) r9 rn) GPPUDCLK0 +i) ,)
\ Clear pending interrupts.
mov) r1 rd) $700 i) ,) add) r1 rd) r1 rn) $ff i) ,)
-str) r1 rd) r7 rn) UART0_ICR +i) ,)
+str) r1 rd) r8 rn) UART0_ICR +i) ,)
\ Set integer & fractional part of baud rate.
\ UART_CLOCK on rpi1 is 48Mhz
\ Divider = UART_CLOCK/(16 * Baud)
\ Fraction part register = 64th of the unit
\ Baud = 115200.
\ Divider = 48000000 / (16 * 115200) = 26.042
-mov) r1 rd) 26 i) ,) str) r1 rd) r7 rn) UART0_IBRD +i) ,)
-mov) r1 rd) 3 i) ,) str) r1 rd) r7 rn) UART0_FBRD +i) ,)
+mov) r1 rd) 26 i) ,) str) r1 rd) r8 rn) UART0_IBRD +i) ,)
+mov) r1 rd) 3 i) ,) str) r1 rd) r8 rn) UART0_FBRD +i) ,)
\ Enable FIFO & 8 bit data transmission (1 stop bit, no parity).
-mov) r1 rd) $70 i) ,) str) r1 rd) r7 rn) UART0_LCRH +i) ,)
+mov) r1 rd) $70 i) ,) str) r1 rd) r8 rn) UART0_LCRH +i) ,)
\ Mask all interrupts.
mov) r1 rd) $700 i) ,) add) r1 rd) r1 rn) $f2 i) ,)
-str) r1 rd) r7 rn) UART0_IMSC +i) ,)
+str) r1 rd) r8 rn) UART0_IMSC +i) ,)
\ Enable UART0, receive & transfer part of UART.
mov) r1 rd) $300 i) ,) add) r1 rd) r1 rn) $01 i) ,)
-str) r1 rd) r7 rn) UART0_CR +i) ,)
+str) r1 rd) r8 rn) UART0_CR +i) ,)
lblprompt abs>rel bl) ,)
pc
lblword abs>rel bl) ,)
- lblwnf 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,
+ lblexecute abs>rel bl) ,)
abs>rel b) ,)