153 lines
4.2 KiB
Plaintext
Executable file
153 lines
4.2 KiB
Plaintext
Executable file
array ops 2 allot
|
|
array optypes 2 allot
|
|
var currop
|
|
: op1 ops @ ;
|
|
: op2 ops 1 + @ ;
|
|
|
|
0 const OP_NONE
|
|
1 const OP_REG8
|
|
2 const OP_REG16
|
|
3 const OP_SREG
|
|
4 const OP_IMM
|
|
5 const OP_INDIRECT
|
|
|
|
: op! ( op type ) currop @ >r optypes r@ + ! ops r@ + ! 1 r> + currop ! ;
|
|
|
|
: mkreg makedo , does> @ swap makedo , , does> dup @ swap 1 + @ op! ;
|
|
OP_REG8 mkreg reg8
|
|
OP_REG16 mkreg reg16
|
|
OP_SREG mkreg sreg
|
|
OP_INDIRECT mkreg ireg
|
|
0 reg16 ax 0 reg8 al 4 reg8 ah
|
|
1 reg16 cx 1 reg8 cl 5 reg8 ch
|
|
2 reg16 dx 2 reg8 dl 6 reg8 dh
|
|
3 reg16 bx 3 reg8 bl 7 reg8 bh
|
|
4 reg16 sp 5 reg16 bp 6 reg16 si 7 reg16 di
|
|
0 sreg es 1 sreg cs 2 sreg ss 3 sreg ds
|
|
0 ireg [ax] 1 ireg [cx] 2 ireg [dx] 3 ireg [bx]
|
|
5 ireg [bp] 6 ireg [si] 7 ireg [di]
|
|
|
|
: # OP_IMM op! ;
|
|
|
|
&h80 const LBL_REL
|
|
var lblfixup var currlbl
|
|
|
|
: currlbl-head currlbl @ 1 + ;
|
|
: mk-lbl-fixpoint
|
|
here currlbl-head @ , tell , lblfixup @ , currlbl-head ! ;
|
|
|
|
: tell>addr &h100 + ;
|
|
|
|
: :> makedo tell , 0 , does> 0 # currlbl ! ;
|
|
: fixlabel.rel currlbl @ @ tell - &hff & tell 1 - seek outb! ;
|
|
: fixlabel.addr currlbl @ @ tell>addr tell 2 - seek outw! ;
|
|
: fixlabel ( fixtype -- ) if fixlabel.rel else fixlabel.addr then ;
|
|
: fixpoint.seek ( p -- ) 1 + @ seek ;
|
|
: fixpoint.fix ( p -- ) 2 + @ fixlabel ;
|
|
: fixpoint ( p -- next ) dup fixpoint.seek dup fixpoint.fix @ ;
|
|
|
|
: fix.fixpoints currlbl-head @ begin dup while fixpoint repeat drop ;
|
|
|
|
: assembled ( success -- )
|
|
currlbl @ and if
|
|
lblfixup @ fixlabel
|
|
mk-lbl-fixpoint
|
|
then 0 currop ! 0 lblfixup ! 0 currlbl ! ;
|
|
|
|
: update.label tell currlbl @ ! ;
|
|
: <: update.label tell fix.fixpoints seek 0 assembled ;
|
|
|
|
: read-impl ( p -- next cp optypes )
|
|
dup @ swap
|
|
dup 1 + @ swap
|
|
2 + ;
|
|
|
|
: match-impl ( optypes opcount -- b )
|
|
begin dup 0 > while
|
|
1 - 2dup + @ over optypes + @ !=
|
|
if drop drop 0 ret then
|
|
repeat drop drop 1 ;
|
|
|
|
|
|
: inst ( opcount|lblfixup -- ) makedo dup &h7f & , 0 , &h80 & , does>
|
|
dup 2 + @ lblfixup !
|
|
dup @ currop @ != if 0 message yelp ret then
|
|
1 + @ begin dup while
|
|
read-impl currop @ match-impl
|
|
if execute drop 1 assembled ret else drop then
|
|
repeat drop 1 message yelp 0 assembled ;
|
|
|
|
: inst-nextimpl do.data 1 + ;
|
|
: inst-opcount do.data @ ;
|
|
|
|
: impl ( [optype...] cp cpinst -- )
|
|
here >r >r ( r: impl inst )
|
|
r@ inst-nextimpl @ , ,
|
|
r@ inst-opcount begin dup while 1 - swap , repeat drop
|
|
r> inst-nextimpl r> swap ! ;
|
|
|
|
: :+r anondo >r , OP_REG16 r> does> @ op1 + outb! ;
|
|
: :+sreg anondo >r , OP_SREG r> does> @ op1 8 * + outb! ;
|
|
: modrm ( mod rm reg ) 8 * | swap 64 * | outb! ;
|
|
|
|
: int &hcd outb! outb! 1 assembled ;
|
|
|
|
2 inst mov
|
|
|
|
OP_IMM OP_REG16 :noname &hb8 op1 + outb! op2 outw! ; ' mov impl
|
|
OP_IMM OP_REG8 :noname &hb0 op1 + outb! op2 outb! ; ' mov impl
|
|
OP_REG8 OP_REG8 :noname &h88 outb! 3 op1 op2 modrm ; ' mov impl
|
|
|
|
2 inst add
|
|
OP_REG16 OP_REG16 :noname &h01 outb! &h03 op1 op2 modrm ; ' add impl
|
|
OP_IMM OP_REG8 :noname &h80 outb! 3 op1 0 modrm op2 outb! ; ' add impl
|
|
2 inst sub
|
|
OP_REG16 OP_REG16 :noname &h29 outb! &h03 op1 op2 modrm ; ' sub impl
|
|
OP_IMM OP_REG8 :noname &h80 outb! 3 op1 5 modrm op2 outb! ; ' sub impl
|
|
2 inst xor
|
|
OP_REG16 OP_REG16 :noname &h31 outb! &h03 op1 op2 modrm ; ' xor impl
|
|
2 inst cmp
|
|
OP_IMM OP_REG16 :noname &h81 outb! 3 op1 7 modrm op2 outw! ; ' cmp impl
|
|
OP_IMM OP_REG8 :noname &h80 outb! 3 op1 7 modrm op2 outb! ; ' cmp impl
|
|
|
|
1 inst div
|
|
OP_REG16 :noname &hf7 outb! &h03 op1 &h06 modrm ; ' div impl
|
|
1 inst mul
|
|
OP_REG16 :noname &hf7 outb! &h03 op1 &h04 modrm ; ' mul impl
|
|
|
|
1 inst push
|
|
&h06 :+sreg ' push impl
|
|
&h50 :+r ' push impl
|
|
1 inst pop
|
|
&h07 :+sreg ' pop impl
|
|
&h58 :+r ' pop impl
|
|
1 inst dec
|
|
&h48 :+r ' dec impl
|
|
1 inst inc
|
|
&h40 :+r ' inc impl
|
|
|
|
1 inst jmp
|
|
OP_INDIRECT :noname &hff outb! 0 op1 4 modrm ; ' jmp impl
|
|
OP_REG16 :noname &hff outb! 3 op1 4 modrm ; ' jmp impl
|
|
|
|
: :jumprel here >r 1 LBL_REL | inst
|
|
:| anondo >r , OP_IMM r> does> @ outb! op1 outb! |; execute
|
|
r> impl ;
|
|
|
|
&h77 :jumprel ja
|
|
&h73 :jumprel jae
|
|
&h72 :jumprel jb
|
|
&h76 :jumprel jbe
|
|
&h74 :jumprel je
|
|
&h7f :jumprel jg
|
|
&h7d :jumprel jge
|
|
&h7c :jumprel jl
|
|
&h7e :jumprel jle
|
|
&h75 :jumprel jne
|
|
&h74 :jumprel jz
|
|
&heb :jumprel jmps
|
|
|
|
: .EXIT ax &h4c00 | # mov &h21 int ;
|
|
: d" begin in@ dup [ in@ " lit ] != while outb! repeat drop ;
|
|
|