nybble
/
jumpforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add pictured numeric output definitions as per ANS FORTH

This commit is contained in:
Jesse D. McDonald 2020-10-20 21:59:12 -05:00
parent d90c8857e2
commit 4460297631
1 changed files with 33 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
startup.4th
View File

@ -190,22 +190,42 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
: DABS ( d -- +d ) DUP 0< IF DNEGATE THEN ;
80 CONSTANT PNO-BUFFER-BYTES
CREATE PNO-BUFFER PNO-BUFFER-BYTES ALLOT
PNO-BUFFER PNO-BUFFER-BYTES + CONSTANT PNO-BUFFER-END
CREATE PNO-POINTER PNO-BUFFER-END ,
: <# ( -- ) PNO-BUFFER-END PNO-POINTER ! ;
: HOLD ( char -- ) PNO-POINTER 1 OVER -! @ C! ;
: #> ( xd -- c-addr u ) 2DROP PNO-BUFFER-END PNO-POINTER @ TUCK - ;
' PNO-BUFFER (HIDE)
' PNO-BUFFER-END (HIDE)
' PNO-POINTER (HIDE)
: SIGN ( n -- ) 0< IF [CHAR] - HOLD THEN ;
: #B ( ud1 u -- ud2 )
UM/MOD ROT DUP 10 >= IF
10 - [CHAR] A +
ELSE
[CHAR] 0 +
THEN HOLD ;
: # ( ud1 -- ud2 ) 10 #B ;
: #SB ( ud u -- )
>R BEGIN R@ #B 2DUP D0= UNTIL RDROP ;
: #S ( ud -- ) 10 #SB ;
\ Display the unsigned number at the top of the stack
: U. ( u -- "<digits>" )
\ Start with the highest place-value on the left
1000000000
\ Skip place-values that would be larger than the input
BEGIN 2DUP U< OVER 1 U> AND WHILE 10 U/ REPEAT
\ Emit the remaining digits down to the units' place
BEGIN
TUCK U/MOD [CHAR] 0 + EMIT SWAP
DUP 1 U<= IF 2DROP EXIT THEN
10 U/
AGAIN ;
: DU. ( ud -- "<digits>" ) <# #S #> TYPE ;
: U. ( u -- "<digits>" ) 0 DU. ;
\ Display the signed number at the top of the stack
: . ( n -- "<minus?><digits>" )
DUP 0< IF [CHAR] - EMIT NEGATE THEN U. ;
: D. ( d -- "<minus?><digits>" ) DUP -ROT DABS <# #S ROT SIGN #> TYPE ;
: . ( n -- "<minus?><digits>" ) S>D D. ;
\ Display the content of the data stack
: .DS ( -- "<text>" )