From be7950520ea7feb69425ff9b460f1f2c3a86d84f Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Fri, 1 Sep 2023 19:10:54 -0400 Subject: [PATCH] cleaning up and testing number parsing --- asm.jrt | 101 ++++++++++++++++++++++++++++++++++++--------------- tinyjort.com | Bin 477 -> 551 bytes tinyjort.jrt | 54 +++++++++++++++------------ 3 files changed, 102 insertions(+), 53 deletions(-) diff --git a/asm.jrt b/asm.jrt index e9bbd2e..da665f1 100755 --- a/asm.jrt +++ b/asm.jrt @@ -84,10 +84,14 @@ array patchtable 10 2 cells * allot : patch-a16 ( tptr targ -- ) swap !t ; : patch-r16 ( tptr targ -- ) over 2 + - swap !t ; : patch-r8 ( tptr targ -- ) over 1 + - swap b!t ; -: apply-patch ( tptr type -- ) target @ swap execute ; +' patch-a16 dbg" patch-a16" drop +' patch-r16 dbg" patch-r16" drop +' patch-r8 dbg" patch-r8 " drop +: apply-patch ( tptr type -- ) target @ swap dbg" applying patch" execute ; : @> ( patchid -- ) 0x13 set-oparg! @] ; -: <: ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ; +: <: + ( patchid -- ) find-patch dup @ swap cell + @ swap apply-patch ; : L: here create wordname lastlabel ! target @ , does> @ @+ ; : L@ [ ' ' , ] 2 cells + @ ; @@ -110,7 +114,7 @@ array patchtable 10 2 cells * allot : start-op ( dictentry argcount -- ) 0 op-memwidth ! ( start unknown ) opargs-remaining @ if s" not enough arguments" operror then - opargs-remaining ! lastop ! arg1 ; + opargs-remaining ! lastop ! arg2 0 0 set-oparg! arg1 0 0 set-oparg! ; : prefix create , does> @ >t ; : 0op here create wordname , b, does> dup @ 0 start-op cell + b@ >t ; @@ -147,7 +151,10 @@ array patchtable 10 2 cells * allot ( convention: words ending in * mean "will return if matched" ) : 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 ; +defer byteimm? ' byteop? ' byteimm? redefine +var ignoreimm +: imm?>t ignoreimm @ not if + oparg-imm? if oparg-val @ byteimm? if >t else w>t then then then ; ( 2ret: return immediately from this word and calling word. equivalent to rdrop return. ) @@ -162,15 +169,23 @@ array patchtable 10 2 cells * allot : >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 ; +: >extreg ( reg op -- ) >t regarg>mod+rm modrm>t swap-args imm?>t ; : >extbreg* ( ext op -- ) oparg-breg? if >extreg 2ret then 2drop ; : >extreg* ( ext op -- ) oparg-wreg? if >extreg 2ret then 2drop ; -: >extwreg|mem* ( ext op -- ) byteop? not if - oparg-wreg? if >extreg 2ret then - oparg-mem? if >mem 2ret then - then 2drop ; +: *? ( cp -- f ) :| execute 0 2ret |; execute 1 ; +: >extwreg|mem* ( ext op -- ) + 2dup ' >extreg* *? if 2drop 2ret then + ' >extmem* *? if 2ret then ; +: >extbreg|mem* ( ext op -- ) + 2dup ' >extbreg* *? if 2drop 2ret then + ' >extbmem* *? if 2ret then ; + +: >grp3* ( reg -- ) + dup 0xf6 ' >extbreg|mem* *? if drop 2ret then + 0xf7 ' >extwreg|mem* *? if 2ret then ; + 1 :op RET- oparg-imm? if oparg-val @ w>t then ; 1 :op PUSH 0x50 >wreg+op* @@ -182,16 +197,12 @@ array patchtable 10 2 cells * allot 0 0x8f >extmem* ; 1 :op INC 0x40 >wreg+op* - 0 0xfe >extbreg* - 0 0xff >extreg* - 0 0xff >extmem* - 1 0xff >extmem* ; + 0 0xfe >extbreg|mem* + 0 0xff >extwreg|mem* ; 1 :op DEC 0x48 >wreg+op* - 1 0xfe >extbreg* - 1 0xff >extreg* - 1 0xff >extmem* - 1 0xfe >extbmem* ; + 1 0xfe >extbreg|mem* + 1 0xff >extwreg|mem* ; 1 :op INT oparg-imm? if oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then @@ -229,15 +240,15 @@ array patchtable 10 2 cells * allot 1 :op LOOP 0xe2 >short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JMP - 0xeb >short-jmp* 0xe9 >near-reljmp* + 0xeb >short-jmp* 0xea >far-jmp* farptr? if 0x05 0xff >extmem* then - 0x04 0xff >extmem* ( todo: JMP to reg allowed ) ; + 0x04 0xff >extwreg|mem* ; 1 :op CALL 0xe8 >near-reljmp* farptr? if 0x03 0xff >extmem* then - 0x02 0xff >extmem* ( todo: CALL reg allowed ) ; + 0x02 0xff >extwreg|mem* ; ( four opcodes laid out next to each other: byte mem, reg | word mem, reg | byte reg, mem | word reg, mem ) @@ -251,6 +262,11 @@ array patchtable 10 2 cells * allot : >brr-wrr? ( base -- f ) regreg? if 1 + else bregbreg? not if drop 0 return then then >regreg 1 ; +( byte any, reg | word any, reg ) +: >bar-war* ( base -- ) + dup >brr-wrr? if drop 2ret then + >bmr-wmr? if 2ret then ; + : >bmr-wmr-brm-wrm* ( base -- ) dup >bmr-wmr? if drop 2ret then dup >brr-wrr? if drop 2ret then @@ -265,9 +281,27 @@ array patchtable 10 2 cells * allot 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 ; +: 'extregmem ( op -- op ) + byteop? if ' >extbreg|mem* else 1 + ' >extwreg|mem* then ; + +: >grp1* ( ext -- ) + arg2 oparg-imm? if + oparg-val @ byteval? arg1 byteop? not and + if ' 1 ' byteimm? redefine 0x82 else 0x80 then + 'extregmem *? ' byteop? ' byteimm? redefine if 2ret then + else arg1 drop then ; + +: >grp2* ( ext -- ) + 0xd0 swap-args + oparg-imm? oparg-val @ 1 = and not if ( 1, d0/d1 ) + oparg-reg? oparg-val @ 0x11 = and + if 2 + ( CL, d2/d3 ) else swap-args 2drop return then + then swap-args 'extregmem 1 ignoreimm ! *? 0 ignoreimm ! if 2ret then ; + 2 :op XCHG arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and - if 0x90 >wreg+op* then ; + if 0x90 >wreg+op* then + 0x86 >bar-war* ; 2 :op MOV 0x88 >bmr-wmr-brm-wrm* arg2 oparg-imm? arg1 if @@ -276,12 +310,21 @@ array patchtable 10 2 cells * allot 0 0xc6 >extbmem* 0 0xc7 >extmem* 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* ; +2 :op ADD 0x00 >6group-math* 0 >grp1* ; +2 :op ADC 0x10 >6group-math* 2 >grp1* ; +2 :op AND 0x20 >6group-math* 4 >grp1* ; +2 :op XOR 0x30 >6group-math* 6 >grp1* ; +2 :op OR 0x08 >6group-math* 1 >grp1* ; +2 :op SBB 0x18 >6group-math* 3 >grp1* ; +2 :op SUB 0x28 >6group-math* 5 >grp1* ; +2 :op CMP 0x38 >6group-math* 7 >grp1* ; + +2 :op ROL 0 >grp2* ; 2 :op ROR 1 >grp2* ; 2 :op RCL 2 >grp2* ; +2 :op RCR 3 >grp2* ; 2 :op SHL 4 >grp2* ; 2 :op SHR 5 >grp2* ; +2 :op SAR 7 >grp2* ; + +1 :op NOT 2 >grp3* ; 1 :op NEG 3 >grp3* ; 1 :op MUL 4 >grp3* ; +1 :op IMUL 5 >grp3* ; 1 :op DIV 6 >grp3* ; 1 :op IDIV 7 >grp3* ; + +2 :op LEA oparg-wreg? arg2 oparg-mem? and if 0x8d >memreg then ; diff --git a/tinyjort.com b/tinyjort.com index 7d8233d7c1d83403e370fe6ddaddd95858b9dcc8..7c7caa562d835b8aa9781b789e39717e04a926fb 100755 GIT binary patch literal 551 zcmaDU&BOo%M;T`_y=A%qWIteJW(J8cFdPE%-Z8EPlFrWm&DVAw{;v)c(RJNkjlG36)hKY>6zCcN^a5^IcH&Bm@tD9?3kgE$&o3nGb{C{;v zMg|ri&yaYAeT-`Zz$#l98JL}-;u+2}Mm}a+3l>`2c?@PYtGj=Qe>}qtMlO)A*z!tq zlTwQqelvD{j|)4__68_yc);+s;mMA}Yuau!{AMVTYxr$huiEh1poZ(a-Wx{78;&m@ z{qOu|crp-dlJ7{;vBnRCk)^N?`f~EJvzTp zr=9cKaLKOJyhJ@YeMRU-A#3hHFES(~uV;m}A*k#@&S#yMeF$=INSzPH2&=e&&_X3w z!|F7sXm5g|aBjahU1d`fmRW#fj6~?t!K(;uqzNe#N-U;?NXGe5SIs+yAcd#m8Mwnz z)OmS;;2KY5;02SPa>+p@`>E;eo>b#%2Hwz9|CL;@^2?eDzi9s~&i6m`KOa^u10dQ1 zBm12`|E>!v!T-MO_f*5*k}PI{FDQ9@9g^pi@^hw9gi)4oG6op9a#j%{ED>!8C`a1Z z$`)aXCDPHxMC#1gq+~%Xok%;t L: BASE 10 w>t :ASM number ( str -- num 1 | str 0 ) ( AX - current number - BX - saved IP, as SI will be clobbered by LODSB + BH - 0 + BL - current character CX - current digit count, used to detect 0x prefix - DX - clobbered by IMUL - SI - remainder of string to be parsed ) - MOV BX SI ( save IP ) + DX - clobbered by IMUL + SI - remainder of string to be parsed + DI - saved IP, as SI will be clobbered by LODSB ) + MOV DI SI ( save IP ) POP SI PUSH SI MOV BASE 10 # XOR AX AX + XOR BX BX XOR CX CX L: next-digit - IMUL BASE MOV BL AL LODSB - CMP AL 0 # + XCHG AL BL + CMP BL 0 # JZ 1 @> ( string end ) - CMP AL key 9 # + CMP BL key 9 # JG 2 @> ( hex or fail ) - SUB AL key 0 # + SUB BL key 0 # JL 0 @> ( not a number ) L: parsed-digit - ADD BL AL - ADC AH 0 # + IMUL BASE + ADD AX BX INC CX JMP next-digit L: fail-digit 0 <: - MOV SI BX - PUSH 0 # + MOV SI DI + XOR CX CX + PUSH CX NEXT 1 <: ( string end ) JCXZ fail-digit ( empty string is not zero ) - MOV SI BX + MOV SI DI POP DX PUSH AX - PUSH 1 # + PUSH CX ( we know cx is nonzero and will be treated as true ) NEXT 2 <: ( hex or fail ) - CMP AL key x ( lowercase x ) + CMP BL key x # ( lowercase x ) JNZ 0 @> CMP CX 1 # ( x is second character ) JNZ 1 @> - CMP BL 0 # ( first character was a 0 ) + CMP AX 0 # ( first character was a 0 ) JNZ 2 @> MOV BASE 16 # JMP next-digit 0 <: 1 <: 2 <: ( actual parsing of hex digit ) - SUB AL key A # + SUB BL key A # JL fail-digit - ADD AL 10 # - CMP AL BASE + ADD BL 10 # + CMP BL BASE JL parsed-digit - SUB AL key a key A - 10 - # + SUB BL key a key A - 10 - # JL fail-digit - ADD AL 10 # - CMP AL BASE + ADD BL 10 # + CMP BL BASE JL parsed-digit JMP fail-digit @@ -212,7 +216,7 @@ L: fail-digit 0 <: NEXT :ASM emit - MOV AH 5 # + MOV AH 2 # POP DX INT 0x21 # NEXT @@ -224,9 +228,11 @@ L: fail-digit 0 <: ( test program ) ARRAY hex65 key 0 >t key x >t key 6 >t key 5 >t 0 >t -L: test-word L@ $$COLON w>t t' hex65 w>t t' emit w>t t' terminate w>t +L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t +0x101 @t . 9 <: ( actual entry point ) +0x101 @t . LEA SI test-word ( TODO: configure stacks ) NEXT