commit 44f745a7554c6e665cc1fddfcf8632ac4c84cb31
parent 8cdd6c5a54127a46ec91e517346b22f9d7965946
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 25 May 2023 14:33:57 -0400
rpi: remplace most labels with word entries
Diffstat:
3 files changed, 59 insertions(+), 50 deletions(-)
diff --git a/fs/xcomp/arm/rpi/kernel.fs b/fs/xcomp/arm/rpi/kernel.fs
@@ -21,6 +21,8 @@ $44 const UART0_ICR
: xdrop, rTOP ppop, ;
: xnip, sub) rPSP rd) rPSP rn) CELLSZ i) ,) ;
: xdup, rTOP ppush, ;
+: wcall, xwordlbl abscall, ;
+: wjmp, xwordlbl abs>rel b) ,) ;
: delay, ( ncycles -- )
mov) r0 rd) swap ( ncycles ) i) ,)
@@ -36,85 +38,87 @@ $44 const UART0_ICR
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
+2 values lblcurword lblsysdict
$8000 to binstart
-binstart $100 - const SYSVARS
-$00 const SYSDICT
-$04 const CURWORD
-binstart $1000 - const RSTOP
+binstart const RSTOP
RSTOP $1000 - const PSTOP
0 align4 here to org
forward b) ,)
-pc to lblemit ( c -- )
+xcode emit ( c -- )
+ pc
ldr) r3 rd) r8 rn) UART0_FR +i) ,)
tst) r3 rn) $20 i) ,)
- lblemit abs>rel b) ne) ,)
+ ( pc ) abs>rel b) ne) ,)
str) rTOP rd) r8 rn) UART0_DR +i) ,)
xdrop,
lret,
-pc to lblkey ( -- c )
+xcode key ( -- c )
+ pc
ldr) r3 rd) r8 rn) UART0_FR +i) ,)
tst) r3 rn) $10 i) ,)
- lblkey abs>rel b) ne) ,)
+ ( pc ) abs>rel b) ne) ,)
xdup,
ldr) rTOP rd) r8 rn) UART0_DR +i) 8b) ,)
lret,
-pc to lblrtype ( a u -- )
+xcode rtype ( a u -- )
r1 ppop, mov) r2 rd) rTOP rm) ,) \ r1=a r2=u
pc
ldr) rTOP rd) r1 rn) 8b) 1 +i) post) ,)
xdup,
- lblemit abscall,
+ wcall, emit
sub) r2 rd) r2 rn) 1 i) f) ,)
( pc ) abs>rel b) ne) ,)
xdrop,
lret,
-pc to lblstype ( str -- )
+xcode stype ( str -- )
ldr) r0 rd) rTOP rn) 8b) 1 +i) post) ,)
xdup, mov) rTOP rd) r0 rm) ,)
- lblrtype abs>rel b) ,)
+ wjmp, rtype
-pc to lblword ( -- str )
+pc to lblcurword $20 allot0
+xcode curword
+ xdup, lblcurword rTOP pc>reg,
+ lret,
+
+xcode word ( -- str )
xdup,
pc
- lblkey abscall,
+ wcall, key
xnip,
cmp) rTOP rn) SPC i) ,)
( pc ) abs>rel b) ls) ,) \ rTOP=first non-ws
mov) r2 rd) 0 i) ,)
- r1 SYSVARS CURWORD movi2,
+ lblcurword r1 pc>reg,
pc
add) r2 rd) r2 rn) 1 i) ,)
str) rTOP rd) r1 rn) 8b) 1 +i) pre) !) ,)
- lblkey abscall,
+ wcall, key
xnip,
cmp) rTOP rn) SPC i) ,)
( pc ) abs>rel b) hi) ,)
- rTOP SYSVARS CURWORD movi2,
+ lblcurword rTOP pc>reg,
str) r2 rd) rTOP rn) 8b) ,)
lret,
-pc 12 c, ," Hello World!" 0 align4
-pc to lblprompt
+pc 15 c, ," word not found" 0 align4
+xcode (wnf)
+ wcall, curword
+ wcall, stype
xdup,
( pc ) rTOP pc>reg,
- lblstype abs>rel b) ,)
+ wjmp, stype
-pc 15 c, ," word not found" 0 align4
-pc to lblwnf
- xdup,
- rTOP SYSVARS CURWORD movi2,
- lblstype abscall,
+pc 12 c, ," Hello World!" 0 align4
+xcode prompt
xdup,
( pc ) rTOP pc>reg,
- lblstype abs>rel b) ,)
+ wjmp, stype
-pc to lblexecute ( a -- )
+xcode execute ( a -- )
mov) r0 rd) rTOP rm) ,)
xdrop,
r0 bx) ,)
@@ -123,43 +127,47 @@ pc 4 c, ," foo!" 0 align4
xcode foo
xdup,
( pc ) rTOP pc>reg,
- lblstype abs>rel b) ,)
+ wjmp, stype
pc 4 c, ," bar!" 0 align4
-xcode bar pc w>e to lbllastentry
+xcode bar
xdup,
( pc ) rTOP pc>reg,
- lblstype abs>rel b) ,)
+ wjmp, stype
+
+8 allot0 pc to lblsysdict 0 le,
+xcode sysdict pc w>e lblsysdict pc>addr le!
+ xdup, lblsysdict rTOP pc>reg,
+ lret,
-pc to lblfind ( name -- w-or-0 )
- ldr) r1 rd) rTOP rn) 8b) 1 +i) post) ,) \ rTOP=a r1=len
- lbllastentry r2 pc>reg, \ r2=dict
+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) r2 rn) 8b) 5 -i) ,) \ entry len
+ ldr) r3 rd) rTOP 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) rTOP 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) r0 rd) rTOP 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) ,)
cmp) r5 rn) r1 rm) ,)
( loop2 ) abs>rel b) cs) ,)
\ same contents
- add) rTOP rd) r2 rn) 4 i) ,) \ e>w
+ add) rTOP rd) rTOP 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) ,)
+ ldr) rTOP rd) rTOP rn) 0 +i) ,)
+ cmp) rTOP rn) 0 i) ,)
( loop1 ) abs>rel b) ne) ,)
\ not found
- mov) rTOP rd) 0 i) ,)
lret,
forward!
@@ -199,12 +207,13 @@ str) r1 rd) r8 rn) UART0_IMSC +i) ,)
mov) r1 rd) $300 i) ,) add) r1 rd) r1 rn) $01 i) ,)
str) r1 rd) r8 rn) UART0_CR +i) ,)
-lblprompt abs>rel bl) ,)
+wcall, prompt
pc
- lblword abs>rel bl) ,)
- lblfind abs>rel bl) ,)
+ wcall, word
+ wcall, sysdict
+ wcall, find
teq) rTOP rn) 0 i) ,)
mov) eq) rTOP rd) binstart i) ,)
- add) eq) rTOP rd) rTOP rn) lblwnf binstart - i) ,)
- lblexecute abs>rel bl) ,)
+ add) eq) rTOP rd) rTOP rn) xwordlbl (wnf) binstart - i) ,)
+ wcall, execute
abs>rel b) ,)
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -65,7 +65,7 @@ HERESTART xconst herestart
pc HEREMAX , xconst HEREMAX
pc to lblhere HERESTART ,
lblhere xconst HERE
-pc to lblsysdict 0 , 0 c, \ 1b zero len field. see doc/arch
+8 allot0 pc to lblsysdict 0 ,
lblsysdict xconst sysdict
pc to lblmod 0 ,
lblmod xconst MOD
diff --git a/posix/vm.c b/posix/vm.c
@@ -36,8 +36,8 @@ no assembler to complete the HAL to "full" level later. It's all in there.
#define SYSVARS ((PSTOP-STACKSZ)-SYSVARSSZ)
#define HERE SYSVARS
#define HEREMAX (HERE+4)
-#define SYSDICT (HEREMAX+4)
-#define NEXTMETA (SYSDICT+8) // +8 to leave space for sysdict's 0 len. doc/impl
+#define SYSDICT (HEREMAX+12) // 12b to have a whole dict entry with null name
+#define NEXTMETA (SYSDICT+4)
#define _RCNT_ (NEXTMETA+4)
#define NEXTWORD (_RCNT_+4)
#define MOD (NEXTWORD+4)
