commit 376c70fbd0e803cd537ce444808dae81eb90d700
parent aa955b3e311a50f3f962181ce668c15d99bb9cad
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 16 Mar 2023 09:56:17 -0400
hal: i386 first steps
Not all those words written in the new kernel are tested, but at least we have
"runword" leading to "bye". It's a good chunk. I test that this words through
QEMU's "info registers": EDX is 42.
Diffstat:
6 files changed, 337 insertions(+), 703 deletions(-)
diff --git a/fs/asm/i386.fs b/fs/asm/i386.fs
@@ -3,10 +3,10 @@
\ "opcode+mod" structure (very close to i386 structure)
\ b2:0 regid
\ b5:3 zeroes except when register is a "special" one for mov,
-\ b7:6 mod ( displacement in "_disp" if present )
+\ b7:6 mod ( displacement in bank if present )
\ b8 0=8b 1=32/16b
\ b14:9 zeroes
-\ b15 immediate? ( value in "_imm" )
+\ b15 immediate? ( value in bank )
\ b16 opcode is 2 bytes (has $0f extension byte)
\ b17 16b?
\ b19:18 reserved
@@ -218,7 +218,7 @@ create _tbl $8c , $120 , $121 , $124 ,
@ over jrel8? if $70 or op, jrel8, else $180 or op, 1- jrel32, then ;
$4 op jz, $5 op jnz, $2 op jc, $3 op jnc,
$8 op js, $9 op jns, $c op jl, $d op jnl,
-$7 op ja, $6 op jna,
+$7 op ja, $6 op jna, $2 op jb, $6 op jbe,
: op ( opcode -- ) doer , does> ( rel a -- )
@ over jrel8? _assert op, jrel8, ;
@@ -248,14 +248,3 @@ $e2 op loop, $e1 op loopz, $e0 op loopnz,
of 8b? movzx, endof
of 16b? 32b) movzx, endof
mov, endcase ;
-
-\ Useful Dusk-related macros
-: [ebp] bp 0 d) ;
-: [ebp]z? [ebp] -1 i) test, ;
-: [esi] si 0 d) ;
-: ps+, bp CELLSZ i) sub, ;
-: ps-, bp CELLSZ i) add, ;
-: pspush, ( opmod -- ) ps+, [ebp] swap mov, ;
-: pspop, ( opmod -- ) [ebp] mov, ps-, ;
-\ equivalent to op1 pspop, then op2 pspop,
-: pspop2, ( op1 op2 -- ) bp CELLSZ d) mov, r) [ebp] mov, bp CELLSZ << i) add, ;
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -72,7 +72,7 @@ code 1- -1 W+n, exit,
code execute W>A, drop, branchA,
code not =0>Z, Z>W, exit,
code bool =0>Z, Z>W, 1 xorn, exit,
-: litn -4 ps+, PSP) !, LIT>W, ;
+: litn dup, LIT>W, ;
: if 0 =0>Z, Z) >branchC, ; immediate
: ahead 0 branch, ; immediate
: then HERE @ swap branch! ; immediate
diff --git a/fs/xcomp/bootlo2.fs b/fs/xcomp/bootlo2.fs
@@ -0,0 +1 @@
+bye
diff --git a/fs/xcomp/i386/kernel.fs b/fs/xcomp/i386/kernel.fs
@@ -1,14 +1,22 @@
\ This is the i386 Dusk kernel. It is called when the bootloader has finished
\ loading this binary as well as the Forth boot code following it in memory.
-\ We're in protected mode and all segments have been initialized. ESP and EBP
-\ are uninitialized. DI is the A register.
+\ We're in protected mode and all segments have been initialized.
+\ ESP=RSP SI=PSP DI=A EAX=W. They begin uninitialized.
+\ HAL operand structure is the same as asm/i386 opmod structure.
?f<< /asm/i386.fs
?f<< /xcomp/tools.fs
\ Macros
+: xnip, si CELLSZ i) add, ;
+: xdrop, ax si 0 d) mov, xnip, ;
+: xgrow, si CELLSZ i) sub, ;
+: xdup, xgrow, si 0 d) ax mov, ;
+: xlit, ( n -- ) xdup, ax swap i) mov, ;
: absjmp, abs>rel jmp, ;
: abscall, abs>rel call, ;
: wcall, xwordlbl abscall, ;
+: wjmp, xwordlbl absjmp, ;
+: xconst ( n -- ) xcode dup, ax swap i) mov, ret, ;
0 value lblintnoop
: idtgen ( entrycount -- ) for
lblintnoop $ffff and w, $08 w, 0 c, $8e c, lblintnoop 16 rshift w, next ;
@@ -16,18 +24,32 @@
\ Constants and labels
0 to realmode
: values ( n -- ) for 0 value next ;
-22 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
+21 values lblmainalias lblbootptr lblnextword lblcurword lblnextmeta lblret
lblsysdict lblparsec lblparseh lblparseud lblerrmsg lblhere lbl[rcnt]
- lblmovewrite lblwrite lblcwrite lblfind lblcompiling lblidt lblmod
- lblrelwr lblcallwr
+ lblwriterange lblfind lblcompiling lblidt lblmod
+ lblrelwr lblcallwr lblgrp1i
$8000 const HERESTART
$500 to binstart
$2000 const STACKSZ
$7c00 const RSTOP
$80000 const PSTOP
+$10 const HBANKCNT
PSTOP STACKSZ - const HEREMAX
-: movewrite, ( a u ) cx swap i) mov, si swap i) mov, lblmovewrite abscall, ;
+$1c0 const MODRM_AX
+$1c7 const MODRM_DI
+$1c6 const MODRM_SI
+$1c4 const MODRM_SP
+$100 const MODRM_[AX]
+$107 const MODRM_[DI]
+$106 const MODRM_[SI]
+$104 const MODRM_[SP]
+
+: _ dx lblhere m) mov, dx 0 d) swap mov, ;
+: cwrite, ( opmod -- ) _ lblhere m) inc, ;
+: wwrite, ( opmod -- ) _ lblhere m) 2 i) add, ;
+: dwrite, ( opmod -- ) _ lblhere m) 4 i) add, ;
+: movewrite, ( a u ) cx swap i) mov, bx swap i) mov, lblwriterange abscall, ;
\ Let's go!
0 align4 here to org
@@ -41,57 +63,36 @@ L1 forward!
lblidt m) lidt, sti,
forward16 jmp, to L1
-xcode IDT L2 i) pspush, ret,
-xcode CALLSZ 5 i) pspush, ret,
-xcode BRSZ 5 i) pspush, ret,
-xcode ?BRSZ 14 i) pspush, ret,
-
-xcode noop pc to lblret ret,
-
-xcode (cell)
- ax pop,
- ax pspush,
- ret,
-
-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,
- ax ax xor,
- lodsb, \ len
- si ax add, \ ret to PC right after str
- si jmp,
-
-xcode herestart
- HERESTART i) pspush,
- ret,
-
-pc HEREMAX ,
-xcode HEREMAX
- ( pc ) i) pspush,
- ret,
+L2 xconst IDT
+5 xconst CALLSZ
+5 xconst BRSZ
+15 xconst ?BRSZ
+HERESTART xconst herestart
+pc HEREMAX , xconst HEREMAX
pc to lblhere HERESTART ,
-xcode HERE
- lblhere i) pspush,
- ret,
-
+lblhere xconst HERE
pc to lblsysdict 0 , 0 c, \ 1b zero len field. see doc/arch
-xcode sysdict
- lblsysdict i) pspush,
- ret,
+lblsysdict xconst sysdict
+pc to lblmod 0 ,
+lblmod xconst MOD
+pc to lbl[rcnt] 0 ,
+lbl[rcnt] xconst [rcnt]
+pc to lblnextword 0 ,
+lblnextword xconst NEXTWORD
+pc to lblcurword $20 allot0
+lblcurword xconst curword
+pc to lblnextmeta 0 ,
+lblnextmeta xconst nextmeta
+
pc to lblcompiling 0 ,
xcode compiling
- ax lblcompiling m) mov,
- ax pspush,
- ret,
+ dup, ax lblcompiling m) mov, ret,
+
+xcode bye \ temporary word
+ dx 42 i) mov,
+ 0 jmp,
xcode quit
cld,
@@ -102,383 +103,281 @@ xcode quit
xcode (abort)
L1 forward!
- bp PSTOP i) mov,
- xwordlbl quit absjmp,
+ si PSTOP i) mov,
+ wjmp, quit
-xcode exit
- ax pop,
+\ HAL operands
+pc to L1 HBANKCNT CELLSZ * allot
+pc to L2 0 ,
+xcode hbank' ( idx -- a )
+ ax $0f i) and,
+ ax 2 i) shl,
+ ax L1 i) add,
ret,
-xcode execute
- ax pspop,
- ax jmp,
-
-xcode dup ( a -- a a )
- ax [ebp] mov,
- ax pspush,
+xcode @) ( operand -- n )
+ ax 20 i) shr,
+ wcall, hbank'
+ ax ax 0 d) mov,
ret,
-xcode ?dup ( a -- a? a )
- [ebp]z?
- xwordlbl dup abs>rel jnz,
+xcode hbank! ( operand n -- operand )
+ cx ax mov, \ cx=n
+ ax L2 m) mov,
+ L2 m) inc,
+ bx ax mov, \ bx=idx
+ wcall, hbank' \ ax=a
+ ax 0 d) cx mov,
+ xdrop, \ ax=operand
+ bx 20 i) shl,
+ ax bx or,
ret,
-xcode swap ( a b -- b a )
- ax [ebp] mov,
- bx bp CELLSZ d) mov,
- [ebp] bx mov,
- bp CELLSZ d) ax mov,
- ret,
+MODRM_[AX] xconst W)
+MODRM_[DI] xconst A)
+MODRM_[SI] xconst PSP)
+MODRM_[SP] xconst RSP)
-xcode over ( a b -- a b a )
- ax bp CELLSZ d) mov,
- ax pspush,
- ret,
+xcode m) ( a -- operand )
+ xdup,
+ si 0 d) $105 i) mov,
+ wjmp, hbank!
-xcode rot ( a b c -- b c a )
- ax [ebp] mov,
- bx bp CELLSZ d) mov,
- cx bp CELLSZ << d) mov,
- [ebp] cx mov,
- bp CELLSZ d) ax mov,
- bp CELLSZ << d) bx mov,
- ret,
+pc to L1 xdrop, ret,
+xcode +) ( operand n -- operand )
+ ax ax test, L1 abs>rel jz,
+ si 0 d) $40 i) or, \ disp8 mode
+ wjmp, hbank!
-xcode nip ( a b - b )
- ax pspop,
- [ebp] ax mov,
+\ Write routines
+pc to lblcallwr \ bx=abs addr
+ $e8 i) cwrite,
+pc to lblrelwr \ bx=abs addr
+ bx lblhere m) sub, \ displacement
+ bx 4 i) sub, \ ... from *after* call op
+ bx dwrite,
+pc to lblret
ret,
-xcode tuck ( a b -- b a b )
- ax [ebp] mov,
- bx bp CELLSZ d) mov,
- [ebp] bx mov,
- bp CELLSZ d) ax mov,
- ax pspush,
+pc to lblwriterange \ bx=addr cx=u
+ di push, si push,
+ si bx mov,
+ di lblhere m) mov,
+ lblhere m) cx add,
+ rep, movsb,
+ si pop, di pop,
ret,
-xcode rot> ( a b c -- c a b )
- ax [ebp] mov,
- bx bp CELLSZ d) mov,
- cx bp CELLSZ << d) mov,
- [ebp] bx mov,
- bp CELLSZ d) cx mov,
- bp CELLSZ << d) ax mov,
- ret,
+\ Group1 op (add, sub, etc.)
+pc to lblgrp1i \ bx=dstmodrm cx=i dx=reg
+ dx 3 i) shl,
+ bx dx or,
+ cx $100 i) cmp, forward8 jb,
+ $81 cwrite, bl cwrite, cx dwrite, ret,
+ forward!
+ $83 cwrite, bl cwrite, cl cwrite, ret,
-xcode scnt
- ax PSTOP i) mov,
- ax bp sub,
- ax 16b) 2 i) shr, \ div by 4, preserve neg
- ax pspush,
- ret,
+\ Assembler words
+xcode rs+, ( n -- ) \ sp XX i) add,
+ bx MODRM_SP i) mov, cx ax mov, dx dx xor, ( add ) lblgrp1i abscall,
+ lbl[rcnt] m) ax add,
+ xdrop, ret,
-xcode rcnt
- ax RSTOP i) mov,
- ax sp sub,
- ax 16b) 2 i) shr, \ div by 4, preserve neg
- ax dec, \ ignore this call
- ax pspush,
- ret,
+xcode ps+, ( n -- ) \ si XX i) add,
+ bx MODRM_SI i) mov, cx ax mov, dx dx xor, ( add ) lblgrp1i abscall,
+ xdrop, ret,
-xcode 1+
- [ebp] inc,
+pc to L1
+ ax dwrite, xdrop,
ret,
-xcode 1-
- [ebp] dec,
- ret,
+xcode LIT>W, ( n -- ) \ ax XX i) mov,
+ $b8 i) cwrite, L1 absjmp,
-xcode +
- ax pspop,
- [ebp] ax add,
- ret,
+xcode LIT>A, ( n -- ) \ di XX i) mov,
+ $bf i) cwrite, L1 absjmp,
-xcode -
- ax pspop,
- [ebp] ax sub,
- ret,
+xcode W+n, ( n -- ) \ ax XX i) add,
+ $05 i) cwrite, L1 absjmp,
-xcode *
- ax pspop,
- [ebp] mul,
- [ebp] ax mov,
- ret,
+xcode A+n, ( n -- ) \ di XX i) add,
+ $c781 i) wwrite, L1 absjmp,
-xcode /mod ( a b -- r q )
- ax bp CELLSZ d) mov,
- dx dx xor,
- [ebp] div,
- bp CELLSZ d) dx mov, \ remainder
- [ebp] ax mov, \ quotient
- ret,
+xcode W>A, ( n -- ) \ di ax mov,
+ $c789 i) wwrite, ret,
-xcode <<c
- 0 i) pspush,
- bp CELLSZ d) 1 i) shl,
- [ebp] setc,
- ret,
+xcode W<>A, ( n -- ) \ di ax xchg,
+ $97 i) cwrite, ret,
-xcode >>c
- 0 i) pspush,
- bp CELLSZ d) 1 i) shr,
- [ebp] setc,
+xcode !, ( operand -- ) \ operand ax mov,
+ ax $8800 i) or,
+ al ah xchg,
+ ax wwrite,
+ xdrop,
ret,
-xcode lshift ( n u -- n )
- cx pspop,
- [ebp] cl shl,
- ret,
+xcode dup,
+ -4 xlit, wcall, ps+,
+ wcall, PSP)
+ wjmp, !,
-xcode rshift ( n u -- n )
- cx pspop,
- [ebp] cl shr,
- ret,
+xcode litn
+ wcall, dup,
+ wjmp, LIT>W,
-xcode and
- ax pspop,
- [ebp] ax and,
- ret,
+pc 3 nc, $5b $ff $d3 \ bx pop, bx call,
+xcode yield ximm
+ ( pc ) 3 movewrite, ret,
-xcode or
- ax pspop,
- [ebp] ax or,
- ret,
+xcode execute,
+ bx ax mov, xdrop,
+ lblcallwr absjmp,
-xcode xor
- ax pspop,
- [ebp] ax xor,
+xcode exit,
+ $c3 ( ret ) i) cwrite,
ret,
-xcode bool
- ax [ebp] mov,
- [ebp] 0 i) mov,
- ax ax test,
- [ebp] setnz,
+xcode branch,
+ $e9 ( jmp ) i) cwrite,
+pc to L1
+ bx ax mov,
+ lblrelwr abscall,
+ ax lblhere m) mov,
+ ax 4 i) sub,
ret,
-xcode not
- ax [ebp] mov,
- [ebp] 0 i) mov,
- ax ax test,
- [ebp] setz,
- ret,
+\ bx ax mov, xdrop, bx bx test, XX jz,
+pc 11 nc, $89 $c3 $8b $06 $83 $c6 $04 $85 $db $0f $84
+xcode ?branch,
+ ( pc ) 11 movewrite,
+ L1 absjmp,
-xcode <
- ax pspop,
- [ebp] ax sub,
- [ebp] 0 i) mov,
- [ebp] setc,
+xcode branch!
+ bx si 0 d) mov, xnip, \ ax=a bx=n
+ bx ax sub, \ displacement
+ bx 4 i) sub, \ ... from *after* call/jmp op
+ ax 0 d) bx mov,
+ xdrop,
ret,
-\ Following words have binary modulator subwords
+\ Regular words
+xcode execute
+ bx ax mov,
+ xdrop,
+ bx jmp,
-xcode c@
- ax [ebp] mov, \ ax=a
- bx ax 0 d) 8b) movzx,
- [ebp] bx mov,
- ret,
+xcode -
+ si 0 d) ax sub,
+ xdrop, ret,
-pc 0 , EMETA_8B ,
- xwordlbl c@ absjmp,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- ax [ebp] mov, \ ax=a
- bx ax 0 d) movzx,
- [ebp] bx mov,
- ret,
-xcode @ ( a -- n )
- ax [ebp] mov, \ ax=a
- ax ax 0 d) mov,
- [ebp] ax mov,
- ret,
+xcode *
+ si 0 d) mul,
+ xnip, ret,
-xcode c!
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) bl mov,
+xcode /mod ( a b -- r q )
+ bx ax mov, ax si 0 d) mov,
+ dx dx xor,
+ bx div,
+ si 0 d) dx mov, \ remainder
ret,
-pc 0 , EMETA_8B ,
- xwordlbl c! absjmp,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) 16b) bx mov,
- ret,
-xcode ! ( n a -- )
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) bx mov,
+xcode lshift ( n u -- n )
+ cx ax mov, xdrop,
+ ax cl shl,
ret,
-pc 0 , EMETA_8B ,
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) bl add,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) 16b) bx add,
- ret,
-xcode +! ( n a -- )
- ax bx pspop2, \ ax=a bx=n
- ax 0 d) bx add,
+xcode rshift ( n u -- n )
+ cx ax mov, xdrop,
+ ax cl shr,
ret,
-xcode c,
- ax pspop, \ ax=n
-pc to lblcwrite \ al=c preserves bx
- si lblhere m) mov,
- [esi] al mov,
- lblhere m) inc,
- ret,
+xcode and
+ ax si 0 d) and,
+ xnip, ret,
-pc 0 , EMETA_8B ,
- xwordlbl c, absjmp,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- ax pspop, \ ax=n
- si lblhere m) mov,
- [esi] 16b) ax mov,
- lblhere m) 2 i) add,
- ret,
-xcode ,
- ax pspop, \ ax=n
-pc to lblwrite \ ax=n
- si lblhere m) mov,
- [esi] ax mov,
- lblhere m) 4 i) add,
- ret,
+xcode or
+ ax si 0 d) or,
+ xnip, ret,
+
+xcode xor
+ ax si 0 d) xor,
+ xnip, ret,
+
+xcode <
+ bx ax mov,
+ ax ax xor,
+ si 0 d) bx cmp,
+ al setc,
+ xnip, ret,
xcode pc@ ( port -- n8 )
- dx [ebp] mov,
+ dx ax mov,
ax ax xor,
al dx in,
- [ebp] ax mov,
ret,
xcode pc! ( n8 port -- )
- dx ax pspop2,
+ dx ax mov, xdrop,
al dx out,
ret,
xcode pw@ ( port -- n16 )
- dx [ebp] mov,
+ dx ax mov,
ax ax xor,
ax 16b) dx in,
- [ebp] ax mov,
ret,
xcode pw! ( n16 port -- )
- dx ax pspop2,
+ dx ax mov, xdrop,
ax 16b) dx out,
ret,
xcode p@ ( port -- n32 )
- dx [ebp] mov,
+ dx ax mov,
ax ax xor,
ax dx in,
- [ebp] ax mov,
ret,
xcode p! ( n32 port -- )
- dx ax pspop2,
+ dx ax mov, xdrop,
ax dx out,
ret,
-xcode move ( src dst u -- )
- cx pspop,
- di si pspop2,
- cx cx test,
- lblret abs>rel jz,
- rep, movsb,
- ret,
-
-xcode move, ( src u -- )
- cx si pspop2,
- 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,
-
-xcode []= ( a1 a2 u -- f )
- cx di pspop2,
- si [ebp] mov,
- ax ax xor,
- repz, cmpsb,
- al setz,
- [ebp] ax mov,
- ret,
-
xcode align4 ( n -- )
- ax pspop,
ax lblhere m) add,
ax 3 i) and,
lblret abs>rel jz,
lblhere m) ax sub,
lblhere m) 4 i) add,
- ret,
+ xdrop, ret,
-pc to lbl[rcnt] 0 ,
-xcode [rcnt]
- lbl[rcnt] i) pspush,
- ret,
-
-pc 2 nc, $83 $c4 ( XX ) \ sp XX i) add,
-xcode r+, ( n -- )
- ( pc ) 2 movewrite,
- ax pspop,
- lbl[rcnt] m) ax add,
- lblcwrite absjmp,
-
-pc 2 nc, $83 $c5 ( XX ) \ bp XX i) add,
-xcode p+, ( n -- )
- ( pc ) 2 movewrite,
- ax pspop,
- lblcwrite absjmp,
-
-pc 3 nc, $58 $ff $d0 \ ax pop, ax call,
-xcode yield ximm
- ( pc ) 3 movewrite, ret,
-
-xcode rtype xwordlbl (abort) absjmp,
+xcode rtype wjmp, (abort)
\ During early boot, it's better to halt the machine than to go back to the
\ mainloop because the mainloop likely sends us to an infinite error loop
\ through boot<.
pc ," boot failure"
xcode abort
- ( pc ) i) pspush,
- 12 i) pspush,
+ si 0 d) swap ( pc ) i) mov,
+ ax 12 i) mov,
wcall, rtype
0 jmp,
0 align4 pc to lblbootptr 0 ,
xcode boot<
- si lblbootptr m) mov,
- ax [esi] 8b) movzx,
+ dx lblbootptr m) mov,
+ xdup, ax dx 0 d) 8b) movzx,
lblbootptr m) inc,
- ax pspush,
ret,
\ where "word" feeds itself
-xcode in< xwordlbl boot< absjmp,
+xcode in< wjmp, boot<
3 allot \ that last jump is a rel8, we need more space.
-pc to lblnextword 0 ,
-xcode NEXTWORD
- lblnextword i) pspush,
- ret,
-
-pc to lblcurword $20 allot0
-xcode curword
- lblcurword i) pspush,
- ret,
-
pc to L1 ( word_eof )
- ax ax xor,
- ax pspush,
- ret,
-
+ ax ax xor, ret,
pc \ we have a nonzero lblnextword
+ si push, di push,
si lblnextword m) mov,
lblnextword m) 0 i) mov,
cx cx xor,
@@ -486,15 +385,16 @@ pc \ we have a nonzero lblnextword
cl inc,
di lblcurword i) mov,
rep, movsb,
- lblcurword i) pspush,
+ di pop, si pop,
+ ax lblcurword i) mov,
ret,
xcode maybeword ( -- str-or-0 )
+ xdup, \ reserve wiggle room on PS.
lblnextword m) -1 i) test,
( pc ) abs>rel jnz,
pc ( loop1 )
- wcall, in<
- ax pspop,
+ wcall, in< xnip,
ax ax test,
L1 ( word_eof ) abs>rel js,
ax SPC 1+ i) cmp, \ is ws?
@@ -504,9 +404,8 @@ pc ( loop2 )
bx 0 d) al mov,
bx inc,
bx push,
- wcall, in<
+ wcall, in< xnip,
bx pop,
- ax pspop,
ax ax test,
forward js, to L1 ( stoploop )
ax SPC 1+ i) cmp, \ is ws?
@@ -514,26 +413,24 @@ pc ( loop2 )
L1 forward! ( stoploop )
bx lblcurword 1+ i) sub,
lblcurword m) bl mov,
- lblcurword i) pspush,
+ ax lblcurword i) mov,
ret,
pc ," word expected"
xcode word
wcall, maybeword
- [ebp]z?
+ ax ax test,
lblret abs>rel jnz,
cx 13 i) mov,
- si swap ( pc ) i) mov,
-pc to lblerrmsg \ exc=sl esi=sa
- si pspush,
- cx pspush,
+ bx swap ( pc ) i) mov,
+pc to lblerrmsg \ ecx=sl ebx=sa
+ xdup, ax bx mov, xdup, ax cx mov,
wcall, rtype
- xwordlbl abort absjmp,
+ wjmp, abort
xcode findmeta ( id ll -- ll-or-0 )
- ax pspop,
- bx [ebp] mov,
-pc to L1
+ bx si 0 d) mov, xnip,
+pc to L1 \ bx=id
ax ax test,
forward8 jz,
bx ax 4 d) cmp,
@@ -541,105 +438,86 @@ pc to L1
ax ax 0 d) mov,
L1 absjmp,
forward! forward!
- [ebp] ax mov,
- ret,
-
-pc to lblmod 0 ,
-xcode MOD
- lblmod i) pspush,
ret,
xcode findmod ( w -- w )
lblmod m) -1 i) test,
- forward8 jnz, ret, forward!
- ax [ebp] mov,
+ lblret abs>rel jz,
ax 9 i) sub,
bx lblmod m) mov,
- bx pspush, ax pspush,
- wcall, findmeta
- ax pspop,
+ L1 abs>rel call,
ax ax test,
- forward8 jz,
- lblmod m) 0 i) mov,
- ax 8 i) add,
- [ebp] ax mov,
- forward!
+ lblret abs>rel jz,
+ lblmod m) 0 i) mov,
+ ax 8 i) add,
ret,
xcode find ( str 'dict -- word-or-0 )
- dx pspop,
-pc to lblfind
- si [ebp] mov,
- cx [esi] 8b) movzx,
- [ebp] inc,
+ dx ax mov, xdrop,
+pc to lblfind \ ax=str dx='dict
+ cx ax 0 d) 8b) movzx, \ cx=sz
+ ax inc,
+ di push, si push,
pc ( loop )
- di dx mov, \ entry
- al di 4 d) mov, \ len
- al $3f i) and, \ 3f instead of 7f? we reserve space for another flag.
- al cl cmp,
+ bl dx 4 d) mov, \ entry len
+ bl $3f i) and, \ 3f instead of 7f? we reserve space for another flag.
+ bl cl cmp,
forward jnz, to L1 ( skip1 )
\ same length
+ di dx mov,
di 4 i) sub,
di cx sub, \ beginning of name range
- si [ebp] mov,
+ si ax mov,
repz, cmpsb,
forward jnz, to L2 ( skip2 )
\ same contents
+ si pop, di pop,
dx 5 i) add, \ word
- [ebp] dx mov,
- xwordlbl findmod absjmp,
+ ax dx mov,
+ wjmp, findmod
L2 forward! ( skip2 )
- cl al mov,
+ cl bl mov,
L1 forward! ( skip1 )
dx dx 0 d) mov,
dx dx test,
( pc ) abs>rel jnz, ( loop )
\ not found
- [ebp] 0 i) mov,
+ si pop, di pop,
+ ax ax xor,
ret,
pc ," word not found"
xcode (wnf)
- lblcurword 1+ i) pspush,
- cx lblcurword m) 8b) movzx,
- cx pspush,
+ xdup, ax lblcurword 1+ i) mov,
+ xdup, ax lblcurword m) 8b) movzx,
wcall, rtype
cx 15 i) mov,
- si swap ( pc ) i) mov,
+ bx swap ( pc ) i) mov,
lblerrmsg absjmp,
-xcode ' ( "name" -- w )
- wcall, word
- dx lblsysdict m) mov,
- lblfind abscall,
- [ebp]z?
- xwordlbl (wnf) abs>rel jz,
- ret,
-
0 align4 pc to L1 \ parse unsuccessful
- [ebp] 0 i) mov,
+ ax ax xor,
ret,
-0 align4 pc to lblparsec ( str -- n? f ) \ esi=sa ecx=sl
+0 align4 pc to lblparsec ( str -- n? f ) \ eax=sa ecx=sl
cx 3 i) cmp,
L1 abs>rel jnz, \ fail
- si 2 d) 8b) ''' i) cmp,
+ ax 2 d) 8b) ''' i) cmp,
L1 abs>rel jnz, \ fail
- ax ax xor,
- al si 1 d) mov,
- [ebp] ax mov,
- 1 i) pspush,
+ ax ax 0 d) 8b) movzx,
+ xdup,
+ ax 1 i) mov,
ret,
-0 align4 pc to lblparseh ( str -- n? f ) \ esi=sa ecx=sl
+0 align4 pc to lblparseh ( str -- n? f ) \ eax=sa ecx=sl
cx 2 i) cmp,
L1 abs>rel jc, \ fail
- si inc, \ skip $
+ ax inc, \ skip $
cx dec,
- ax ax xor,
+ dx dx xor,
bx bx xor,
pc ( loop )
- bl [esi] mov,
+ bl ax 0 d) mov,
bl $20 i) or,
bl '0' i) sub,
L1 abs>rel jc, \ fail
@@ -651,289 +529,50 @@ pc ( loop )
bl 16 i) cmp,
L1 abs>rel jnc, \ fail
L2 forward! \ parse ok
- ax 4 i) shl, \ res*16
- ax bx add,
- si inc,
+ dx 4 i) shl, \ res*16
+ dx bx add,
+ ax inc,
( pc ) abs>rel loop, ( loop )
- [ebp] ax mov,
- 1 i) pspush,
+ xgrow,
+ si 0 d) dx mov,
+ ax 1 i) mov,
ret,
-0 align4 pc to lblparseud ( str -- n? f ) \ esi=sa ecx=sl
+0 align4 pc to lblparseud ( str -- n? f ) \ eax=sa ecx=sl
cx cx test,
L1 abs>rel jz, \ fail
- ax ax xor, \ res
+ bx ax mov, \ bx=str
+ ax ax xor, \ ax=res
pc ( loop )
- bx 10 i) mov,
- bx mul,
- bl [esi] mov,
- bl '0' i) sub,
+ dx 10 i) mov,
+ dx mul,
+ dx bx 0 d) 8b) movzx,
+ dl '0' i) sub,
L1 abs>rel jc, \ fail
- bl 10 i) cmp,
+ dl 10 i) cmp,
L1 abs>rel jnc, \ fail
- ax bx add,
- si inc,
+ ax dx add,
+ bx inc,
( pc ) abs>rel loop, ( loop )
- [ebp] ax mov,
- 1 i) pspush,
+ xdup, ax 1 i) mov,
ret,
xcode parse ( str -- n? f )
- si [ebp] mov,
- cx [esi] 8b) movzx,
- si inc,
- [esi] 8b) ''' i) cmp,
+ cx ax 0 d) 8b) movzx,
+ ax inc,
+ ax 0 d) 8b) ''' i) cmp,
lblparsec abs>rel jz,
- [esi] 8b) '$' i) cmp,
+ ax 0 d) 8b) '$' i) cmp,
lblparseh abs>rel jz,
- [esi] 8b) '-' i) cmp,
+ ax 0 d) 8b) '-' i) cmp,
lblparseud abs>rel jnz,
- si inc,
+ ax inc,
cx dec,
lblparseud abscall,
- [ebp]z?
- L1 abs>rel jz, \ fail
- bp CELLSZ d) neg,
- ret,
-
-pc 7 nc, 'n' LF 'r' CR '0' 0 0
-xcode "<
- wcall, in<
- [ebp] '"' i) cmp,
- forward jnz,
- [ebp] -1 i) mov,
- ret,
- forward!
- [ebp] '\' i) cmp,
- lblret abs>rel jnz,
- ps-,
- wcall, in<
- si swap ( pc ) i) mov,
-pc
- lodsb,
- al al test,
- lblret abs>rel jz,
- [ebp] al cmp,
- lodsb,
- ( pc ) abs>rel jnz,
- [ebp] al mov,
- ret,
-
-xcode ,"
- wcall, "<
- ax pspop,
ax ax test,
- lblret abs>rel js,
- xwordlbl ," i) push,
- lblcwrite absjmp,
-
-pc to lblnextmeta 0 ,
-xcode nextmeta
- lblnextmeta i) pspush,
- ret,
-
-pc 6 nc, $83 $ed $04 $c7 $45 $00 ( XX ) \ bp 4 i) sub, [ebp] XX i) mov,
-xcode litn
- ( pc ) 6 movewrite,
- xwordlbl , absjmp,
-
-pc to lblcallwr \ bx=abs addr
- al $e8 ( call ) i) mov,
- lblcwrite abscall,
- ax bx mov,
-pc to lblrelwr \ ax=abs addr
- ax lblhere m) sub, \ displacement
- ax 4 i) sub, \ ... from *after* call op
- lblwrite absjmp,
-
-xcode execute,
- bx pspop,
- lblcallwr absjmp,
-
-xcode exit,
- al $c3 ( ret ) i) mov,
- lblcwrite absjmp,
-
-xcode branch,
- al $e9 ( jmp ) i) mov, lblcwrite abscall,
- ax pspop,
- lblrelwr abscall,
- ax lblhere m) mov,
- ax 4 i) sub,
- ax pspush,
- ret,
-
-pc 10 nc, $8b $45 $00 $83 $c5 $04 $85 $c0 $0f $84 \ ax pspop, ax ax test, XX jz,
-xcode ?branch,
- ( pc ) 10 movewrite,
- ax pspop,
- lblrelwr abscall,
- ax lblhere m) mov,
- ax 4 i) sub,
- ax pspush,
- ret,
-
-xcode branch!
- ax bx pspop2, \ ax=a bx=n
- bx ax sub, \ displacement
- bx 4 i) sub, \ ... from *after* call/jmp op
- ax 0 d) bx mov,
- ret,
-
-pc 2 nc, $89 $e7 \ di sp mov,
-xcode RSP>A,
- ( pc ) 2 movewrite, ret,
-
-pc 2 nc, $89 $ef \ di bp mov,
-xcode PSP>A,
- ( pc ) 2 movewrite, ret,
-
-xcode LIT>A, \ di XX i) mov, --> BF XX
- al $bf i) mov, lblcwrite abscall,
- xwordlbl , absjmp,
-
-pc 6 nc, $8b $7d $00 $83 $c5 $04 \ di [ebp] mov, [ebp] 4 i) add,
-xcode >A, \ di [ebp] mov, [ebp] 4 i) add, --> 8b 7d 00 83 c5 04
- ( pc ) 6 movewrite, ret,
-
-pc 6 nc, $83 $ed $04 $89 $7d $00 \ [ebp] 4 i) sub, [ebp] di mov,
-xcode A>,
- ( pc ) 6 movewrite, ret,
-
-pc 2 nc, $81 $c7 ( XX ) \ di XX i) add,
-xcode A+,
- ( pc ) 2 movewrite,
- xwordlbl , absjmp,
-
-pc 2 nc, $81 $07 ( XX ) \ di 0 d) XX i) add,
-xcode [A]+,
- ( pc ) 2 movewrite,
- xwordlbl , absjmp,
-
-pc to L1 \ 8b A@
- ax di 0 d) 8b) movzx,
- ax pspush,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b A@
- ax di 0 d) movzx,
- ax pspush,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ A@
- ax di 0 d) mov,
- ax pspush,
- ret,
-xcode A@,
- bx L1 i) mov, lblcallwr absjmp,
-
-pc to L1 \ 8b A!
- ax pspop,
- di 0 d) al mov,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b A!
- ax pspop,
- di 0 d) 16b) ax mov,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ A!
- ax pspop,
- di 0 d) ax mov,
- ret,
-xcode A!,
- bx L1 i) mov, lblcallwr absjmp,
-
-pc to L1 \ 8b A@!
- ax ax xor,
- al [ebp] mov,
- al di 0 d) xchg,
- [ebp] ax mov,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b A@!
- ax ax xor,
- ax 16b) [ebp] mov,
- ax 16b) di 0 d) xchg,
- [ebp] ax mov,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ A@!
- ax [ebp] mov,
- ax di 0 d) xchg,
- [ebp] ax mov,
- ret,
-xcode A@!,
- bx L1 i) mov, lblcallwr absjmp,
-
-pc to L1 \ 8b A+!
- ax pspop,
- di 0 d) al add,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b A+!
- ax pspop,
- di 0 d) 16b) ax add,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ A+!
- ax pspop,
- di 0 d) ax add,
- ret,
-xcode A+!,
- bx L1 i) mov, lblcallwr absjmp,
-
-pc to L1 \ 8b [A]@
- ax di 0 d) mov,
- ax ax 0 d) 8b) movzx,
- ax pspush,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b [A]@
- ax di 0 d) mov,
- ax ax 0 d) movzx,
- ax pspush,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ [A]@
- ax di 0 d) mov,
- ax ax 0 d) mov,
- ax pspush,
- ret,
-xcode [A]@,
- bx L1 i) mov, lblcallwr absjmp,
-
-pc to L1 \ 8b [A]!
- bx di 0 d) mov,
- ax pspop,
- bx 0 d) al mov,
- ret,
-pc 0 , EMETA_8B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ 16b [A]!
- bx di 0 d) mov,
- ax pspop,
- bx 0 d) 16b) ax mov,
- ret,
-pc nextmeta ! ( pc ) , EMETA_16B ,
- bx L1 i) mov, lblcallwr absjmp,
-pc to L1 \ [A]!
- bx di 0 d) mov,
- ax pspop,
- bx 0 d) ax mov,
+ L1 abs>rel jz, \ fail
+ si 0 d) neg,
ret,
-xcode [A]!,
- bx L1 i) mov, lblcallwr absjmp,
xcode [ ximm
lblcompiling m) 0 i) mov,
@@ -945,50 +584,49 @@ xcode ]
pc ," stack underflow"
xcode stack?
- bp PSTOP i) cmp,
+ si PSTOP i) cmp,
lblret abs>rel jna,
cx 15 i) mov,
- si swap ( pc ) i) mov,
+ bx swap ( pc ) i) mov,
lblerrmsg absjmp,
pc to L2 \ find in sys dict
- lblcurword i) pspush,
+ ax lblcurword i) mov,
dx lblsysdict m) mov,
lblfind abscall,
- [ebp]z?
+ ax ax test,
xwordlbl (wnf) abs>rel jz,
ret,
pc to L1 \ execute imm word
wcall, execute
- xwordlbl stack? absjmp,
+ wjmp, stack?
xcode compword ( str -- )
wcall, parse
- ax pspop,
- ax ax test,
+ bx ax mov, xdrop,
+ bx bx test,
xwordlbl litn abs>rel jnz, \ literal: jump to litn
\ not a literal, find and compile
- L2 abscall,
- ax [ebp] mov, \ w
- ax dec,
- ax 0 d) 8b) $80 i) test,
+ L2 abscall, \ ax=w
+ ax -1 d) 8b) $80 i) test,
L1 abs>rel jnz, \ immediate? execute
\ compile word
- xwordlbl execute, absjmp,
+ wjmp, execute,
xcode runword ( str -- ) pc w>e lblsysdict pc>addr !
lblcompiling m) -1 i) test,
xwordlbl compword abs>rel jnz,
wcall, parse
- ax pspop,
ax ax test,
- xwordlbl noop abs>rel jnz, \ literal: nothing to do
+ lblret abs>rel jnz, \ literal: nothing to do
\ not a literal, find and execute
L2 abscall,
- ax pspop,
- ax call,
- xwordlbl stack? absjmp,
+ L1 absjmp,
+
+\ Constants that override compile-time constant names and must come last
+PSTOP xconst PSTOP
+RSTOP xconst RSTOP
xcode main
lblmainalias forward!
diff --git a/fs/xcomp/i386/pc/build.fs b/fs/xcomp/i386/pc/build.fs
@@ -34,7 +34,7 @@ org value kernel
: setupFAT ( drv clustercnt -- fat )
." creating FAT and copying files\n"
- createFAT bootfs over copyfs ;
+ createFAT ( bootfs over copyfs ) ;
: spitfile ( fpath dst -- ) >r
curpath :find# Path :open begin ( fc )
@@ -58,7 +58,7 @@ org value kernel
: spitBoot ( iohdl -- ) >r \ V1=iohdl
." Putting kernel in place\n"
kernel kernellen V1 IO :write
- S" /xcomp/bootlo.fs" V1 spitfile
+ S" /xcomp/bootlo2.fs" V1 spitfile
S" /drv/pc/int13h.fs" V1 spitfile
S" /fs/fatlo.fs" V1 spitfile
S" /xcomp/i386/pc/glue.fs" V1 spitfile
diff --git a/fs/xcomp/i386/pc/kernel.fs b/fs/xcomp/i386/pc/kernel.fs
@@ -23,20 +23,22 @@ pc to L4 \ segment with ffff limits
0 to realmode
xcode int13h ( drv head cyl sec dst -- )
- bx pspop,
- ax pspop, cl al mov, \ sec
- ax pspop, ch al mov, \ cyl
- ax pspop, dh al mov, \ head
- ax pspop, dl al mov, \ drive
+ bx ax mov, xdrop,
+ cl al mov, xdrop, \ sec
+ ch al mov, xdrop, \ cyl
+ dh al mov, xdrop, \ head
+ dl al mov, xdrop, \ drive
cli, $18 L4 jmpfar,
pc to L1 \ back to protected mode!
- \ we still need to push di, bx and ax
dx $10 i) mov, ds dx mov, ss dx mov, es dx mov, gs dx mov, fs dx mov,
- bx pspush, ax pspush,
- lblidt m) lidt, sti,
- \ restore PIC masks
+ \ restore PIC masks while preserving ax
+ cx ax mov,
ax pop, al $a1 i) out, al ah mov, al $21 i) out,
+ ax cx mov,
+ \ we still need to push bx and ax
+ xgrow, si 0 d) bx mov, ( -- bx ax )
+ lblidt m) lidt, sti,
ret,
pc to L3 1 to realmode \ we're in realmode
@@ -55,10 +57,14 @@ pc to L4 \ segment with ffff limits
0 to realmode
xcode int10h ( cx/dx bx ax -- bx ax )
- \ save PIC masks and disable PIC for duration of int10h
+ \ save PIC masks and disable PIC for duration of int10h, preserve ax
+ cx ax mov,
al $21 i) in, ah al mov, al $a1 i) in, ax push,
al $ff i) mov, al $21 i) out, al $a1 i) out,
- ax pspop, bx pspop, cx pspop, cli, $18 L4 jmpfar,
+ ax cx mov,
+ bx si 0 d) mov, xnip,
+ cx si 0 d) mov, xnip,
+ cli, $18 L4 jmpfar,
\ To avoid lockups, we map all PIC IRQs on boot to words that acknowledge those
\ IRQs. The rest of PIC initialization is done in /drv/pc/pic.fs
