evocation/output.e

~ Output
~ ~~~~~~
~
~   It is convenient to be able to output text. This depends on the
~ OS-specific stuff in linux.e, so it's in its own file.
~
~   The most interesting word we define here is ".", pronounced "dot"; the
~ math stuff is needed to implement it.
~
~   Unlike Jonesforth, we do not have a global "base" variable, and this word
~ does not change its behavior depending on that value. It's always base ten.


~   Strings are comparatively easy.
~
~ (string pointer --)
: emitstring dup stringlen 1 3unroll sys-write drop ;

: space 32 value@ emitstring drop ;
: newline 10 value@ emitstring drop ;


~ (base, exponent -- base to the power of exponent)
: pow
  1 swap

  {
    ~ If the count of remaining powers is equal to zero, exit.
    dup { drop swap drop exit } unless
    ~ (base, result so far, count of remaining powers)

    1 - 3unroll
    ~ (updated count of remaining powers, base, result so far)

    swap dup 4 unroll
    ~ (base, updated count of remaining powers, result so far, base)

    * swap
    ~ (base, updated result so far, updated count of remaining powers)
  } forever ;


~ (base, value -- floor of logarithm of value in base base)
: logfloor
  ~ Start with a product equal to the base, and a count of 0.
  swap dup 3unroll 0

  {
    ~ This is the start of the loop body.
    ~ (base, value, product so far, count of powers included so far)
    3unroll 2dup
    ~ (base, count so far, value, product so far)

    ~ If we get here, we're done.
    ~ (base, count so far, value, product so far)
    >unsigned { drop drop swap drop exit } if

    ~ If we're here, we need to do another loop.
    ~ (base, count so far, value, product so far)
    4 roll dup 5 unroll * 3roll 1 +
    ~ (base, value, updated product so far, updated count so far)

    ~ If the product is less than the base, we overflowed. In that case, the
    ~ product-so-far is the maximum, so just return it.
    4 roll dup 5 unroll 3roll dup 4 unroll
    < { 4 unroll drop drop drop exit } if

    ~ Nothing else weird going on, so loop.
  } forever ;


~ (base, value -- ceiling of logarithm of value in base base)
: logceil
  ~ Start with a product of 1 and a count of 0.
  1 0

  {
    ~ This is the start of the loop body.
    ~ (base, value, product so far, count of powers included so far)
    3unroll 2dup
    ~ (base, count so far, value, product so far)

    ~ If we get here, we're done.
    ~ (base, count so far, value, product so far)
    >=unsigned { drop drop swap drop exit } if

    ~ If we're here, we need to do another loop.
    ~ (base, count so far, value, product so far)
    4 roll dup 5 unroll * 3roll 1 +
    ~ (base, value, updated product so far, updated count so far)

    ~ If the product is less than the base, we overflowed. In that case, the
    ~ product-so-far is the maximum, so just return it.
    4 roll dup 5 unroll 3roll dup 4 unroll
    < { 4 unroll drop drop drop exit } if

    ~ Nothing else weird going on, so loop.
  } forever ;


~   This is an extremely inefficient implementation, but on the plus side,
~ doing that avoids having to think about any sort of memory management or
~ recursion, and lets us stick entirely with the trivial control-flow
~ constructs we already have.
~
~ TODO add a variant that writes to a string
~
~ (integer to print, base to print in, width to zero-pad to --)
: .base-unsigned
  ~ (input, base, width)
  ~ Compute how many digits we need to display. Because we use logfloor, the
  ~ logic of always printing at least one digit is already handled for us.
  3unroll swap 2dup logfloor 1 +
  ~ (width, base, input, number of digits if no padding)
  4 roll 2dup > {
    ~ (base, input, number of digits if no padding, width)
    ~ If we're here, we should use the padded width
    swap drop
  } {
    ~ (base, input, number of digits if no padding, width)
    ~ If we're here, we should use the unpadded width
    drop
  } if-else

  {
    ~ (base, input, number of digits remaining)
    ~ This is the start of the loop.
    2dup 1 -
    ~ (base, input, number of digits remaining, input, intermediate value)
    5 roll dup 6 unroll swap
    ~ (base, input, number of digits remaining, input, base, intermediate value)
    pow /% swap drop
    ~ (base, input, number of digits remaining,
    ~  input divided by base^x appropriately)
    4 roll dup 5 unroll
    ~ (base, input, number of digits remaining,
    ~  input divided by base^x appropriately, base)
    /% drop
    ~ (base, input, number of digits remaining, current digit)

    ~   We construct a one-character string on the stack, then use a pointer to
    ~ it. It will always contain its own null-termination without us having to
    ~ do anything special to that end.
    dup 10 > {
      0x30                                         ~ ASCII "0"
    } {
      10 - 0x61                                    ~ ASCII "a"
    } if-else
    +
    value@ emitstring

    ~ We deallocate the string by dropping it.
    ~
    ~ Saying it like that makes it sound obvious; contemplate it until it feels
    ~ surprising.
    drop

    1 -
    dup { drop drop drop exit } unless
  } forever ;


~ (integer to print, base to print in --)
: .base
  swap
  ~ (base, input)

  ~ Deal with negative numbers.
  dup 0 > {
    -1 *
    s" -" emitstring
  } if

  swap 0 .base-unsigned ;


~   Although this could notionally be called emitinteger for symmetry, it's
~ well-known under the name dot and as a single period character, and that
~ name participates in conventions for names of other things. So, we go with
~ it.
~
~ (integer to print --)
: . 10 .base ;
: .hex 16 0 .base-unsigned ;
: .hex8 16 2 .base-unsigned ;
: .hex16 16 4 .base-unsigned ;
: .hex32 16 8 .base-unsigned ;
: .hex64 16 16 .base-unsigned ;

~ (integer to print, width --)
: .hexn 16 swap .base-unsigned ;