SpindleyQ/dialer
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

cleaning up and testing number parsing

Browse source
This commit is contained in:
Jeremy Penner 2023-09-01 19:10:54 -04:00
parent 63ee66a8e5
commit be7950520e
3 changed files with 102 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

101
asm.jrt
View file

@ -84,10 +84,14 @@ array patchtable 10 2 cells * allot
: patch-a16 ( tptr targ -- ) swap !t ; : patch-a16 ( tptr targ -- ) swap !t ;
: patch-r16 ( tptr targ -- ) over 2 + - swap !t ; : patch-r16 ( tptr targ -- ) over 2 + - swap !t ;
: patch-r8 ( tptr targ -- ) over 1 + - swap b!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 -- ) 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: here create wordname lastlabel ! target @ , does> @ @+ ;
: L@ [ ' ' , ] 2 cells + @ ; : L@ [ ' ' , ] 2 cells + @ ;
@ -110,7 +114,7 @@ array patchtable 10 2 cells * allot
: start-op ( dictentry argcount -- ) : start-op ( dictentry argcount -- )
0 op-memwidth ! ( start unknown ) 0 op-memwidth ! ( start unknown )
opargs-remaining @ if s" not enough arguments" operror then 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 ; : prefix create , does> @ >t ;
: 0op here create wordname , b, does> dup @ 0 start-op cell + b@ >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" ) ( convention: words ending in * mean "will return if matched" )
: disp>t pre-disp-write 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 ; 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. ( 2ret: return immediately from this word and calling word.
equivalent to rdrop return. ) equivalent to rdrop return. )
@ -162,14 +169,22 @@ array patchtable 10 2 cells * allot
: >extmem* oparg-mem? byteop? not and if >mem 2ret then 2drop ; : >extmem* oparg-mem? byteop? not and if >mem 2ret then 2drop ;
: >extbmem* oparg-mem? byteop? 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 ; : >extbreg* ( ext op -- ) oparg-breg? if >extreg 2ret then 2drop ;
: >extreg* ( ext op -- ) oparg-wreg? if >extreg 2ret then 2drop ; : >extreg* ( ext op -- ) oparg-wreg? if >extreg 2ret then 2drop ;
: >extwreg|mem* ( ext op -- ) byteop? not if : *? ( cp -- f ) :| execute 0 2ret |; execute 1 ;
oparg-wreg? if >extreg 2ret then
oparg-mem? if >mem 2ret then : >extwreg|mem* ( ext op -- )
then 2drop ; 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 RET- oparg-imm? if oparg-val @ w>t then ;
1 :op PUSH 1 :op PUSH
@ -182,16 +197,12 @@ array patchtable 10 2 cells * allot
0 0x8f >extmem* ; 0 0x8f >extmem* ;
1 :op INC 1 :op INC
0x40 >wreg+op* 0x40 >wreg+op*
0 0xfe >extbreg* 0 0xfe >extbreg|mem*
0 0xff >extreg* 0 0xff >extwreg|mem* ;
0 0xff >extmem*
1 0xff >extmem* ;
1 :op DEC 1 :op DEC
0x48 >wreg+op* 0x48 >wreg+op*
1 0xfe >extbreg* 1 0xfe >extbreg|mem*
1 0xff >extreg* 1 0xff >extwreg|mem* ;
1 0xff >extmem*
1 0xfe >extbmem* ;
1 :op INT 1 :op INT
oparg-imm? if oparg-imm? if
oparg-val @ dup 3 = if drop 0xcc >t else 0xcd >t >t then 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 LOOP 0xe2 >short-jmp* ;
1 :op JCXZ 0xe3 >short-jmp* ; 1 :op JCXZ 0xe3 >short-jmp* ;
1 :op JMP 1 :op JMP
0xeb >short-jmp*
0xe9 >near-reljmp* 0xe9 >near-reljmp*
0xeb >short-jmp*
0xea >far-jmp* 0xea >far-jmp*
farptr? if 0x05 0xff >extmem* then farptr? if 0x05 0xff >extmem* then
0x04 0xff >extmem* ( todo: JMP to reg allowed ) ; 0x04 0xff >extwreg|mem* ;
1 :op CALL 1 :op CALL
0xe8 >near-reljmp* 0xe8 >near-reljmp*
farptr? if 0x03 0xff >extmem* then 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: ( four opcodes laid out next to each other:
byte mem, reg | word mem, reg | byte reg, mem | word reg, mem ) 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 ) : >brr-wrr? ( base -- f )
regreg? if 1 + else bregbreg? not if drop 0 return then then >regreg 1 ; 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 -- ) : >bmr-wmr-brm-wrm* ( base -- )
dup >bmr-wmr? if drop 2ret then dup >bmr-wmr? if drop 2ret then
dup >brr-wrr? 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 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 ; 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 2 :op XCHG
arg2 oparg-reg? oparg-val @ 0x00 = arg1 oparg-wreg? and 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 2 :op MOV
0x88 >bmr-wmr-brm-wrm* 0x88 >bmr-wmr-brm-wrm*
arg2 oparg-imm? arg1 if arg2 oparg-imm? arg1 if
@ -276,12 +310,21 @@ array patchtable 10 2 cells * allot
0 0xc6 >extbmem* 0 0xc6 >extbmem*
0 0xc7 >extmem* 0 0xc7 >extmem*
then ; then ;
2 :op ADD 0x00 >6group-math* ; 2 :op ADD 0x00 >6group-math* 0 >grp1* ;
2 :op ADC 0x10 >6group-math* ; 2 :op ADC 0x10 >6group-math* 2 >grp1* ;
2 :op AND 0x20 >6group-math* ; 2 :op AND 0x20 >6group-math* 4 >grp1* ;
2 :op XOR 0x30 >6group-math* ; 2 :op XOR 0x30 >6group-math* 6 >grp1* ;
2 :op OR 0x08 >6group-math* ; 2 :op OR 0x08 >6group-math* 1 >grp1* ;
2 :op SBB 0x18 >6group-math* ; 2 :op SBB 0x18 >6group-math* 3 >grp1* ;
2 :op SUB 0x28 >6group-math* ; 2 :op SUB 0x28 >6group-math* 5 >grp1* ;
2 :op CMP 0x38 >6group-math* ; 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 ;

