diff options
Diffstat (limited to 'output.e')
| -rw-r--r-- | output.e | 218 |
1 files changed, 218 insertions, 0 deletions
diff --git a/output.e b/output.e new file mode 100644 index 0000000..29789b6 --- /dev/null +++ b/output.e @@ -0,0 +1,218 @@ +~ 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 ; + |