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

add DU.R, D.R, U.R, and .R for right-aligned numeric output

This commit is contained in:
Jesse D. McDonald 2020-11-05 17:06:41 -06:00
parent 50fe63b104
commit ffb555c42f
1 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
startup.4th
View File

@ -973,15 +973,20 @@ CREATE PNO-BUFFER PNO-BUFFER-BYTES ALLOT
PNO-BUFFER PNO-BUFFER-BYTES + CONSTANT PNO-BUFFER-END PNO-BUFFER PNO-BUFFER-BYTES + CONSTANT PNO-BUFFER-END
CREATE PNO-POINTER PNO-BUFFER-END , CREATE PNO-POINTER PNO-BUFFER-END ,
\ Return the number of characters consumed/remaining in the PNO buffer
: PNO-USED ( -- u ) PNO-BUFFER-END PNO-POINTER @ - ;
: PNO-REMAINING ( -- u ) PNO-POINTER @ PNO-BUFFER - ;
\ THROW if there are less than u bytes remaining in the PNO buffer \ THROW if there are less than u bytes remaining in the PNO buffer
: PNO-CHECK ( u -- ) : PNO-CHECK ( u -- ) PNO-REMAINING U> IF EXCP-PNO-OVERFLOW THROW THEN ;
PNO-POINTER @ PNO-BUFFER - U> IF EXCP-PNO-OVERFLOW THROW THEN ;
>>FORTH >>FORTH
: <# PNO-BUFFER-END PNO-POINTER ! ; : <# PNO-BUFFER-END PNO-POINTER ! ;
: HOLD ( char -- ) PNO-POINTER 1 DUP PNO-CHECK OVER -! @ C! ; : HOLD ( char -- ) PNO-POINTER 1 DUP PNO-CHECK OVER -! @ C! ;
: HOLDS ( c-addr u -- ) PNO-POINTER OVER DUP PNO-CHECK OVER -! @ SWAP CMOVE ; : HOLDS ( c-addr u -- ) PNO-POINTER OVER DUP PNO-CHECK OVER -! @ SWAP CMOVE ;
: #PAD ( c n -- )
0 MAX DUP PNO-USED UMIN - DUP PNO-CHECK PNO-POINTER 2DUP -! @ SWAP ROT FILL ;
: #> ( xd -- c-addr u ) 2DROP PNO-BUFFER-END PNO-POINTER @ TUCK - ; : #> ( xd -- c-addr u ) 2DROP PNO-BUFFER-END PNO-POINTER @ TUCK - ;
: SIGN ( n -- ) 0< IF [[ CHAR - ]] HOLD THEN ; : SIGN ( n -- ) 0< IF [[ CHAR - ]] HOLD THEN ;
@ -1000,13 +1005,24 @@ CREATE PNO-POINTER PNO-BUFFER-END ,
\ Example: 12345 0 <# 3 #DFP #> ≡ "12.345" \ Example: 12345 0 <# 3 #DFP #> ≡ "12.345"
: #DFP ( ud1 u -- ud2 ) BEGIN ?DUP WHILE 1- >R # R> REPEAT [[ CHAR . ]] HOLD #S ; : #DFP ( ud1 u -- ud2 ) BEGIN ?DUP WHILE 1- >R # R> REPEAT [[ CHAR . ]] HOLD #S ;
\ Display the unsigned number at the top of the stack >>FORTH
: DU. ( ud -- "<digits>" ) <# #S #> TYPE ;
: U. ( u -- "<digits>" ) 0 DU. ;
\ Display the signed number at the top of the stack \ Display the unsigned double-cell number at the top of the stack, right-aligned
: D. ( d -- "<minus?><digits>" ) DUP -ROT DABS <# #S ROT SIGN #> TYPE ; : DU.R ( ud n -- "<digits>" ) >R <# #S BL R> #PAD #> TYPE ;
: . ( n -- "<minus?><digits>" ) S>D D. ;
\ Display the signed double-cell number at the top of the stack, right-aligned
: D.R ( d n -- "<minus?><digits>" )
>R DUP -ROT DABS <# #S ROT SIGN BL R> #PAD #> TYPE ;
\ Single-cell versions of DU.R and D.R
: U.R ( u n -- "<digits>" ) 0 SWAP DU.R ;
: .R ( n1 n2 -- "<minus?><digits>" ) >R S>D R> D.R ;
\ Versions of DU.R, D.R, U.R, and .R without right-alignment
: DU. ( ud -- "<digits>" ) 0 DU.R ;
: U. ( u -- "<digits>" ) 0 0 DU.R ;
: D. ( d -- "<minus?><digits>" ) 0 D.R ;
: . ( n -- "<minus?><digits>" ) S>D 0 D.R ;
\ Return the number of words on the data and return stacks, respectively \ Return the number of words on the data and return stacks, respectively
: DEPTH ( -- n ) SP@ S0 SWAP - CELL / ; : DEPTH ( -- n ) SP@ S0 SWAP - CELL / ;