diff options
Diffstat (limited to 'output.e')
| -rw-r--r-- | output.e | 221 |
1 files changed, 97 insertions, 124 deletions
diff --git a/output.e b/output.e index 80f1577..5c4b31d 100644 --- a/output.e +++ b/output.e @@ -26,21 +26,20 @@ : 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) + { + ~ 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) + 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 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 * , ] ; + * swap + ~ (base, updated result so far, updated count of remaining powers) + } forever ; ~ (base, value -- floor of logarithm of value in base base) @@ -48,29 +47,28 @@ ~ 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 * , ] + { + ~ 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) - drop drop swap drop exit + ~ 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 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 + ~ 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. - branch [ -45 8 * , ] ; + ~ Nothing else weird going on, so loop. + } forever ; ~ (base, value -- ceiling of logarithm of value in base base) @@ -78,29 +76,28 @@ ~ 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 * , ] + { + ~ 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) - drop drop swap drop exit + ~ 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 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 + ~ 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. - branch [ -45 8 * , ] ; + ~ Nothing else weird going on, so loop. + } forever ; ~ This is an extremely inefficient implementation, but on the plus side, @@ -115,47 +112,52 @@ ~ 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 ; + 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 --) @@ -164,9 +166,10 @@ ~ (base, input) ~ Deal with negative numbers. - dup 0 > 0branch [ 7 8 * , ] - -1 * - s" -" emitstring + dup 0 > { + -1 * + s" -" emitstring + } if swap 0 .base-unsigned ; @@ -187,33 +190,3 @@ ~ (integer to print, width --) : .hexn 16 swap .base-unsigned ; - -~ Debugging tools -~ ~~~~~~~~~~~~~~~ - -~ TODO remove these altogether, they're in dynamic.e now -~ ~ ~ TODO this is a horrible, horrible hack -~ : s0-kludge 0x1000010008 ; -~ -~ ~ TODO replace these with the implementations that use proper flow-control -~ : stack -~ s0-kludge @ 8 - -~ -~ dup value@ 8 + != -~ 0branch [ 19 8 * , ] -~ dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ . 8 - -~ branch [ -25 8 * , ] -~ -~ drop newline ; -~ -~ -~ : stackhex -~ s0-kludge @ 8 - -~ -~ dup value@ 8 + != -~ 0branch [ 19 8 * , ] -~ dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ .hex64 8 - -~ branch [ -25 8 * , ] -~ -~ drop newline ; - |