commit 1fc82e94aed50c982b41f93a7e93898bf7143dfe
parent 7ba873823bc6e6c1ccee409d64789f6669ba284c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 24 Jul 2022 15:06:03 -0400
i386: add c, , move move, (wnf) ' entry
Diffstat:
3 files changed, 112 insertions(+), 38 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -160,7 +160,8 @@ ES _ es SS _ ss DS _ ds FS _ fs GS _ gs
: op ( opcode -- ) doer c, does> ( a -- ) c@ c, asm$ ;
$c3 op ret, $90 op nop, $fa op cli, $fc op cld,
$ac op lodsb, $ad op lods, $a6 op cmpsb, $a7 op cmps,
-$f3 op repz, $f2 op repnz,
+$a4 op movsb, $a5 op movs,
+$f3 op repz, $f2 op repnz, $f3 op rep,
\ Jumps and relative addresses
\ i386 jumps and calls in their immediate modes are relative. We keep it that
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -11,22 +11,14 @@
: pspush, ( regid -- ) ps+, [ebp] r! mov, ;
: pspushN, ( n -- ) ps+, [ebp] i) mov, ;
: pspop, ( regid -- ) r! [ebp] mov, ps-, ;
+: wcall, xwordlbl abs>rel call, ;
0 to realmode
-0 value L1
-0 value L2
-0 value lblmainalias
-0 value lbltoptr
-0 value lbltoexec
-0 value lblbootptr
-0 value lblin<
-0 value lblcurword
-0 value lblret \ label for whenever you need to return early
-0 value lblcurrent
-0 value lblemit
-0 value lblparsec
-0 value lblparseh
-0 value lblparseud
+: values ( n -- ) >r begin 0 value next ;
+20 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
+ lblret lblcurrent lblemit lblparsec lblparseh lblparseud lblerrmsg
+ lblrtype lblhere lblmovewrite lblwrite lblcwrite
+$500 const HERESTART \ TODO: find a better place
$8000 to binstart \ This code lives at $8000.
$6000 const RSTOP
$8000 const PSTOP
@@ -97,20 +89,34 @@ xcode [to]
ret,
xcode main
- xwordlbl (alias) abs>rel call,
+ wcall, (alias)
pc to lblmainalias 0 ,
+xcode herestart
+ HERESTART pspushN,
+ ret,
+
+xcode here
+ wcall, (val) pc to lblhere HERESTART ,
+
+xcode current
+ wcall, (val) pc to lblcurrent 0 ,
+
xcode quit
cld,
lbltoptr m) 0 i) mov,
sp RSTOP i) mov,
- xwordlbl main abs>rel call,
+ xwordlbl main abs>rel jmp,
xcode abort
L1 forward!
bp PSTOP i) mov,
xwordlbl quit abs>rel jmp,
+xcode execute
+ AX pspop,
+ ax jmp,
+
xcode drop
ps-,
ret,
@@ -142,12 +148,48 @@ xcode c@
[ebp] ax mov,
ret,
+xcode c,
+ AX pspop,
+pc to lblcwrite \ al=c
+ si lblhere m) mov,
+ [esi] al mov,
+ lblhere m) inc,
+ ret,
+
xcode !
AX pspop,
BX pspop,
ax 0 d) bx mov,
ret,
+xcode ,
+ AX pspop,
+pc to lblwrite \ eax=n
+ si lblhere m) mov,
+ [esi] ax mov,
+ lblhere m) CELLSZ i) add,
+ ret,
+
+xcode move ( src dst u -- )
+ CX pspop,
+ DI pspop,
+ SI pspop,
+ cx cx test,
+ lblret abs>rel jz,
+ rep, movsb,
+ ret,
+
+xcode move, ( src u -- )
+ CX pspop,
+ SI pspop,
+ cx cx test,
+ lblret abs>rel jz,
+pc to lblmovewrite \ esi=a ecx=u
+ di lblhere m) mov,
+ lblhere m) cx add,
+ rep, movsb,
+ ret,
+
pc $b8000 ,
xcode emit \ temporary, this is going in /drv/pc
AX pspop,
@@ -162,16 +204,16 @@ pc to lblemit
xcode rtype ( a u -- )
CX pspop,
SI pspop,
-pc
+pc to lblrtype
ax ax xor,
al [esi] mov,
AX pspush,
si push, cx push,
- xwordlbl emit abs>rel call,
+ wcall, emit
cx pop, si pop,
si inc,
cx dec,
- ( pc ) abs>rel jnz,
+ lblrtype abs>rel jnz,
ret,
pc to lblbootptr 0 ,
@@ -185,7 +227,7 @@ xcode boot<
\ where "word" feeds itself
xcode in< ( -- c )
- xwordlbl (alias) abs>rel call,
+ wcall, (alias)
pc to lblin<
xwordlbl boot< ,
@@ -233,15 +275,16 @@ L1 forward! ( stoploop )
lblcurword pspushN,
ret,
+pc ," word expected"
xcode word
- xwordlbl maybeword abs>rel call,
+ wcall, maybeword
[ebp] -1 i) test,
lblret abs>rel jnz,
- 0 jmp, \ TODO add error message
-
-xcode current
- xwordlbl (val) abs>rel call,
- pc to lblcurrent 0 ,
+ cx 13 i) mov,
+ si ( pc ) i) mov,
+pc to lblerrmsg \ exc=sl esi=sa
+ lblrtype abs>rel call,
+ xwordlbl abort abs>rel jmp,
xcode find ( str -- word-or-0 )
si [ebp] mov,
@@ -276,6 +319,23 @@ L1 forward! ( skip1 )
[ebp] 0 i) mov,
ret,
+pc ," word not found"
+xcode (wnf)
+ si lblcurword 1+ i) mov,
+ cx cx xor,
+ cl lblcurword m) mov,
+ lblrtype abs>rel call,
+ cx 15 i) mov,
+ si ( pc ) i) mov,
+ lblerrmsg abs>rel jmp,
+
+xcode ' ( "name" -- w )
+ wcall, word
+ wcall, find
+ [ebp] -1 i) test,
+ xwordlbl (wnf) abs>rel jz,
+ ret,
+
pc to L1 \ parse unsuccessful
[ebp] 0 i) mov,
ret,
@@ -359,29 +419,42 @@ xcode parse ( str -- n? f )
bp CELLSZ d) neg,
ret,
-xcode execute
- AX pspop,
- ax jmp,
+xcode entry ( str -- )
+ SI pspop,
+ cx cx xor,
+ cl [esi] mov,
+ si inc,
+ dx cx mov, \ save len
+ lblmovewrite abs>rel call,
+ ax lblcurrent m) mov,
+ lblwrite abs>rel call,
+ ax dx mov,
+ lblcwrite abs>rel call,
+ ax lblhere m) mov,
+ lblcurrent m) ax mov,
+ ret,
xcode runword ( str -- ) pc lblcurrent pc>addr !
- xwordlbl parse abs>rel call,
+ wcall, parse
AX pspop,
ax ax test,
lblret abs>rel jnz, \ is a literal
\ not a literal
lblcurword pspushN,
- xwordlbl find abs>rel call,
+ wcall, find
[ebp] -1 i) test,
- 0 jz, \ TODO: implement (wnf)
- xwordlbl execute abs>rel call,
+ xwordlbl (wnf) abs>rel jz,
+ wcall, execute
ret, \ TODO implement stack?
pc lblmainalias pc>addr !
- xwordlbl (s) abs>rel call,
+ wcall, (s)
12 c, ," Hello World!"
+ wcall, (s)
+ 6 c, ," foobar"
pc ( loop )
- xwordlbl word abs>rel call,
- xwordlbl runword abs>rel call,
+ wcall, word
+ wcall, runword
( pc ) abs>rel jmp,
pc lblbootptr pc>addr !
diff --git a/fs/xcomp/pc/boot.fs b/fs/xcomp/pc/boot.fs
@@ -1,2 +1,2 @@
-1+ $0c rtype bye
+entry ' foobar drop 1+ $0c rtype bye
