[# and <# come from two different design philosophies. The <# philosophy has the called 'word' 'function' (call it what you like) supplying the address. This creates two problems:
1) The function either has to use a fixed location, making the function non re-entrant, or take the buffer out of a pool and either have the user call another function to return the buffer, or hand the responsibility of buffer return to the user. The first solution complicates the users life, the second places a lot of resposibility on the user.
2) You more often than not you have to move data as the programmer has no way of having the function place the data where he wants it.
It is far better to take the path offered by [# Have the user supply the data area and give the user easy to use data area allocation functions.
Anyway if you look at the number output words only (d.) (d.r) and #> supply the address of the data. The kernel uses [# for all number output, as a result you can use .S in the middle of a [# word and not destroy what you are trying to create. (d.) and (d.r) are not ANS words so take care, they are written to suit the preferred implementation. <# , #> and PAD are available, but it would be better to use [# , #] , get_buffer and buffer_end.
The buffer should be a minimum of #picture_min bytes long. The kernel does not do overflow checks.
HEX
User data area. The _hold> cell holds the address below where the next character is to be place. The _hold_base hold the end address of the string. The pictured number words always build the string downwards.
\ picture number conversion pointer
uvariable _hold>
\ picture number conversion base
uvariable _hold_base
If claiming a buffer for pictured number conversion use #picture_min to specify the buffer length.
The minimum picture size is about 25 bytes if no characters are held in the picture. We make it so it will just fit in a 80 hex byte buffer.
??HEX
80 _#sys_buffer_user - CONSTANT #picture_min
Number conversion data area needed for <#, as it is allocated as a ubuffer the data area will only exist if used. The kernel does not use it.
#picture_min ubuffer _picture_buffer
CORE
( n -- )
If n is greater than zero, display n spaces.
: SPACES ( n --)
$buffer \ n(--
buffer OVER #$maximum_data MIN BL FILL \ n(--
BEGIN
buffer OVER #$maximum_data MIN TYPE \ n(--
DUP #$maximum_data MIN -
DUP 0= \ n1 flag(--
UNTIL
DROP
kill_buffer
;
CORE
( -- )
Display one space.
: SPACE ( --)
BL EMIT
;
CORE
( char -- )
Add char to the beginning of the pictured numeric output string. An ambiguous condition exists if HOLD executes outside of a <# #> delimited number conversion.
COLDFORTH HOLD can be used between [# and #]
: HOLD ( char --)
_hold> @ 1 - C! -1 _hold> +!
;
_hold> points to the start of a sting being built down in memory this word adds a string TO that string. "hold can be used between <# #> and [# #]
: "hold ( c-addr len -- )
DUP \ addr len len (--
NEGATE \ addr len -len (--
_hold> +! \ addr len (-- now points TO where start will be after move
_hold> @ \ addr len to(--
SWAP \ from to len (--
MOVE
;
Factors out the conversion of a digit to a printable character.
: digit ( n -- ascii)
9 OVER < IF
[ CHAR A CHAR 9 - 1- ]T LITERAL +
THEN
[CHAR] 0 +
;
Move a counted string to the pictured number area. Can be used between <# #> and [# #]
: $hold ( $ --)
COUNT
"hold
;
CORE
( n -- )
If n is negative, add a minus sign to the beginning of the pictured numeric output string. An ambiguous condition exists if SIGN executes outside of a <# #> delimited number conversion.
COLDFORTH SIGN can be used between [# and #]
: SIGN ( n --)
0< IF
[CHAR] - HOLD
THEN
;
CORE
( ud1 -- ud2 )
Divide ud1 by the number in BASE giving the quotient ud2 and the remainder n. (n is the least-significant digit of ud1.) Convert n to external form and add the resulting character to the beginning of the pictured numeric output string. An ambiguous condition exists if # executes outside of a <# #> delimited number conversion.
COLDFORTH # can be used between [# and #]
: # ( lo hi -- lo hi )
BASE @ \ lo hi base (--
mu/mod \ rem lo hi (--
ROT
digit HOLD
;
CORE
( ud1 -- ud2 )
Convert one digit of ud1 according to the rule for #. Continue conversion until the quotient is zero. ud2 is zero. An ambiguous condition exists if #S executes outside of a <# #> delimited number conversion.
COLDFORTH #S can be used between [# and #]
: #S ( lo hi -- lo hi )
BEGIN
# 2DUP OR \ d flag (--
0=
UNTIL
;
Drop xd. Make the pictured numeric output string available as a character string. c-addr and u specify the resulting character string.
: #] ( sys lo hi -- c-addr u)
2DROP
_hold> @ _hold_base @ OVER -
2SWAP
_hold_base !
_hold> !
;
CORE
( xd -- c-addr u )
Drop xd. Make the pictured numeric output string available as a character string. c-addr and u specify the resulting character string. A program may replace characters within the string.
: #> ( lo hi -- c-addr u)
zero zero 2SWAP \ put back sys(--
#] ;
Start a pictured number conversion using the supplied address and count. The picture is built down. This version does not check for overflow, but there is no reason why you can't.
: [# ( lo hi addr count --sys0 sys1 lo hi)
\ the picture is always built back from the pointer
\ so the base is the end.
_hold> @
_hold_base @ \ lo hi addr count sys1 sys2(--
2SWAP \ lo hi sys1 sys2 addr count(--
+ DUP _hold_base ! \ lo hi sys1 sys2 addr_end(--
_hold> !
2SWAP \ sys1 sys2 lo hi(--
;
CORE
( -- )
Initialize the pictured numeric output conversion process. Not recommended look at using [# instead.
: <# ( lo hi -- lo hi )
_picture_buffer #picture_min [# \ sys lo hi(--
\ get rid of sys
2SWAP 2DROP
;
Note this requires a buffer address and count, the address can be a character boundary, see r.
: (d.) ( l h addr n -- addr len )
[#
TUCK \ h l h (--
DABS \ h |d| (--
#S \ h 0d (--
ROT SIGN
#] \ addr len (--
;
DECIMAL number in form nnn.nnn.nnn.nnn with no leading zeros.
: (.ip) ( ip_addr zero addr n -- addr n )
BASE @ >R
DECIMAL
[#
\ ip_addr zero(--
3 0 DO
OVER $FF AND zero
BEGIN
#
OVER not UNTIL
[CHAR] . HOLD
2DROP
SWAP
8 RSHIFT
SWAP
LOOP
OVER $FF AND zero BEGIN
#
OVER not UNTIL
2DROP
#]
R> BASE !
;
DOUBLE
( d -- )
Display d in free field format.
: D. ( l h -- )
#picture_min get_buffer
buffer #picture_min (d.)
TYPE SPACE
kill_buffer
;
DOUBLE
( d n -- )
Display d right aligned in a field n characters wide. If the number of characters required to display d is greater than n, all digits are displayed with no leading spaces in a field as wide as necessary.
In D.R, the R is short for RIGHT.
: D.R ( d len -- )
#picture_min
get_buffer
>R
buffer #picture_min (d.)
R> OVER -
zero MAX
SPACES
TYPE
kill_buffer
;
Display d left aligned in a field n characters wide. If the number of characters required to display d is greater than n, all digits are displayed with no leading spaces in a field as wide as necessary.
: d.l ( d len -- )
#picture_min get_buffer
>R \ lo hi (--
buffer #picture_min (d.) \ addr len (--
TUCK \ len addr len (--
TYPE \ len (--
R> SWAP -
zero MAX
SPACES
kill_buffer
;
CORE
( n -- )
Display n in free field format.
: . ( n --)
S>D D. SPACE
;
dot-r CORE EXT
( n1 n2 -- )
Display n1 right aligned in a field n2 characters wide. If the number of characters required to display n1 is greater than n2, all digits are displayed with no leading spaces in a field as wide as necessary.
In .R, R is short for RIGHT.
HEX
: .R ( n1 len --)
>R
S>D
R>
D.R
;
The l stands or LEFT
: .l ( n1 len --)
>R S>D R> d.l
;
CORE
( u -- )
Display u in free field format.
: U. ( u --)
u>d \ extend as unsigned number
D.
;
CORE EXT
( u n -- )
Display u right aligned in a field n characters wide. If the number of characters required to display u is greater than n, all digits are displayed with no leading spaces in a field as wide as necessary.
: U.R ( u len --)
u>d SWAP D.R
;
TOOLS
( a-addr -- )
Display the value stored at a-addr.
? may be implemented using pictured numeric output words.
Consequently, its use may corrupt the transient region identified by #>.
COLDFORTH
DON'T USE THIS LET IT DIE
: ? ( a-addr --)
@ .
;
Print the unsigned number as a 8 digit hex number with one leading space. Nice and handy for displaying memory.
: .h ( u --)
BASE @ >R
HEX
u>d \ lo hi (--
#picture_min get_buffer
buffer #picture_min [# BL HOLD # # # # # # # # #] TYPE
kill_buffer
R> BASE !
;
No every one knows real programers have BASE set to 16, full time. Every now and again you do need to convert a number to decimal. This word is for you.
: .d ( u --)
BASE @ >R
DECIMAL
.
R> BASE !
;
DECIMAL
An array containing the months as 4 byte counted strings.
CREATE $months
," JAN" ," FEB" ," MAR" ," APR" ," MAY" ," JUN" ," JUL" ," AUG"
," SEP" ," OCT" ," NOV" ," DEC"
Given the year month day and a buffer, place a string representing the date below the given address. The address returned is the address of a counted string located in the supplied buffer.
: $date ( year month day addr n --$)
2>R
ROT DUP 1900 < IF
1900 +
THEN
\ year
u>d 2R@ [# # # # # BL HOLD #] \ mmm ddd addr count1(--
R> OVER - >R NIP \ mmm ddd count1 (--
-rot \ count1 mmm ddd (--
\ month
SWAP u>d \ count1 ddd mmml mmmh (--
2R@
[# DROP 1- zero MAX 11 MIN 4* $months + $hold BL HOLD zero zero #] \ count1 ddd addr count2 (--
\ adjust buffer
R> OVER - >R NIP \ count1 ddd count2
ROT + SWAP \ count3 ddd
u>d
2R>
[# # # #] \ count3 addr count
ROT + \ addr count3(--
\ turn into a $string
OVER [ _#$_count _#$_data - ]T LITERAL + $count!
[ _#$_count _#$_data - ]T LITERAL +
;
Given the year month and day print a date in the form.
dd mmm yyyy
: .date ( yyy mmm ddd -- )
#picture_min get_buffer
buffer #picture_min $date
$type
kill_buffer
;
Give the time in ticks ( 10msec increments since midnight), create a string below address that represents the time, to the second. The address returned is the address of a counted string located n the supplied buffer.
: $sec ( ticks addr n -- $ )
BASE @ >R
2>R
u>d
2R>
[#
DROP
#1sec / ( to secs)
u>d
DECIMAL # 6 BASE W! # [CHAR] : HOLD
DECIMAL # 6 BASE W! # [CHAR] : HOLD
DECIMAL # #
#]
\ turn into a $string
OVER [ _#$_count _#$_data - ]T LITERAL + $count!
[ _#$_count _#$_data - ]T LITERAL +
R> BASE !
;
Given the time in ticks ( 10 msec increments since midnight), print out the time in the form:
hh:mm:ss: .sec ( ticks--) #picture_min get_buffer buffer #picture_min $sec $type kill_buffer ;$time
Give the time in ticks ( 10msec increments since midnight), create a string below address that represents the time, to the minute. The address returned is the address of a counted string located n the supplied buffer.
: $time ( ticks addr n -- addr) BASE @ >R 2>R u>d 2R> [# DROP [ #1sec 60 * ]T LITERAL / ( To mins) u>d DECIMAL # 6 BASE W! # [CHAR] : HOLD DECIMAL # # #] OVER [ _#$_count _#$_data - ]T LITERAL + $count! [ _#$_count _#$_data - ]T LITERAL + R> BASE ! ;.time
Given the time in ticks ( 10 msec increments since midnight), print out the time in the form:
hh:mm: .time ( n --) #picture_min get_buffer buffer #picture_min $time $type kill_buffer ;$ticks
Give the time in ticks ( 10msec increments since midnight), create a string below address that represents the time, to the msec. The address returned is the address of a counted string located n the supplied buffer.
: $ticks ( n addr u--) BASE @ >R 2>R u>d 2R> [# DROP #1sec /MOD SWAP u>d # # 2DROP [CHAR] . HOLD 60 /MOD SWAP u>d # # 2DROP [CHAR] : HOLD 60 /MOD SWAP u>d # # 2DROP [CHAR] : HOLD u>d # # #] OVER [ _#$_count _#$_data - ]T LITERAL + $count! [ _#$_count _#$_data - ]T LITERAL + R> BASE ! ;.ticks
Given the time in ticks ( 10 msec increments since midnight), print out the time in the form:
hh:mm:ss.xx: .ticks ( n --) #picture_min get_buffer buffer #picture_min $ticks $type kill_buffer ;Convert num to a string and add he string to the end of the other string.
: $+num { ( $1 num ) variable %new_$ variable %new_length -- } zero \ $ lo hi(-- #$buffer get_buffer buffer #$buffer \ $1 lo hi addr n(-- (d.) \ $1 addr n (-- SWAP [ _#$_count _#$_data - ]T LITERAL + TUCK $count! \ $1 $2(-- OVER $type DUP $type %new_$ @ %new_length @ $+ %new_$ @ $type kill_buffer ;