BIN
tinyjort.com
View file

Binary file not shown.

52
tinyjort.jrt
View file

@ -118,62 +118,66 @@ DEF GOTO_ L@ GOTO_IMPL w>t
L: BASE 10 w>t L: BASE 10 w>t
:ASM number ( str -- num 1 | str 0 ) :ASM number ( str -- num 1 | str 0 )
( AX - current number ( 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 CX - current digit count, used to detect 0x prefix
DX - clobbered by IMUL DX - clobbered by IMUL
SI - remainder of string to be parsed ) SI - remainder of string to be parsed
MOV BX SI ( save IP ) DI - saved IP, as SI will be clobbered by LODSB )
MOV DI SI ( save IP )
POP SI POP SI
PUSH SI PUSH SI
MOV BASE 10 # MOV BASE 10 #
XOR AX AX XOR AX AX
XOR BX BX
XOR CX CX XOR CX CX
L: next-digit L: next-digit
IMUL BASE
MOV BL AL MOV BL AL
LODSB LODSB
CMP AL 0 # XCHG AL BL
CMP BL 0 #
JZ 1 @> ( string end ) JZ 1 @> ( string end )
CMP AL key 9 # CMP BL key 9 #
JG 2 @> ( hex or fail ) JG 2 @> ( hex or fail )
SUB AL key 0 # SUB BL key 0 #
JL 0 @> ( not a number ) JL 0 @> ( not a number )
L: parsed-digit L: parsed-digit
ADD BL AL IMUL BASE
ADC AH 0 # ADD AX BX
INC CX INC CX
JMP next-digit JMP next-digit
L: fail-digit 0 <: L: fail-digit 0 <:
MOV SI BX MOV SI DI
PUSH 0 # XOR CX CX
PUSH CX
NEXT NEXT
1 <: ( string end ) 1 <: ( string end )
JCXZ fail-digit ( empty string is not zero ) JCXZ fail-digit ( empty string is not zero )
MOV SI BX MOV SI DI
POP DX POP DX
PUSH AX PUSH AX
PUSH 1 # PUSH CX ( we know cx is nonzero and will be treated as true )
NEXT NEXT
2 <: ( hex or fail ) 2 <: ( hex or fail )
CMP AL key x ( lowercase x ) CMP BL key x # ( lowercase x )
JNZ 0 @> JNZ 0 @>
CMP CX 1 # ( x is second character ) CMP CX 1 # ( x is second character )
JNZ 1 @> JNZ 1 @>
CMP BL 0 # ( first character was a 0 ) CMP AX 0 # ( first character was a 0 )
JNZ 2 @> JNZ 2 @>
MOV BASE 16 # MOV BASE 16 #
JMP next-digit JMP next-digit
0 <: 1 <: 2 <: ( actual parsing of hex digit ) 0 <: 1 <: 2 <: ( actual parsing of hex digit )
SUB AL key A # SUB BL key A #
JL fail-digit JL fail-digit
ADD AL 10 # ADD BL 10 #
CMP AL BASE CMP BL BASE
JL parsed-digit JL parsed-digit
SUB AL key a key A - 10 - # SUB BL key a key A - 10 - #
JL fail-digit JL fail-digit
ADD AL 10 # ADD BL 10 #
CMP AL BASE CMP BL BASE
JL parsed-digit JL parsed-digit
JMP fail-digit JMP fail-digit
@ -212,7 +216,7 @@ L: fail-digit 0 <:
NEXT NEXT
:ASM emit :ASM emit
MOV AH 5 # MOV AH 2 #
POP DX POP DX
INT 0x21 # INT 0x21 #
NEXT NEXT
@ -224,9 +228,11 @@ L: fail-digit 0 <:
( test program ) ( test program )
ARRAY hex65 key 0 >t key x >t key 6 >t key 5 >t 0 >t 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 ) 9 <: ( actual entry point )
0x101 @t .
LEA SI test-word LEA SI test-word
( TODO: configure stacks ) ( TODO: configure stacks )
NEXT NEXT