More opcodes, and a tiny program that prints "!"

This commit is contained in:
Jeremy Penner 2023-09-01 19:10:52 -04:00
parent bea5d1b0e4
commit e3d15b37cf
3 changed files with 69 additions and 24 deletions

78
asm.jrt
View file

@ -6,7 +6,9 @@ var target
var op-encode
var lastop
var is-byteptr : byteptr 1 is-byteptr ! ;
var op-memwidth
: byteptr 1 op-memwidth ! ; : byteptr? op-memwidth @ 1 = ;
: farptr 4 op-memwidth ! ; : farptr? op-memwidth @ 4 = ;
var current-oparg
var opargs-remaining
@ -33,13 +35,10 @@ array oparg2 3 cells allot
: 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? )
: byteop? ( -- f )
oparg-breg? swap-args oparg-breg? or swap-args is-byteptr @ or ;
oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ;
: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0 = or ;
: oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ;
: operror ( err -- ) lastop @ wordname type s" : " type type cr ;
: oparg-complete!
@ -60,6 +59,8 @@ array oparg2 3 cells allot
else 3 = if oparg-val !
else unexpected-addr then then
else unexpected-addr then ;
: @far ( offset segment -- ) 4 set-oparg! oparg-base ! ;
: oparg-faraddr? oparg-type @ 4 = ;
: l: create target @ , does> @ @+ ;
: l@ [ ' ' , ] cell + @ ;
@ -79,10 +80,10 @@ array oparg2 3 cells allot
( 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
0x20 reg es 0x21 reg cs 0x22 reg ss 0x23 reg ds
: start-op ( does-ptr argcount -- )
0 is-byteptr !
0 op-memwidth ! ( start unknown )
opargs-remaining @ if s" not enough arguments" operror then
opargs-remaining ! cell - lastop ! arg1 ;
: prefix create , does> @ >t ;
@ -126,9 +127,10 @@ array oparg2 3 cells allot
: >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 ;
: >segreg+op* ( base -- )
oparg-segreg? if oparg-val @ 0x0f & 3 << + >t rdrop else drop then ;
: >mem ( reg op -- ) >t memarg>mod+rm modrm>t disp>t swap-args imm?>t ;
: >memreg ( op -- ) swap-args oparg-val @ swap-args swap >mem ;
: >mem* oparg-mem? byteop? not and if >mem rdrop else 2drop then ;
: >bmem* oparg-mem? byteop? and if >mem rdrop else 2drop then ;
@ -139,12 +141,12 @@ array oparg2 3 cells allot
1 :op ret- oparg-imm? if oparg-val @ w>t else invalid-args then ;
1 :op push
0x50 >wreg+op*
0 >segreg+op*
0x06 >segreg+op*
6 0xff >mem*
invalid-args ;
1 :op pop
0x58 >wreg+op*
1 >segreg+op*
0x07 >segreg+op*
0 0x8f >mem*
invalid-args ;
1 :op inc
@ -165,14 +167,19 @@ array oparg2 3 cells allot
1 0xfe >bmem*
invalid-args ;
1 :op int
oparg-imm? if oparg-val @ dup 3 = if drop 0xcc t> else 0xcd t> t> then
oparg-imm? if oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then
else invalid-args then ;
: diffaddr ( addr opsize -- diff ) target @ + - ;
: >short-jmp* ( op -- ) oparg-type @ 3 = if oparg-base @ -1 = if
: oparg-nearaddr? ( -- f ) oparg-type @ 3 = oparg-base @ -1 = and ;
: >short-jmp* ( op -- ) oparg-nearaddr? if
oparg-val @ 2 diffaddr dup byteval? if swap >t >t rdrop return else drop
then then then drop ;
then then drop ;
: >near-reljmp* ( op -- ) oparg-nearaddr? if
oparg-val @ 3 diffaddr swap >t w>t rdrop else drop then ;
: >far-jmp* ( op -- ) oparg-faraddr?
if >t oparg-base @ w>t oparg-val @ w>t rdrop else drop then ;
1 :op jo 0x70 >short-jmp* invalid-args ;
1 :op jno 0x71 >short-jmp* invalid-args ;
1 :op jb 0x72 >short-jmp* invalid-args ;
@ -193,16 +200,51 @@ array oparg2 3 cells allot
1 :op loopz 0xe1 >short-jmp* invalid-args ;
1 :op loop 0xe2 >short-jmp* invalid-args ;
1 :op jcxz 0xe3 >short-jmp* invalid-args ;
1 :op jmp
0xeb >short-jmp*
0xe9 >near-reljmp*
0xea >far-jmp*
invalid-args ;
1 :op call
0xe8 >near-reljmp*
invalid-args ;
( four opcodes laid out next to each other:
byte mem, reg | word mem, reg | byte reg, mem | word reg, mem )
: memreg? ( -- f ) oparg-mem? swap-args oparg-bwreg? swap-args and ;
: >bmr-wmr? ( base -- f )
memreg? if byteop? not if 1 + then >memreg 1 else drop 0 then ;
: >bmr-wmr-brm-wrm* ( base -- )
dup >bmr-wmr? if drop rdrop return then
2 + swap-args >bmr-wmr? swap-args if rdrop then ;
: >bmr-wmr-brm-wrm? ( base -- f )
1 swap >bmr-wmr-brm-wrm* drop 0 ;
: >6group-math* ( base -- )
dup >bmr-wmr-brm-wrm? if drop rdrop then 4 +
swap-args oparg-imm? swap-args not if drop return then
oparg-reg? not if drop return then
oparg-val @ dup 0x10 = if drop >t swap-args imm?>t swap-args rdrop return then
0x00 = if 1 + >t swap-args imm?>t swap-args rdrop return else drop then ;
2 :op xchg
arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and
if 0x90 >wreg+op* then
invalid-args ;
2 :op mov
0x88 >bmr-wmr-brm-wrm*
arg2 oparg-imm? arg1 if
oparg-wreg? if oparg-val @ 0xb8 | >t arg2 oparg-val @ w>t return then
oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then
0 0xc6 >bmem*
0 0xc7 >mem*
0 0xc7 >mem*
then
invalid-args ;
invalid-args ;
2 :op add 0x00 >6group-math* invalid-args ;
2 :op adc 0x10 >6group-math* invalid-args ;
2 :op AND 0x20 >6group-math* invalid-args ;
2 :op xor 0x30 >6group-math* invalid-args ;
2 :op OR 0x08 >6group-math* invalid-args ;
2 :op sbb 0x18 >6group-math* invalid-args ;
2 :op sub 0x28 >6group-math* invalid-args ;
2 :op cmp 0x38 >6group-math* invalid-args ;

1
tinyjort.com Executable file
View file

@ -0,0 +1 @@
ДВ!Э!У

View file

@ -1,12 +1,14 @@
s" defs.jrt" loadfile
s" asm.jrt" loadfile
here
here
push ax
pop bx
inc @[ bx]
mov ah 0x02 #
mov dl key ! #
int 0x21 #
ret
here
:noname for i b@ .hex next ; execute
s" tinyjort.com" overwrite
:noname for i b@ fputc next ; execute
close