commit afc36be6d3f7f1385d31d6ad671c181a5be4122a
parent ca1b730fa2dff08c71275a147ca60e46369bc559
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 25 Jul 2022 10:16:52 -0400
i386: the whole of /xcomp/bootlo.fs now compiles
Diffstat:
5 files changed, 114 insertions(+), 34 deletions(-)
diff --git a/buildpc.fs b/buildpc.fs
@@ -7,4 +7,6 @@ f<< /xcomp/pc/mbr.fs
org $200 spit
f<< /xcomp/i386.fs
org here org - spit
-spitfile<< /xcomp/pc/boot.fs bye
+spitfile<< /xcomp/bootlo.fs
+spitfile<< /xcomp/pc/glue1.fs
+bye
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -205,9 +205,10 @@ $04e9 op jmp, $02e8 op call,
\ m = modrm opcode
: op ( reg opcode -- ) doer , does> @ ( opcode -- )
dup 16 rshift opreg! $ffff and opmodrm, ;
-$0400f7 op mul, $0300f7 op neg, $0200f7 op not,
+$0400f7 op mul, $0600f7 op div, $0300f7 op neg, $0200f7 op not,
$0100ff op dec, $0000ff op inc,
$000f9f op setg, $000f9c op setl, $000f94 op setz, $000f95 op setnz,
+$000f92 op setc, $000f93 op setnc,
$020f01 op lgdt, $030f01 op lidt,
\ Two operands
@@ -221,7 +222,7 @@ $020f01 op lgdt, $030f01 op lidt,
8 rshift dup >> $fc and $80 or swap 7 and ( opcode opreg ) opimm,
else $ff and maybe8b opmodrm, then ;
$040000 op add, $3c0738 op cmp, $2c0528 op sub, $a80084 op _test,
-$240420 op and, $0c0108 op or, $340630 op xor,
+$240420 op and, $0c0108 op or, $340630 op xor, $000086 op xchg,
\ TEST can only have one direction
: test, imm? if $f6 0 opimm, else 0 to opdirec _test, then ;
diff --git a/fs/xcomp/i386.fs b/fs/xcomp/i386.fs
@@ -16,9 +16,9 @@
0 to realmode
: values ( n -- ) >r begin 0 value next ;
-21 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
+22 values L1 L2 lblmainalias lbltoptr lbltoexec lblbootptr lblin< lblcurword
lblret lblcurrent lblemit lblparsec lblparseh lblparseud lblerrmsg
- lblrtype lblhere lblmovewrite lblwrite lblcwrite lblcompiling
+ lblrtype lblhere lblmovewrite lblwrite lblcwrite lblcompiling lblareg
$500 const HERESTART \ TODO: find a better place
$8000 to binstart \ This code lives at $8000.
$6000 const RSTOP
@@ -56,6 +56,13 @@ xcode (alias)
lbltoexec abs>rel jnz,
ax 0 d) jmp,
+xcode (does)
+ ax pop,
+ bx ax mov,
+ bx CELLSZ i) add,
+ BX pspush,
+ ax 0 d) jmp,
+
xcode (s)
si pop, \ addr of str
SI pspush,
@@ -117,6 +124,10 @@ xcode abort
bp PSTOP i) mov,
xwordlbl quit abs>rel jmp,
+xcode exit
+ ax pop,
+ ret,
+
xcode execute
AX pspop,
ax jmp,
@@ -188,10 +199,8 @@ xcode r>
ax jmp,
xcode >r
- BX pspop,
- \ TODO add xchg
- ax pop,
- bx push,
+ AX pspop,
+ ax sp 0 d) xchg,
ax jmp,
xcode r@
@@ -229,6 +238,27 @@ xcode *
[ebp] ax mov,
ret,
+xcode /mod ( a b -- r q )
+ ax bp CELLSZ d) mov,
+ bx [ebp] mov,
+ dx dx xor,
+ bx div,
+ bp CELLSZ d) dx mov, \ remainder
+ [ebp] ax mov, \ quotient
+ ret,
+
+xcode <<c
+ 0 pspushN,
+ bp CELLSZ d) 1 i) shl,
+ [ebp] setc,
+ ret,
+
+xcode >>c
+ 0 pspushN,
+ bp CELLSZ d) 1 i) shr,
+ [ebp] setc,
+ ret,
+
xcode and
AX pspop,
[ebp] ax and,
@@ -244,6 +274,20 @@ xcode xor
[ebp] ax xor,
ret,
+xcode not
+ ax [ebp] mov,
+ [ebp] 0 i) mov,
+ ax ax test,
+ [ebp] setz,
+ ret,
+
+xcode <
+ AX pspop,
+ [ebp] ax sub,
+ [ebp] 0 i) mov,
+ [ebp] setc,
+ ret,
+
xcode c@
si [ebp] mov,
ax ax xor,
@@ -311,6 +355,59 @@ pc to lblmovewrite \ esi=a ecx=u
rep, movsb,
ret,
+xcode []= ( a1 a2 u -- f )
+ CX pspop,
+ DI pspop,
+ si [ebp] mov,
+ ax ax xor,
+ repz, cmpsb,
+ al setz,
+ [ebp] ax mov,
+ ret,
+
+pc to lblareg 0 ,
+xcode >A
+ AX pspop,
+ lblareg m) ax mov,
+ ret,
+
+xcode A>
+ ax lblareg m) mov,
+ AX pspush,
+ ret,
+
+xcode Ac@
+ ax ax xor,
+ si lblareg m) mov,
+ al [esi] mov,
+ AX pspush,
+ ret,
+
+xcode Ac!
+ AX pspop,
+ si lblareg m) mov,
+ [esi] al mov,
+ ret,
+
+xcode A-
+ lblareg m) dec,
+ ret,
+
+xcode A+
+ lblareg m) inc,
+ ret,
+
+xcode A>r
+ ax lblareg m) mov,
+ ax sp 0 d) xchg,
+ ax jmp,
+
+xcode r>A
+ ax pop,
+ bx pop,
+ lblareg m) bx mov,
+ ax jmp,
+
pc $b8000 ,
xcode emit \ temporary, this is going in /drv/pc
AX pspop,
@@ -370,12 +467,12 @@ xcode maybeword ( -- str-or-0 )
ax push,
lbltoptr m) 0 i) mov,
pc ( loop1 )
- lblin< m) abs>rel call,
+ lblin< m) call,
AX pspop,
ax ax test,
L1 ( word_eof ) abs>rel js,
ax SPC 1+ i) cmp, \ is ws?
- ( loop1 ) abs>rel jc,
+ ( pc ) abs>rel jc, ( loop1 )
bx lblcurword 1+ i) mov,
pc ( loop2 )
bx 0 d) al mov,
@@ -630,8 +727,6 @@ xcode runword ( str -- ) pc lblcurrent pc>addr !
ret, \ TODO implement stack?
pc lblmainalias pc>addr !
- wcall, (s)
- 12 c, ," Hello World!"
pc ( loop )
wcall, word
wcall, runword
diff --git a/fs/xcomp/pc/boot.fs b/fs/xcomp/pc/boot.fs
@@ -1,21 +0,0 @@
-: immediate current 1- dup c@ $80 or swap c! ;
-: ['] ' litn ; immediate
-: to ['] ! [to] ;
-: to+ ['] +! [to] ;
-: to' ['] noop [to] ;
-: to@ ['] @ [to] ;
-: allot to+ here ;
-: compile ' litn ['] execute, execute, ; immediate
-: if compile (?br) here 4 allot ; immediate
-: ahead compile (br) here 4 allot ; immediate
-: then here swap ! ; immediate
-: c@+ dup 1+ swap c@ ;
-: else compile (br) here 4 allot here rot ! ; immediate
-: begin here ; immediate
-: again compile (br) , ; immediate
-: until compile (?br) , ; immediate
-: next compile (next) , ; immediate
-c@+ rtype
-: foo 5 >r begin r@ 'A' + emit next ; foo
-bye
-
diff --git a/fs/xcomp/pc/glue1.fs b/fs/xcomp/pc/glue1.fs
@@ -0,0 +1,3 @@
+: foo ." Hello World!" 5 >r begin r@ 'A' + emit next ; foo
+bye
+
