commit 3fc5769f387b188d35c2eac8223a3cfd290fb0ab
parent 113681615f552bd731de93101117419f6aeab707
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Sun, 24 Jul 2022 09:35:27 -0400
i386: add dup swap c@ 1+ 1- word
Diffstat:
3 files changed, 98 insertions(+), 9 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -170,9 +170,10 @@ $ac op lodsb, $ad op lods,
: jrop, ( rel32-or-16 opcode )
dup op, $ff > if 1- then is16bit? if 3 - w, else 5 - , then asm$ ;
-\ Conditional jumps
+\ Conditional jumps TODO: add jr8 support
: op ( opcode -- ) doer , does> ( rel32-or-16 a -- ) @ jrop, ;
-$0f84 op jz, $0f85 op jnz,
+$0f84 op jz, $0f85 op jnz, $0f82 op jc, $0f83 op jnc,
+$0f88 op js, $0f89 op jns, $0f8c op jl, $0f8d op jnl,
\ JMP and CALL
\ These are special. They can either be called with a modrm tgt, or with *no
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -4,8 +4,10 @@
\ ESP and EBP are uninitialized.
?f<< /xcomp/tools.fs
-: pspush, ( regid -- ) bp CELLSZ i) sub, bp 0 d) r! mov, ;
-: pspop, ( regid -- ) r! bp 0 d) mov, bp CELLSZ i) add, ;
+: ps+, bp CELLSZ i) sub, ;
+: ps-, bp CELLSZ i) add, ;
+: pspush, ( regid -- ) ps+, bp 0 d) r! mov, ;
+: pspop, ( regid -- ) r! bp 0 d) mov, ps-, ;
0 to realmode
0 value L1
@@ -13,6 +15,9 @@
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
$8000 to binstart \ This code lives at $8000.
$6000 const RSTOP
$8000 const PSTOP
@@ -21,7 +26,7 @@ forward16 jmp, to L1
xcode bye 0 jmp,
-xcode noop ret,
+xcode noop pc to lblret ret,
pc to lbltoptr 0 ,
pc to lbltoexec \ AX=cell addr
@@ -97,6 +102,33 @@ xcode abort
bp PSTOP i) mov,
xwordlbl quit abs>rel jmp,
+xcode dup
+ ax bp 0 d) mov,
+ AX pspush,
+ ret,
+
+xcode swap
+ ax bp 0 d) mov,
+ bx bp CELLSZ d) mov,
+ bp 0 d) bx mov,
+ bp CELLSZ d) ax mov,
+ ret,
+
+xcode 1+
+ bp 0 d) inc,
+ ret,
+
+xcode 1-
+ bp 0 d) dec,
+ ret,
+
+xcode c@
+ si bp 0 d) mov,
+ ax ax xor,
+ al si 0 d) mov,
+ bp 0 d) ax mov,
+ ret,
+
xcode !
AX pspop,
BX pspop,
@@ -140,11 +172,62 @@ xcode boot<
\ where "word" feeds itself
xcode in< ( -- c )
xwordlbl (alias) abs>rel call,
+pc to lblin<
xwordlbl boot< ,
+pc to lblcurword $20 allot0
+xcode curword
+ ps+, bp 0 d) lblcurword i) mov,
+ ret,
+
+pc to L1 ( word_eof )
+ ax pop,
+ lbltoptr m) ax mov,
+ ax ax xor,
+ AX pspush,
+
+xcode maybeword ( -- str-or-0 )
+ \ save lbltoptr so that it doesn't mess in<, which could be calling a word
+ \ with "to" semantics.
+ ax lbltoptr m) mov,
+ ax push,
+ lbltoptr m) 0 i) mov,
+pc ( loop1 )
+ lblin< m) abs>rel call,
+ AX pspop,
+ ax ax test,
+ L1 ( word_eof ) abs>rel js,
+ ax SPC 1+ i) cmp, \ is ws?
+ ( loop1 ) abs>rel jc,
+ bx lblcurword 1+ i) mov,
+pc ( loop2 )
+ bx 0 d) al mov,
+ bx inc,
+ bx push,
+ lblin< m) call,
+ bx pop,
+ AX pspop,
+ ax ax test,
+ forward js, to L1 ( stoploop )
+ ax SPC 1+ i) cmp, \ is ws?
+ ( loop2 ) abs>rel jnc,
+L1 forward! ( stoploop )
+ ax pop,
+ lbltoptr m) ax mov,
+ bx lblcurword 1+ i) sub,
+ lblcurword m) bl mov,
+ ps+, bp 0 d) lblcurword i) mov,
+ ret,
+
+xcode word
+ xwordlbl maybeword abs>rel call,
+ bp 0 d) -1 i) test,
+ lblret abs>rel jnz,
+ 0 jmp, \ TODO add error message
+
pc lblmainalias pc>addr !
xwordlbl (s) abs>rel call,
- 12 c, ," Hello World!"
+ 6 c, ," Hello "
SI pspop,
bx bx xor,
bl si 0 d) mov, \ len
@@ -152,8 +235,12 @@ pc lblmainalias pc>addr !
SI pspush,
BX pspush,
xwordlbl rtype abs>rel call,
- xwordlbl in< abs>rel call,
- xwordlbl emit abs>rel call,
+ xwordlbl word abs>rel call,
+ xwordlbl dup abs>rel call,
+ xwordlbl 1+ abs>rel call,
+ xwordlbl swap abs>rel call,
+ xwordlbl c@ abs>rel call,
+ xwordlbl rtype abs>rel call,
xwordlbl bye abs>rel call,
pc lblbootptr pc>addr !
diff --git a/fs/xcomp/pc/boot.fs b/fs/xcomp/pc/boot.fs
@@ -1 +1,2 @@
-X
+World! dontprint
+
