\ printf
\ Neal Bridges, 1999.
decimal
: binary 2 base ! ;
: octal 8 base ! ;
[undefined] ud.r [if]
\ Same function as D.R, but unsigned.
: ud.r rot rot <# #s #> rot over - spaces type ;
: u.r 0 swap ud.r ;
: .r >r s>d r> d.r ;
[then]
variable .numbervector
: .number ( x1...x? index fieldwidth -- index )
\ Display stack items x1...x? using the xt in .numbervector.
\ Right align the data in a field of fieldwidth spaces.
swap >r .numbervector @
execute r> ;
: parsenum ( caddr -- nextcaddr dnum )
\ Parse and extract from a string a leading double-cell unsigned number.
0 s>d rot 255 \ max string length of number
( 0. caddr 255 -- ) >number
drop \ residual length of string -- not valid
rot rot ( nextcaddr dnum -- ) ;
: %spec ( caddr -- caddr+1 )
\ Handle most printf-style % format specifiers.
\ Default to single cell unsigned representation:
['] .r .numbervector !
char+
decimal parsenum drop \ extract field width specifier (if present)
over c@ case
[char] c of drop swap emit endof
[char] s of swap >r >r dup r> swap - spaces type r> endof
[char] % of drop [char] % emit endof
[char] d of decimal rot
s>d rot d.r endof \ Signed
[char] u of decimal .number endof
[char] p of drop 0 hex ." 0x" .number endof
[char] X of hex .number endof
[char] o of octal .number endof
[char] b of binary .number endof \ not ANSI C
\ Default:
abort" Unsupported format specifier."
endcase ;
: \spec ( caddr -- caddr+1 )
\ Handle most printf-style \ escapes.
char+ dup c@ case
[char] x of char+ hex parsenum drop emit
\ Backup one char to compensate for parsenum:
-1 chars +
endof
[char] n of cr endof \ Newline
[char] f of page endof \ Form feed
\ These work properly under Linux, etc. :
\ [char] a of beep endof \ Bell
\ [char] b of 8 emit endof \ Backspace
\ [char] t of 9 emit endof \ Tab
dup [char] 0 - dup 7 and = \ Octal?
if drop octal parsenum drop
\ Backup one char to compensate for parsenum:
swap -1 chars + swap
then \ fall through to Default
\ Default:
emit
0 endcase ;
: printf ( c u )
base @ >r
chars over + ( index limit -- )
begin 2dup < while
>r dup c@ case
[char] % of %spec endof
[char] \ of \spec endof
emit
0 endcase
char+ r> repeat
2drop r> base ! ;