From e6f7b144131211a9f34ba0368e9874f4a609fc70 Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Fri, 1 Sep 2023 19:10:54 -0400 Subject: [PATCH] implement anonymous forward labels --- asm.jrt | 175 +++++++++++++++++++++++++++++---------------------- tinyjort.com | Bin 217 -> 236 bytes tinyjort.jrt | 11 +++- 3 files changed, 108 insertions(+), 78 deletions(-) diff --git a/asm.jrt b/asm.jrt index 3204228..e9bbd2e 100755 --- a/asm.jrt +++ b/asm.jrt @@ -31,6 +31,7 @@ array oparg2 3 cells allot : oparg-base ( -- v ) current-oparg @ 2 cells + ; : set-oparg! ( val type -- ) oparg-type ! oparg-val ! 0 oparg-base ! ; +: oparg-unset? ( -- f ) oparg-type @ 0 = ; : oparg-imm! ( val -- ) 1 set-oparg! ; : oparg-imm? ( -- f ) oparg-type @ 1 = ; : oparg-reg! ( reg -- ) 2 set-oparg! ; @@ -40,7 +41,8 @@ array oparg2 3 cells allot : oparg-wreg? ( -- f ) 0x00 oparg-regflag? ; : oparg-segreg? ( -- f ) 0x20 oparg-regflag? ; : oparg-mem! ( disp -- ) 3 set-oparg! ; -: oparg-mem? ( -- f ) oparg-type @ 3 = ; +: oparg-mem? ( -- f ) oparg-type @ 0x0f & 3 = ; +: oparg-mempatch? ( -- f ) oparg-type @ 0x13 = ; : byteop? ( -- f ) oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ; @@ -48,11 +50,16 @@ array oparg2 3 cells allot : oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ; : operror ( err -- ) lastop @ type s" near " type lastlabel @ type s" : " type type cr ; + +: encode-op ( -- ) op-encode @ execute 0 op-encode ! ; +: check-encoded ( -- ) + target @ >r encode-op ( patchid -- ) 0x13 set-oparg! @] ; +: <: ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ; + : L: here create wordname lastlabel ! target @ , does> @ @+ ; : L@ [ ' ' , ] 2 cells + @ ; @@ -122,98 +142,102 @@ array oparg2 3 cells allot : regarg>mod+rm ( -- mod rm ) 3 oparg-val @ ; : modrm>t ( reg mod rm -- ) 0x07 & swap 0x03 & 6 << | swap 0x07 & 3 << | >t ; - -: invalid-args s" invalid argument types" operror ; +: pre-disp-write memarg>case 2 = if ' patch-a16 patchpoint then ; ( convention: words ending in * mean "will return if matched" ) -: disp>t oparg-val @ memarg>dispsize +: disp>t pre-disp-write oparg-val @ memarg>dispsize dup 1 = if drop >t else 2 = if w>t else drop then then ; : imm?>t oparg-imm? if oparg-val @ byteop? if >t else w>t then then ; +( 2ret: return immediately from this word and calling word. + equivalent to rdrop return. ) +: 2ret rdrop rdrop ; + : >wreg+op* ( base -- ) - oparg-wreg? if oparg-val @ | >t rdrop else drop then ; + oparg-wreg? if oparg-val @ | >t 2ret then drop ; : >segreg+op* ( base -- ) - oparg-segreg? if oparg-val @ 0x0f & 3 << + >t rdrop else drop then ; + oparg-segreg? if oparg-val @ 0x0f & 3 << + >t 2ret then drop ; : >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 ; -: >extmem* oparg-mem? byteop? not and if >mem rdrop else 2drop then ; -: >extbmem* oparg-mem? byteop? and if >mem rdrop else 2drop then ; +: >extmem* oparg-mem? byteop? not and if >mem 2ret then 2drop ; +: >extbmem* oparg-mem? byteop? and if >mem 2ret then 2drop ; : >extreg ( reg op -- ) >t regarg>mod+rm modrm>t ; -: >extbreg* ( ext op -- ) oparg-breg? if >extreg rdrop else 2drop then ; -: >extreg* ( ext op -- ) oparg-wreg? if >extreg rdrop else 2drop then ; +: >extbreg* ( ext op -- ) oparg-breg? if >extreg 2ret then 2drop ; +: >extreg* ( ext op -- ) oparg-wreg? if >extreg 2ret then 2drop ; -1 :op RET- oparg-imm? if oparg-val @ w>t else invalid-args then ; +: >extwreg|mem* ( ext op -- ) byteop? not if + oparg-wreg? if >extreg 2ret then + oparg-mem? if >mem 2ret then + then 2drop ; + +1 :op RET- oparg-imm? if oparg-val @ w>t then ; 1 :op PUSH 0x50 >wreg+op* 0x06 >segreg+op* - 6 0xff >extmem* - invalid-args ; + 6 0xff >extmem* ; 1 :op POP 0x58 >wreg+op* 0x07 >segreg+op* - 0 0x8f >extmem* - invalid-args ; + 0 0x8f >extmem* ; 1 :op INC 0x40 >wreg+op* 0 0xfe >extbreg* 0 0xff >extreg* 0 0xff >extmem* - 1 0xff >extmem* - invalid-args ; + 1 0xff >extmem* ; 1 :op DEC 0x48 >wreg+op* 1 0xfe >extbreg* 1 0xff >extreg* 1 0xff >extmem* - 1 0xfe >extbmem* - invalid-args ; + 1 0xfe >extbmem* ; 1 :op INT - oparg-imm? if oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then - else invalid-args then ; + oparg-imm? if + oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then + then ; -: diffaddr ( addr opsize -- diff ) target @ + - ; -: oparg-nearaddr? ( -- f ) oparg-type @ 3 = oparg-base @ -1 = and ; +: diffaddr ( opsize -- diff ) oparg-val @ swap target @ + - ; +: oparg-nearaddr? ( -- f ) oparg-mem? 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 drop ; + 2 diffaddr dup byteval? oparg-mempatch? or + if swap >t ' patch-r8 patchpoint cr >t 2ret then drop + 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 ; + 3 diffaddr swap >t ' patch-r16 patchpoint w>t 2ret then drop ; +: >far-jmp* ( op -- ) oparg-faraddr? + if >t oparg-base @ w>t oparg-val @ w>t 2ret then drop ; -1 :op JO 0x70 >short-jmp* invalid-args ; -1 :op JNO 0x71 >short-jmp* invalid-args ; -1 :op JB 0x72 >short-jmp* invalid-args ; -1 :op JNB 0x73 >short-jmp* invalid-args ; -1 :op JZ 0x74 >short-jmp* invalid-args ; -1 :op JNZ 0x75 >short-jmp* invalid-args ; -1 :op JBE 0x76 >short-jmp* invalid-args ; -1 :op JA 0x77 >short-jmp* invalid-args ; -1 :op JS 0x78 >short-jmp* invalid-args ; -1 :op JNS 0x79 >short-jmp* invalid-args ; -1 :op JPE 0x7a >short-jmp* invalid-args ; -1 :op JPO 0x7b >short-jmp* invalid-args ; -1 :op JL 0x7c >short-jmp* invalid-args ; -1 :op JGE 0x7d >short-jmp* invalid-args ; -1 :op JLE 0x7e >short-jmp* invalid-args ; -1 :op JG 0x7f >short-jmp* invalid-args ; -1 :op LOOPNZ 0xe0 >short-jmp* invalid-args ; -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 JO 0x70 >short-jmp* ; +1 :op JNO 0x71 >short-jmp* ; +1 :op JB 0x72 >short-jmp* ; +1 :op JNB 0x73 >short-jmp* ; +1 :op JZ 0x74 >short-jmp* ; +1 :op JNZ 0x75 >short-jmp* ; +1 :op JBE 0x76 >short-jmp* ; +1 :op JA 0x77 >short-jmp* ; +1 :op JS 0x78 >short-jmp* ; +1 :op JNS 0x79 >short-jmp* ; +1 :op JPE 0x7a >short-jmp* ; +1 :op JPO 0x7b >short-jmp* ; +1 :op JL 0x7c >short-jmp* ; +1 :op JGE 0x7d >short-jmp* ; +1 :op JLE 0x7e >short-jmp* ; +1 :op JG 0x7f >short-jmp* ; +1 :op LOOPNZ 0xe0 >short-jmp* ; +1 :op LOOPZ 0xe1 >short-jmp* ; +1 :op LOOP 0xe2 >short-jmp* ; +1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JMP 0xeb >short-jmp* 0xe9 >near-reljmp* 0xea >far-jmp* farptr? if 0x05 0xff >extmem* then - 0x04 0xff >extmem* ( todo: JMP to reg allowed ) - invalid-args ; + 0x04 0xff >extmem* ( todo: JMP to reg allowed ) ; 1 :op CALL 0xe8 >near-reljmp* farptr? if 0x03 0xff >extmem* then - 0x02 0xff >extmem* ( todo: CALL reg allowed ) - invalid-args ; + 0x02 0xff >extmem* ( todo: CALL reg allowed ) ; ( four opcodes laid out next to each other: byte mem, reg | word mem, reg | byte reg, mem | word reg, mem ) @@ -228,22 +252,22 @@ array oparg2 3 cells allot regreg? if 1 + else bregbreg? not if drop 0 return then then >regreg 1 ; : >bmr-wmr-brm-wrm* ( base -- ) - dup >bmr-wmr? if drop rdrop return then - dup >brr-wrr? if drop rdrop return then - 2 + swap-args >bmr-wmr? swap-args if rdrop then ; + dup >bmr-wmr? if drop 2ret then + dup >brr-wrr? if drop 2ret then + 2 + swap-args >bmr-wmr? swap-args if 2ret 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 + + dup >bmr-wmr-brm-wrm? if drop 2ret 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 ; + oparg-val @ dup + 0x10 = if drop >t swap-args imm?>t swap-args 2ret then + 0x00 = if 1 + >t swap-args imm?>t swap-args 2ret then drop ; 2 :op XCHG arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and - if 0x90 >wreg+op* then - invalid-args ; + if 0x90 >wreg+op* then ; 2 :op MOV 0x88 >bmr-wmr-brm-wrm* arg2 oparg-imm? arg1 if @@ -251,14 +275,13 @@ array oparg2 3 cells allot oparg-breg? if oparg-val @ 0x0f & 0xb0 | >t arg2 oparg-val @ >t return then 0 0xc6 >extbmem* 0 0xc7 >extmem* - then - 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 ; + then ; +2 :op ADD 0x00 >6group-math* ; +2 :op ADC 0x10 >6group-math* ; +2 :op AND 0x20 >6group-math* ; +2 :op XOR 0x30 >6group-math* ; +2 :op OR 0x08 >6group-math* ; +2 :op SBB 0x18 >6group-math* ; +2 :op SUB 0x28 >6group-math* ; +2 :op CMP 0x38 >6group-math* ; diff --git a/tinyjort.com b/tinyjort.com index 77cad5a3c3fc3c8f036d3c6858fd79d55ce1d089..c27890578ce93521375acf002f25abc8a1dd1485 100755 GIT binary patch delta 66 zcmcb~_=ZvFt : savelabel ( word -- ) here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; -: DICTLIST ( word -- tptr ) b@ 0x0f & dup . cells [ L@ DICTIONARY lit ] + ; +: DICTLIST ( word -- tptr ) b@ 0x0f & cells [ L@ DICTIONARY lit ] + ; : strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ; : str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ; : link>t ( tptr-head -- ) dup @t swap target @ swap !t w>t ; @@ -95,11 +95,18 @@ L: $$COLON PUSH AX NEXT -:ASM GOTO_ +:ASM BZ_ + POP CX + JCXZ 0 @> + LODSW + NEXT +L: GOTO_IMPL 0 <: LODSW MOV SI AX NEXT +DEF GOTO_ L@ GOTO_IMPL w>t + ( 0x1000 target ! ) .s