fix up number printing word
This commit is contained in:
parent
8214784bc6
commit
8d5fbe0143
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -2,4 +2,4 @@
|
|||
*.obj
|
||||
*.dsk
|
||||
errors.txt
|
||||
|
||||
*.sym
|
||||
|
|
3
defs.jrt
3
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 ;
|
||||
|
||||
|
|
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
42
tinyjort.jrt
42
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 <rot != if 2drop 0 return then 1 + ( word tword )
|
||||
|
@ -94,7 +96,7 @@ L@ $$VAR CONST $DOVAR
|
|||
|
||||
:ASM return
|
||||
DEC BP DEC BP
|
||||
MOV @[ BP] SI
|
||||
MOV SI @[ BP]
|
||||
NEXT
|
||||
|
||||
( some helpers for making manually defining colon words slightly less ugly )
|
||||
|
@ -556,35 +558,51 @@ L: fail-digit 0 <:
|
|||
JL parsed-digit
|
||||
JMP fail-digit
|
||||
|
||||
dbg" num>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
|
||||
|
|
Loading…
Reference in a new issue