add pictured numeric output definitions as per ANS FORTH
This commit is contained in:
parent
d90c8857e2
commit
4460297631
46
startup.4th
46
startup.4th
|
|
@ -190,22 +190,42 @@ DEFER THROW-UNWIND ( k*x n -- i*x <noreturn> )
|
||||||
|
|
||||||
: DABS ( d -- +d ) DUP 0< IF DNEGATE THEN ;
|
: 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
|
\ Display the unsigned number at the top of the stack
|
||||||
: U. ( u -- "<digits>" )
|
: DU. ( ud -- "<digits>" ) <# #S #> TYPE ;
|
||||||
\ Start with the highest place-value on the left
|
: U. ( u -- "<digits>" ) 0 DU. ;
|
||||||
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 ;
|
|
||||||
|
|
||||||
\ Display the signed number at the top of the stack
|
\ Display the signed number at the top of the stack
|
||||||
: . ( n -- "<minus?><digits>" )
|
: D. ( d -- "<minus?><digits>" ) DUP -ROT DABS <# #S ROT SIGN #> TYPE ;
|
||||||
DUP 0< IF [CHAR] - EMIT NEGATE THEN U. ;
|
: . ( n -- "<minus?><digits>" ) S>D D. ;
|
||||||
|
|
||||||
\ Display the content of the data stack
|
\ Display the content of the data stack
|
||||||
: .DS ( -- "<text>" )
|
: .DS ( -- "<text>" )
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue