rearranging code, implementing "type", progress / debug output

main
Jeremy Penner 2023-09-03 15:21:56 -04:00
parent e5384d5aef
commit 8214784bc6
2 changed files with 135 additions and 69 deletions

Binary file not shown.

View File

@ -60,6 +60,8 @@ L: LATEST 0 w>t
: :ASM DEF target @ 2 + w>t ;
dbg" core"
L: $$CONST
INC BX INC BX
PUSH @[ BX]
@ -97,7 +99,6 @@ L@ $$VAR CONST $DOVAR
( some helpers for making manually defining colon words slightly less ugly )
: '>t t' w>t ;
: @>t t& @t w>t ;
: :t DEF [ t& $DOCOLON lit ] w>t ;
:CP $DODEFERRED
@ -130,72 +131,6 @@ L: GOTO_IMPL 0 <:
DEF GOTO_ L@ GOTO_IMPL w>t
L: BASE 10 w>t
:ASM number ( str -- num 1 | str 0 )
( AX - current number
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
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
MOV BL AL
LODSB
XCHG AL BL
CMP BL 0 #
JZ 1 @> ( string end )
CMP BL key 9 #
JG 2 @> ( hex or fail )
SUB BL key 0 #
JL 0 @> ( not a number )
L: parsed-digit
IMUL BASE
ADD AX BX
INC CX
JMP next-digit
L: fail-digit 0 <:
MOV SI DI
XOR CX CX
PUSH CX
NEXT
1 <: ( string end )
JCXZ fail-digit ( empty string is not zero )
MOV SI DI
POP DX
PUSH AX
PUSH CX ( we know cx is nonzero and will be treated as true )
NEXT
2 <: ( hex or fail )
CMP BL key x # ( lowercase x )
JNZ 0 @>
CMP CX 1 # ( x is second character )
JNZ 1 @>
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 BL key A #
JL fail-digit
ADD BL 10 #
CMP BL BASE
JL parsed-digit
SUB BL key a key A - 10 - #
JL fail-digit
ADD BL 10 #
CMP BL BASE
JL parsed-digit
JMP fail-digit
:ASM drop
POP AX
NEXT
@ -239,6 +174,7 @@ L: fail-digit 0 <:
POP BX
JMP @[ BX]
dbg" math"
:ASM +
POP AX POP BX
ADD AX BX
@ -257,6 +193,7 @@ L: fail-digit 0 <:
PUSH AX
NEXT
dbg" comparisons"
L: TRUE 0xffff w>t
L: FALSE 0 w>t
L: RETTRUE
@ -313,6 +250,7 @@ L: RETFALSE
:t <= '>t > '>t not '>t return
:t >= '>t < '>t not '>t return
dbg" bitwise"
:ASM &
POP AX
POP BX
@ -348,6 +286,7 @@ L: RETFALSE
PUSH AX
NEXT
dbg" mem"
:ASM @
POP BX
MOV AX @[ BX]
@ -401,6 +340,7 @@ L: RETFALSE
MOV @[ ES: BX] AL
NEXT
dbg" return stack"
:ASM >r
POP AX
MOV @[ BP] AX
@ -429,6 +369,24 @@ L: RETFALSE
MOV @[ -4 @+ BP] AX
NEXT
dbg" ASMEXEC"
( usage: push a CP onto the stack, then CALL ASMEXEC.
will execute the word and then return to your assembly code.
note that this will clobber AX and BX and possibly all other registers!! )
( does not work - I think LEA @> is broken
L: ASMEXEC
LEA BX 1 @> dbg" forward label?"
JMP @[ BX]
:ASM asmret
DEC BP DEC BP
MOV @[ BP] SI
RET
1 find-patch @ . 1 find-patch cell + @ .
1 <:
dbg" patched"
t& $DOCOLON w>t '>t >r '>t execute '>t <r '>t asmret
)
dbg" allocation"
0 VAR, &here
:t here '>t &here '>t @ '>t return
:t here! '>t &here '>t ! '>t return
@ -446,6 +404,7 @@ L: RETFALSE
:t , '>t here '>t ! '>t cell '>t allot '>t return
:t b, '>t here '>t b! '>t LIT_ 1 w>t '>t allot '>t return
dbg" i/o"
:ASM overwrite
MOV AH 0x3c #
XOR CX CX ( non-system, non-hidden )
@ -516,9 +475,116 @@ DEFERRED emit console-emit
'>t fgetc '>t return
DEFERRED key in-key
dbg" number"
L: BASE 10 w>t L: ISNEG? 0 >t
:ASM number ( str -- num 1 | str 0 )
( AX - current number
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
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
MOV BYTE ISNEG? AL
L: next-digit
MOV BL AL
LODSB
XCHG AL BL
CMP BL 0 #
JZ 1 @> ( string end )
JCXZ 3 @> ( starts with negative? )
L: parse-digit
CMP BL key 9 #
JG 2 @> ( hex or fail )
SUB BL key 0 #
JL 0 @> ( not a number )
L: parsed-digit
IMUL BASE
ADD AX BX
INC CX
JMP next-digit
L: fail-digit 0 <:
MOV SI DI
XOR CX CX
PUSH CX
NEXT
1 <: ( string end )
JCXZ fail-digit ( empty string is not zero )
CMP BYTE ISNEG? 0 #
JZ 1 @>
NEG AX
1 <:
MOV SI DI
POP DX
PUSH AX
PUSH CX ( we know cx is nonzero and will be treated as true )
NEXT
3 <: ( negative? )
CMP BL key - #
JNZ parse-digit
CMP BYTE ISNEG? 0 #
JNZ fail-digit ( only one negative sign allowed )
MOV BYTE ISNEG? BL ( any nonzero value will do )
JMP next-digit
2 <: ( hex or fail )
CMP BL key x # ( lowercase x )
JNZ 0 @>
CMP CX 1 # ( x is second character )
JNZ 1 @>
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 BL key A #
JL fail-digit
ADD BL 10 #
CMP BL BASE
JL parsed-digit
SUB BL key a key A - 10 - #
JL fail-digit
ADD BL 10 #
CMP BL BASE
JL parsed-digit
JMP fail-digit
dbg" num>str"
:ASM num>str
MOV DI t& &here @+
POP AX
L: write-next-digit
XOR DX DX
MOV BX 10 #
IDIV BX
XCHG DX AX
ADD AX key 0 #
STOSB
XCHG DX AX
CMP AX 0 #
JNZ write-next-digit
XOR AX AX
STOSB ( trailing 0 )
PUSH t& &here @+
NEXT
dbg" type"
:t type target @ '>t dup '>t b@ '>t dup '>t BZ_ target @ 7 cells + w>t
'>t emit '>t LIT_ 1 w>t '>t + '>t GOTO_ w>t '>t drop '>t drop '>t return
dbg" ."
:t . '>t num>str '>t type '>t LIT_ key w>t '>t emit '>t return
dbg" test"
( test program )
ARRAY hex65 key 6 >t key 5 >t 0 >t
L: test-word t' hex65 w>t t' number w>t t' drop w>t t' emit w>t t' terminate w>t
ARRAY hex65 key - >t key 6 >t key 5 >t 0 >t
L: test-word '>t hex65 '>t number '>t drop '>t . '>t terminate
9 <: ( actual entry point )
LEA SI test-word