cleaning up and testing number parsing
This commit is contained in:
parent
63ee66a8e5
commit
be7950520e
101
asm.jrt
101
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 ;
|
||||
|
||||
|
|
|
|||
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
54
tinyjort.jrt
54
tinyjort.jrt
|
|
@ -118,62 +118,66 @@ DEF GOTO_ L@ GOTO_IMPL w>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
|
||||
|
|
|
|||
Loading…
Reference in a new issue