fix up number printing word

This commit is contained in:
Jeremy Penner 2023-09-04 14:23:12 -04:00
parent 8214784bc6
commit 8d5fbe0143
5 changed files with 34 additions and 14 deletions

2
.gitignore vendored
View file

@ -2,4 +2,4 @@
*.obj
*.dsk
errors.txt
*.sym

View file

@ -1,2 +1,3 @@
minijort < tinyjort.jrt

View file

@ -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 ;

Binary file not shown.

View file

@ -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