path: root/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.
~
~ TODO surely we can find some way to get high-level flow-control


~   Strings are comparatively easy.
~
~ (string pointer --)
: emitstring dup stringlen swap sys-write ;

: 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 NOT equal to zero, the comparison will
  ~ return 0, which will cause the zbranch to skip the rest of the line.
  dup 0 = 0branch [ 5 8 * , ] drop swap drop exit
  ~ (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)

  branch [ -22 8 * , ] ;


~ (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)
  >unsigned 0branch [ 6 8 * , ]

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

  ~ 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
  < 0branch [ 8 8 * , ]
  4 unroll drop drop drop exit

  ~ Nothing else weird going on, so loop.
  branch [ -45 8 * , ] ;


~ (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)
  >=unsigned 0branch [ 6 8 * , ]

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

  ~ 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
  < 0branch [ 8 8 * , ]
  4 unroll drop drop drop exit

  ~ Nothing else weird going on, so loop.
  branch [ -45 8 * , ] ;


~   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.
~
~ (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 > 0branch [ 5 8 * , ]
  ~ (base, input, number of digits if no padding, width)
  ~ If we're here, we should use the padded width
  swap drop branch [ 2 8 * , ]
  ~ (base, input, number of digits if no padding, width)
  ~ If we're here, we should use the unpadded width
  drop

  ~ (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 > 0branch [ 5 8 * , ]
  0x30 branch [ 6 8 * , ]                        ~ ASCII "0"
  10 - 0x61                                      ~ ASCII "a"
  +
  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 0branch [ 3 8 * , ] branch [ -51 8 * , ]
  drop drop drop ;


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

  ~ Deal with negative numbers.
  dup 0 > 0branch [ 7 8 * , ]
  -1 *
  s" -" emitstring

  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 ;


~ Debugging tools
~ ~~~~~~~~~~~~~~~

~ TODO this is a horrible, horrible hack
: s0 0x1000010008 ;

~ TODO replace these with the implementations that use proper flow-control
: stack
  s0 @ 8 -

  dup value@ 8 + !=
  0branch [ 19 8 * , ]
  dup s0 @ 8 - != 0branch [ 2 8 * , ] space dup @ . 8 -
  branch [ -25 8 * , ]

  drop newline ;


: stackhex
  s0 @ 8 -

  dup value@ 8 + !=
  0branch [ 19 8 * , ]
  dup s0 @ 8 - != 0branch [ 2 8 * , ] space dup @ .hex64 8 -
  branch [ -25 8 * , ]

  drop newline ;