rearranging code, implementing "type", progress / debug output
This commit is contained in:
parent
e5384d5aef
commit
8214784bc6
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
204
tinyjort.jrt
204
tinyjort.jrt
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue