diff --git a/tinyjort.com b/tinyjort.com index 46113e9..7187a32 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index adbdae4..af13ac8 100755 --- a/tinyjort.jrt +++ b/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 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