First cut at an 8086 assembler vocabulary
This commit is contained in:
parent
791e4644aa
commit
102751b342
169
asm.jrt
Executable file
169
asm.jrt
Executable file
|
|
@ -0,0 +1,169 @@
|
|||
var target
|
||||
0x100 target !
|
||||
: >t b, 1 target +! ; ( todo: write to target segment )
|
||||
: w>t , 2 target +! ;
|
||||
|
||||
var op-encode
|
||||
var lastop
|
||||
|
||||
var current-oparg
|
||||
var opargs-remaining
|
||||
array oparg1 3 cells allot
|
||||
array oparg2 3 cells allot
|
||||
|
||||
: arg1 oparg1 current-oparg ! ;
|
||||
: arg2 oparg2 current-oparg ! ;
|
||||
arg1
|
||||
: swap-args current-oparg @ oparg1 = if arg2 else arg1 then ;
|
||||
|
||||
: oparg-type ( -- type ) current-oparg @ ;
|
||||
: oparg-val ( -- v ) current-oparg @ cell + ;
|
||||
: oparg-base ( -- v ) current-oparg @ 2 cells + ;
|
||||
: set-oparg! ( val type -- ) oparg-type ! oparg-val ! 0 oparg-base ! ;
|
||||
|
||||
: oparg-imm! ( val -- ) 1 set-oparg! ;
|
||||
: oparg-imm? ( -- f ) oparg-type @ 1 = ;
|
||||
: oparg-reg! ( reg -- ) 2 set-oparg! ;
|
||||
: oparg-reg? ( -- f ) oparg-type @ 2 = ;
|
||||
: oparg-regflag? ( flag -- f ) oparg-val @ 0xf0 & = oparg-reg? and ;
|
||||
: oparg-breg? ( -- f ) 0x10 oparg-regflag? ;
|
||||
: oparg-wreg? ( -- f ) 0x00 oparg-regflag? ;
|
||||
: oparg-segreg? ( -- f ) 0x20 oparg-regflag? ;
|
||||
: oparg-mem! ( disp -- ) 3 set-oparg! ;
|
||||
: oparg-mem? ( -- f ) oparg-type @ 3 = ;
|
||||
|
||||
( TODO: support explicit byte ptr word )
|
||||
( ie. inc [bx] vs inc byte [bx]?? )
|
||||
( or do we just say incb? )
|
||||
|
||||
: bytearg? ( -- f )
|
||||
current-oparg @
|
||||
arg1 oparg-reg? oparg-breg? and
|
||||
arg2 oparg-reg? oparg-breg? and or
|
||||
swap current-oparg ! ;
|
||||
: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0= or ;
|
||||
|
||||
: operror ( err -- ) lastop @ wordname type s": " type type cr ;
|
||||
: oparg-complete!
|
||||
opargs-remaining @ dup if
|
||||
1 - dup opargs-remaining !
|
||||
if arg2
|
||||
else arg1 op-encode @ execute 0 op-encode ! then
|
||||
else s" too many arguments" operror then ;
|
||||
|
||||
: # oparg-imm! oparg-complete! ;
|
||||
: @[ 0 oparg-mem! ;
|
||||
: @] -1 oparg-base ! oparg-complete ! ;
|
||||
|
||||
: unexpected-addr ( addr -- ) drop s" unexpected address" operror ;
|
||||
: @+ ( disp -- )
|
||||
opargs-remaining @ if
|
||||
oparg-type @ dup 0= if drop oparg-mem! oparg-complete!
|
||||
else 3 = if oparg-val !
|
||||
else unexpected-addr then then
|
||||
else unexpected-addr then ;
|
||||
|
||||
: l: create target @ , does> @ @+ ;
|
||||
|
||||
: memreg create , does> @ oparg-base ! oparg-complete! ;
|
||||
0 memreg bx+si] 1 memreg bx+di] 2 memreg bp+si] 3 memreg bp+di]
|
||||
4 memreg si] 5 memreg di] 6 memreg bp] 7 memreg bx]
|
||||
|
||||
: reg create , does> @ oparg-reg! oparg-complete! ;
|
||||
( data registers: take the bottom four bits and you have the
|
||||
REG and R/M encoding for the modr/m byte )
|
||||
0x00 reg ax 0x01 reg cx 0x02 reg dx 0x03 reg bx
|
||||
0x04 reg sp 0x05 reg bp 0x06 reg si 0x07 reg di
|
||||
( 8-bit data registers, same scheme )
|
||||
0x10 reg al 0x11 reg cl 0x12 reg dl 0x13 reg bl
|
||||
0x14 reg ah 0x15 reg ch 0x16 reg dh 0x17 reg bh
|
||||
( segment registers: take the bottom four bits, left shift 1,
|
||||
and you have the PUSH instruction byte. bitwise or 0x01 and
|
||||
you have POP.)
|
||||
0x25 reg es 0x27 reg ss 0x2d reg cs 0x2f reg ds
|
||||
|
||||
: start-op ( does-ptr argcount -- )
|
||||
opargs-remaining @ if s" not enough arguments" operror then
|
||||
opargs-remaining ! cell - lastop ! arg1 ;
|
||||
: prefix create , does> @ >t ;
|
||||
: 0op create , does> dup 0 start-op @ >t ;
|
||||
|
||||
0x26 prefix es: 0x36 prefix ss: 0x2e prefix cs: 0x3e prefix ds:
|
||||
0xf0 prefix lock 0xf2 prefix repnz 0xf3 prefix repz
|
||||
|
||||
0x90 0op nop 0xa4 0op movsb 0xa5 0op movsw 0xa6 0op cmpsb
|
||||
0xa7 0op cmpsw 0xc3 0op ret 0xd7 0op xlat 0xf4 0op hlt
|
||||
0x98 0op cbw 0x99 0op cwd 0x9c 0op pushf 0x9d 0op popf
|
||||
0x9e 0op sahf 0x9f 0op lahf 0xaa 0op stosb 0xab 0op stosw
|
||||
0xac 0op lodsb 0xad 0op lodsw 0xae 0op scasb 0xaf 0op scasw
|
||||
0xcb 0op retf 0xce 0op into 0xcf 0op iret 0xf8 0op clc
|
||||
0xf9 0op stc 0xfa 0op cli 0xfb 0op sti 0xfc 0op cld
|
||||
0xfd 0op std 0xf5 0op cmc
|
||||
|
||||
: :op ( count -- ) , $DOCOLON , does>
|
||||
dup @ dup start-op cell + op-encode ! ;
|
||||
|
||||
: memarg>case ( -- 0|1|2 )
|
||||
oparg-base @ dup -1 = if drop 1 ( D16 ) else
|
||||
6 = oparg-val @ 0= if 2 ( [bp]+0 ) else 0 ( standard ) then then ;
|
||||
: memarg>dispsize ( -- 0|1|2 )
|
||||
memarg>case dup 1 = if drop 2 else 2 = if 1 else
|
||||
oparg-val @ dup 0= if drop 0 else byteval? if 1 else 2
|
||||
then then then then ;
|
||||
: memarg>mod+rm ( -- mod rm )
|
||||
memarg>case dup 1 = if drop 0 6 else 2 = if 2 6 else
|
||||
memarg>dispsize oparg-base @ then then ;
|
||||
: regarg>mod+rm ( -- mod rm ) 3 oparg-val @ ;
|
||||
|
||||
: modrm>t ( reg mod rm -- ) 0x03 & swap 0x02 & 6 << | swap 0x03 & 3 << | >t ;
|
||||
|
||||
: invalid-args s" invalid argument types" operror ;
|
||||
|
||||
( convention: words ending in * mean "will return if matched" )
|
||||
: disp>t memarg>dispsize dup 1= if drop >t else 2 = if w>t else drop then then ;
|
||||
: imm?>t oparg-imm? if oparg-val @ dup byteval? if >t else w>t then then ;
|
||||
|
||||
: >wreg+op* ( base -- )
|
||||
oparg-wreg? if oparg-val @ | >t rdrop else drop then ;
|
||||
: >segreg+op* ( off -- )
|
||||
oparg-segreg? if oparg-val @ 0x0f & 1 << + >t rdrop else drop then ;
|
||||
: >mem* ( reg op -- )
|
||||
oparg-mem? if
|
||||
>t memarg>mod+rm modrm>t disp>t swap-args imm?>t rdrop
|
||||
else 2drop then ;
|
||||
: >regreg ( reg op -- ) >t regarg>mod+rm modrm>t ;
|
||||
: >byte-regreg* ( reg op -- ) oparg-breg? if >regreg rdrop else 2drop then ;
|
||||
: >regreg* ( reg op -- ) oparg-wreg? if >regreg rdrop else 2drop then ;
|
||||
|
||||
1 :op ret- oparg-imm? if oparg-val @ w>t else invalid-args then ;
|
||||
1 :op push
|
||||
0x50 >wreg+op*
|
||||
0 >segreg+op*
|
||||
6 0xff >mem*
|
||||
invalid-args ;
|
||||
1 :op pop
|
||||
0x58 >wreg+op*
|
||||
1 >segreg+op*
|
||||
0 0x8f >mem*
|
||||
invalid-args ;
|
||||
1 :op inc
|
||||
0x40 >wreg+op*
|
||||
0 0xfe >byte-regreg*
|
||||
0 0xff >regreg*
|
||||
0 0xff >mem*
|
||||
invalid-args ;
|
||||
1 :op incb
|
||||
0 0xfe >byte-regreg*
|
||||
0 0xfe >mem*
|
||||
invalid-args ;
|
||||
1 :op dec
|
||||
0x48 >wreg+op*
|
||||
1 0xfe >byte-regreg*
|
||||
1 0xff >regreg*
|
||||
0 0xff >mem*
|
||||
invalid-args ;
|
||||
1 :op decb
|
||||
1 0xfe >byte-regreg*
|
||||
1 0xfe >mem*
|
||||
invalid-args ;
|
||||
|
||||
2
boot.jor
2
boot.jor
|
|
@ -31,7 +31,7 @@ key const sp
|
|||
|
||||
' cells @ const $DOCOLON ( get the colon execution token )
|
||||
: :| inline| $DOCOLON , ; immediate
|
||||
: |; ' ret , |inline ; immediate
|
||||
: |; ' return , |inline ; immediate
|
||||
|
||||
: s" state if inline| else here then
|
||||
begin key dup [ key " lit ] != over 0 != and while b, repeat drop 0 b,
|
||||
|
|
|
|||
159
defs.jrt
Executable file
159
defs.jrt
Executable file
|
|
@ -0,0 +1,159 @@
|
|||
: >rot <rot <rot ;
|
||||
: 2dup over over ;
|
||||
: 3dup >r 2dup r@ >rot <r ;
|
||||
: 4dup >r >r 2dup r@ >rot rswap r@ >rot <r <r swap ;
|
||||
: nip swap drop ;
|
||||
|
||||
: 2= ( a b c d -- a=c&b=d )
|
||||
>r <rot = swap <r = and ;
|
||||
|
||||
: 2swap ( a b c d -- c d a b )
|
||||
>r >rot <r >rot ;
|
||||
|
||||
: negate 0 swap - ;
|
||||
: abs dup 0 < if negate then ;
|
||||
|
||||
: ~ -1 ^ ;
|
||||
: f! ( b v flag -- )
|
||||
>rot >r r@ @ >rot ( val flag b r: v )
|
||||
if | else ~ & then <r ! ;
|
||||
: f@ ( v flag -- b ) swap @ & ;
|
||||
: fnot! ( v flag -- ) over @ ^ swap ! ;
|
||||
|
||||
: @! ( newval v -- oldval ) dup @ >rot ! ;
|
||||
|
||||
: expile state if , else execute then ;
|
||||
|
||||
: :noname here $DOCOLON , ] ;
|
||||
|
||||
: array word new-word $DOVAR , ;
|
||||
: create word new-word $DOCREATE , 0 , ;
|
||||
|
||||
: finishcreate ( ipfirst -- )
|
||||
( set cell after codepointer to first instruction of does> )
|
||||
latest codepointer cell + ! ;
|
||||
|
||||
: does> here 4 cells + lit ' finishcreate , ' return , ] ; immediate
|
||||
|
||||
: +towards ( from to -- from+-1 )
|
||||
over > if 1 + else 1 - then ;
|
||||
|
||||
: for ( from to -- )
|
||||
' >r , [ ' begin , ] ( from r: to )
|
||||
' dup , ' r@ , ' != , [ ' while , ]
|
||||
' >r , ; immediate ( r: to from )
|
||||
: i ' r@ , ; immediate
|
||||
: next
|
||||
' <r , ' r@ , ' +towards , ( from+1 r: to )
|
||||
[ ' repeat , ] ' drop , ' rdrop , ; immediate
|
||||
: breakfor
|
||||
' rdrop , ' rdrop , 0 lit ' >r , 1 lit ' >r , ; immediate
|
||||
|
||||
: yield rswap ;
|
||||
: done rdrop 0 >r rswap ;
|
||||
: ;done ' done , ] ; immediate
|
||||
: each [ ' begin , ] ' r@ , [ ' while , ] ; immediate
|
||||
: more ' yield , [ ' repeat , ] ' rdrop , ; immediate
|
||||
: break rswap rdrop :| yield done |; execute rswap ;
|
||||
|
||||
: links begin yield @ dup not until drop ;done
|
||||
|
||||
: files findfile begin dup while yield nextfile repeat drop ;done
|
||||
: .files files each type s" " type more ;
|
||||
|
||||
: min ( x y -- x|y ) 2dup > if swap then drop ;
|
||||
: max ( x y -- x|y ) 2dup < if swap then drop ;
|
||||
|
||||
: +!pos ( n var -- ) dup @ <rot + 0 max swap ! ;
|
||||
: cycle! ( var lim -- )
|
||||
over @ dup 0 < if drop 1 - swap !
|
||||
else <= if 0 swap !
|
||||
else drop then then ;
|
||||
|
||||
: +!cycle ( n var lim -- ) >r >r r@ +! <r <r cycle! ;
|
||||
|
||||
: intern create latest wordname , does> @ ;
|
||||
|
||||
: preserving ( cp 0 vars... -- )
|
||||
0 >r begin dup while dup @ >r >r repeat drop
|
||||
execute
|
||||
begin r@ while <r <r swap ! repeat rdrop ;
|
||||
: preserve ( cp var -- ) 0 swap preserves ;
|
||||
|
||||
: decompile-from ( ip -- )
|
||||
begin dup @ ' return != while
|
||||
dup @ dup ` dup if type drop else drop . then bl
|
||||
cell +
|
||||
repeat drop ;
|
||||
|
||||
: decompile word lookup if cell + decompile-from else drop then ; userword
|
||||
|
||||
: words
|
||||
latest links each
|
||||
dup wordflags F_USERWORD f@ if
|
||||
dup wordname type bl
|
||||
then
|
||||
more ;
|
||||
|
||||
: lazy here $DODEFERRED , ' noop , ;
|
||||
: >lazy! latest codepointer swap redefine ;
|
||||
|
||||
: dbg" [ ' s" , ] :| type bl .s cr |; expile ; immediate
|
||||
|
||||
( tasks )
|
||||
: mailbox 2 cells + ;
|
||||
: task-ip task-user-size cells + ;
|
||||
: task-sp task-user-size 1 + cells + ;
|
||||
: task-rsp task-user-size 2 + cells + ;
|
||||
: task-stack task-user-size 3 + cells + ;
|
||||
: task-rstack task-stack stacksize cells + ;
|
||||
|
||||
: .wordin ( ptr -- )
|
||||
latest links each
|
||||
2dup > if wordname type drop 0 break then
|
||||
more dup if . else drop then ; userword
|
||||
|
||||
: tasks.s
|
||||
tasks links each
|
||||
dup dup . .wordin s" : " type
|
||||
dup task-sp @ over task-stack ( task stackLim stack )
|
||||
2dup . . s" : " type
|
||||
begin 2dup > while dup @ . cell + repeat
|
||||
cr drop drop more ; userword
|
||||
|
||||
: task.bt ( task -- )
|
||||
dup task-rsp @ swap task-rstack ( rstackLim rstack )
|
||||
begin 2dup > while dup @ dup . .wordin cr cell + repeat
|
||||
drop drop ; userword
|
||||
|
||||
: doactivate ( task ip -- )
|
||||
over task-ip !
|
||||
dup task-stack over task-sp !
|
||||
dup task-rstack over task-rsp !
|
||||
drop
|
||||
;
|
||||
|
||||
: activate
|
||||
here 4 cells + lit
|
||||
' doactivate ,
|
||||
' return ,
|
||||
; immediate
|
||||
|
||||
: >task ( val task -- )
|
||||
task-sp >r r@ @ ! r@ @ cell + r> ! ;
|
||||
|
||||
: try-send ( val task -- b )
|
||||
mailbox dup @ if drop drop 0 else ! 1 then ;
|
||||
|
||||
: wait-send ( val task -- )
|
||||
mailbox
|
||||
begin dup @ while suspend repeat ( wait for empty mailbox )
|
||||
! ;
|
||||
|
||||
: send ( val task -- ) try-send drop ;
|
||||
|
||||
: receive ( -- val )
|
||||
running mailbox
|
||||
begin dup @ not while suspend repeat ( wait for mail )
|
||||
dup @ 0 <rot ! ;
|
||||
|
||||
|
|
@ -563,7 +563,7 @@ void f_immediate() {
|
|||
void f_compileword();
|
||||
|
||||
void f_semicolon() {
|
||||
PUSHS("ret");
|
||||
PUSHS("return");
|
||||
f_compileword();
|
||||
f_compileoff();
|
||||
}
|
||||
|
|
@ -872,7 +872,7 @@ void f_init() {
|
|||
CDEF("BZ_", f_bz_);
|
||||
CDEF("BNZ_", f_bnz_);
|
||||
CDEF("INLINEDATA_", f_inline_data_);
|
||||
CDEF("ret", f_ret);
|
||||
CDEF("return", f_ret);
|
||||
CDEF(".", f_dot);
|
||||
CDEF("u.", f_udot);
|
||||
CDEF("type", f_puts);
|
||||
|
|
|
|||
Loading…
Reference in a new issue