@@ 17,34 17,40 @@ $38 const UART0_IMSC
$44 const UART0_ICR
\ Macros
-: xnip, add) rPSP rd) rPSP rn) CELLSZ i) ,) ;
+: xnip, add) rPSP rdn) CELLSZ i) ,) ;
: xdrop, rTOP ppop, ;
-: xnip, sub) rPSP rd) rPSP rn) CELLSZ i) ,) ;
+: xgrow, sub) rPSP rdn) CELLSZ i) ,) ;
: xdup, rTOP ppush, ;
: wcall, xwordlbl abscall, ;
: wjmp, xwordlbl abs>rel b) ,) ;
+: xconst ( n -- ) xcode xdup, mov) rTOP rd) swap i) ,) lret, ;
: delay, ( ncycles -- )
mov) r0 rd) swap ( ncycles ) i) ,)
- pc sub) r0 rd) r0 rn) 1 i) f) ,) ( pc ) abs>rel b) ne) ,) ;
+ pc sub) r0 rdn) 1 i) f) ,) ( pc ) abs>rel b) ne) ,) ;
: pc>reg, ( pc r -- )
dip pc -^ 8 + | ( off r )
mov) over rd) rPC rm) ,)
- sub) over rd) swap rn) swap i) ,) ;
+ sub) swap rdn) swap i) ,) ;
: movi2, ( r n1 n2 -- )
rot mov) over rd) rot i) ,) ( n1 r )
- add) over rd) swap rn) swap i) ,) ;
+ add) swap rdn) swap i) ,) ;
+
+: xaddr ( lbl -- ) xcode xdup, rTOP pc>reg, lret, ;
: values ( n -- ) for 0 value next ;
-2 values lblcurword lblsysdict
+7 values lblcurword lblsysdict lblhere lblnextmeta
+ lblcwrite lbldwrite lblwriterange
$8000 to binstart
binstart const RSTOP
RSTOP $1000 - const PSTOP
+$10000 const HERESTART
0 align4 here to org
forward b) ,)
+HERESTART xconst herestart
xcode emit ( c -- )
pc
ldr) r3 rd) r8 rn) UART0_FR +i) ,)
@@ 69,7 75,7 @@ xcode rtype ( a u -- )
ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
xdup,
wcall, emit
- sub) r2 rd) r2 rn) 1 i) f) ,)
+ sub) r2 rdn) 1 i) f) ,)
( pc ) abs>rel b) ne) ,)
xdrop,
lret,
@@ 80,9 86,7 @@ xcode stype ( str -- )
wjmp, rtype
pc to lblcurword $20 allot0
-xcode curword
- xdup, lblcurword rTOP pc>reg,
- lret,
+lblcurword xaddr curword
xcode word ( -- str )
xdup,
@@ 94,7 98,7 @@ xcode word ( -- str )
mov) r2 rd) 0 i) ,)
lblcurword r1 pc>reg,
pc
- add) r2 rd) r2 rn) 1 i) ,)
+ add) r2 rdn) 1 i) ,)
str) rTOP rd) r1 rn) 8b) 1 +i) pre) !) ,)
wcall, key
xnip,
@@ 136,40 140,103 @@ xcode bar
wjmp, stype
8 allot0 pc to lblsysdict 0 le,
-xcode sysdict pc w>e lblsysdict pc>addr le!
- xdup, lblsysdict rTOP pc>reg,
- lret,
+lblsysdict xaddr sysdict
xcode find ( name 'dict -- w-or-0 )
r2 ppop,
ldr) r1 rd) r2 rn) 8b) 1 +i) post) ,) \ r2=a r1=len
pc \ loop1
ldr) r3 rd) rTOP rn) 8b) 5 -i) ,) \ entry len
- and) r3 rd) r3 rn) $3f i) ,) \ remove flags
+ and) r3 rdn) $3f i) ,) \ remove flags
cmp) r1 rn) r3 rm) ,)
forward b) ne) ,) to L1
\ same length
sub) r4 rd) rTOP rn) 5 i) ,)
- sub) r4 rd) r4 rn) r1 rm) ,) \ beginning of name range
+ sub) r4 rdn) r1 rm) ,) \ beginning of name range
mov) r5 rd) 0 i) ,)
pc \ loop2
ldr) r6 rd) r4 rn) 8b) r5 +r) ,)
ldr) r0 rd) r2 rn) 8b) r5 +r) ,)
cmp) r6 rn) r0 rm) ,)
forward b) ne) ,) to L2
- add) r5 rd) r5 rn) 1 i) ,)
+ add) r5 rdn) 1 i) ,)
cmp) r5 rn) r1 rm) ,)
( loop2 ) abs>rel b) cs) ,)
\ same contents
- add) rTOP rd) rTOP rn) 4 i) ,) \ e>w
+ add) rTOP rdn) 4 i) ,) \ e>w
lret,
L2 forward! L1 forward! \ not matching, try next
- ldr) rTOP rd) rTOP rn) 0 +i) ,)
+ ldr) rTOP rdn) 0 +i) ,)
cmp) rTOP rn) 0 i) ,)
( loop1 ) abs>rel b) ne) ,)
\ not found
lret,
+pc to lblhere HERESTART le,
+lblhere xaddr here
+
+pc to lblcwrite \ r0=char
+ lblhere r2 pc>reg,
+ ldr) r1 rd) r2 rn) ,)
+ str) r0 rd) r1 rn) 8b) 1 +i) post) ,)
+ str) r1 rd) r2 rn) ,)
+ lret,
+
+pc to lbldwrite \ r0=n
+ lblhere r2 pc>reg,
+ ldr) r1 rd) r2 rn) ,)
+ str) r0 rd) r1 rn) 4 +i) post) ,)
+ str) r1 rd) r2 rn) ,)
+ lret,
+
+pc to lblwriterange \ r0=addr r1=len
+ lblhere r2 pc>reg,
+ ldr) r3 rd) r2 rn) ,)
+ pc
+ ldr) r4 rd) r0 rn) 1 +i) post) ,)
+ str) r4 rd) r3 rn) 1 +i) post) ,)
+ sub) r1 rdn) 1 i) f) ,)
+ ( pc ) abs>rel b) ne) ,)
+ str) r3 rd) r2 rn) ,)
+ lret,
+
+xcode align4 ( n -- )
+ lblhere r0 pc>reg,
+ ldr) r1 rd) r0 rn) ,)
+ add) r2 rd) r1 rn) rTOP rm) ,)
+ and) r2 rdn) 3 i) f) ,)
+ sub) ne) r1 rdn) r2 rm) ,)
+ add) ne) r1 rdn) 4 i) ,)
+ str) ne) r1 rd) r0 rn) ,)
+ xdrop, lret,
+
+pc to lblnextmeta 0 le,
+lblnextmeta xaddr nextmeta
+
+xcode entry ( 'dict s -- )
+ mov) r7 rd) rTOP rm) ,)
+ ldr) r6 rd) r7 rn) 8b) 1 +i) post) ,) \ r7=a r6=len
+ add) rTOP rd) r6 rn) 1 i) ,) \ rTOP=len+1
+ wcall, align4 \ rTOP='dict
+ mov) r0 rd) r7 rm) ,)
+ mov) r1 rd) r6 rm) ,)
+ lblwriterange abscall,
+ mov) r0 rd) r6 rm) ,)
+ lblcwrite abscall,
+ lblnextmeta r0 pc>reg,
+ ldr) r0 rdn) ,)
+ lbldwrite abscall,
+ ldr) r0 rd) rTOP rn) ,) \ r0=dict
+ lblhere r1 pc>reg,
+ ldr) r1 rdn) ,)
+ str) r1 rd) rTOP rn) ,) \ "here" is new sysdict
+ lbldwrite abs>rel b) ,)
+
+xcode code pc w>e lblsysdict pc>addr le!
+ wcall, sysdict
+ wcall, word
+ wjmp, entry
+
forward!
mov) rSP rd) RSTOP i) ,)
mov) rPSP rd) PSTOP i) ,)