diff --git a/.gitignore b/.gitignore index 7dab9df..0de5d82 100644 --- a/.gitignore +++ b/.gitignore @@ -2,4 +2,4 @@ *.obj *.dsk errors.txt - +*.sym diff --git a/build.bat b/build.bat index c242798..7e9a847 100755 --- a/build.bat +++ b/build.bat @@ -1,2 +1,3 @@ minijort < tinyjort.jrt + diff --git a/defs.jrt b/defs.jrt index fc49a40..9585aaa 100755 --- a/defs.jrt +++ b/defs.jrt @@ -82,5 +82,6 @@ : .hexnib ( x -- ) dup 0 >= over 9 <= and if [ key 0 lit ] else 10 - [ key A lit ] then + emit ; -: .hex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ; +: .bhex dup 0xf0 & 4 >> .hexnib 0x0f & .hexnib bl ; +: .hex dup 0xf000 & 12 >> .hexnib dup 0x0f00 & 8 >> .hexnib .bhex ; diff --git a/tinyjort.com b/tinyjort.com index 7187a32..a292488 100755 Binary files a/tinyjort.com and b/tinyjort.com differ diff --git a/tinyjort.jrt b/tinyjort.jrt index af13ac8..9fae020 100755 --- a/tinyjort.jrt +++ b/tinyjort.jrt @@ -39,12 +39,14 @@ L: DICTIONARY L: LATEST 0 w>t : savelabel ( word -- ) + dup type s" : " type here swap begin dup b@ dup while b, 1 + repeat b, drop lastlabel ! ; : DICTLIST ( word -- tptr ) b@ 0x0f & cells [ L@ DICTIONARY lit ] + ; : strlen ( word -- len ) 0 swap begin dup b@ while swap 1 + swap 1 + repeat drop ; : str>t ( word -- ) begin dup b@ dup while >t 1 + repeat >t drop ; : link>t ( tptr-head -- ) dup @t swap target @ swap !t w>t ; -: DEF word dup savelabel dup DICTLIST link>t 0 >t dup strlen >t str>t ; +: DEF word dup savelabel dup DICTLIST link>t 0 >t dup strlen >t str>t + target @ cell + .hex cr ; : WORD= ( word len tptr -- f ) 3 + dup b@t str" +L: DECDIVISORS 1 w>t 10 w>t 100 w>t 1000 w>t 10000 w>t :ASM num>str MOV DI t& &here @+ POP AX + CMP AX 0 # + JGE 0 @> + MOV BYTE @[ DI] key - # + NEG AX + INC DI +0 <: + PUSH SI + MOV SI 4 cells # + MOV BX L@ DECDIVISORS # + MOV CX 4 # ( CX=0 when we should write zeros ) L: write-next-digit XOR DX DX - MOV BX 10 # - IDIV BX - XCHG DX AX + IDIV @[ BX+SI] + CMP AX 0 # + JNZ 1 @> + JCXZ 0 @> ( unconditionally write a zero ) + DEC CX ( if we haven't written any digits this will hit 0 on the ones place ) + JMP 2 @> +1 <: 0 <: + XOR CX CX ADD AX key 0 # STOSB - XCHG DX AX - CMP AX 0 # - JNZ write-next-digit +2 <: + MOV AX DX + DEC SI + DEC SI + JNS write-next-digit ( once SI decrements below zero the sign bit will set ) XOR AX AX STOSB ( trailing 0 ) + POP SI 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 - >t key 6 >t key 5 >t 0 >t -L: test-word '>t hex65 '>t number '>t drop '>t . '>t terminate +L: test-word '>t hex65 '>t number '>t . '>t . '>t terminate 9 <: ( actual entry point ) LEA SI test-word