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

asm.jrt

@@ -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 -- ) 
+: >segreg+op* ( base -- ) 
-  oparg-segreg? if oparg-val @ 0x0f & 1 << + >t rdrop else drop then ;
+  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 ;
+

tinyjort.com

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

tinyjort.jrt

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