From 77e8ce989010fbd94080e780fb0b5cb6c10434e8 Mon Sep 17 00:00:00 2001 From: Irene Knapp Date: Mon, 28 Sep 2026 18:07:52 -0700 Subject: move all the source files into subdirectories and rename one, linux-dynamic.e to language/dynamic/linux.e. also make sure all references in comments and documentation refer to the new locations and names. this directory structure reflects code organization which had existed in Irenes' head, but was likely not obvious to other readers. now hopefully it is more discoverable. Force-Push: yes Change-Id: Icfef3eae812a50fe20202191999e68e1f7db445a --- language/static/output.e | 252 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 252 insertions(+) create mode 100644 language/static/output.e (limited to 'language/static/output.e') diff --git a/language/static/output.e b/language/static/output.e new file mode 100644 index 0000000..cadd5fb --- /dev/null +++ b/language/static/output.e @@ -0,0 +1,252 @@ +~ Output +~ ~~~~~~ +~ +~ It is convenient to be able to output text. This depends on the +~ OS-specific stuff in language/static/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. +~ +~ (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 ; + + + +~ The control structure here is the same as .base-unsigned, but it outputs +~ to a string. +~ +~ The use of the "pack" nomenclature here is a little odd in that most other +~ uses are for binary structures rather than text, but compare packstring. +~ +~ (output point, integer to print, base to print in, width to zero-pad to +~ -- output point) +: pack-base-unsigned + 3unroll swap 2dup logfloor 1 + + 4 roll 2dup > { + swap drop + } { + drop + } if-else + + { + ~ (output point, base, input, number of digits remaining) + 2dup 1 - + 5 roll dup 6 unroll swap + pow /% swap drop + 4 roll dup 5 unroll + /% drop + + dup 10 > { + 0x30 ~ ASCII "0" + } { + 10 - 0x61 ~ ASCII "a" + } if-else + + + ~ (output point, base, input, number of digits remaining, character) + 5 roll swap pack8 4 unroll + + 1 - + dup { drop drop drop exit } unless + } forever ; + + +~ (output point, integer to print, base to print in -- output point) +: pack-base + swap + + dup 0 > { + -1 * + 3roll s" -" packstring 3unroll + } if + + swap 0 .base-unsigned ; + + +~ (output point, integer to print -- output point) +: pack-decimal 10 pack-base ; +: pack-hex 16 0 pack-base-unsigned ; +: pack-hex8 16 2 pack-base-unsigned ; +: pack-hex16 16 4 pack-base-unsigned ; +: pack-hex32 16 8 pack-base-unsigned ; +: pack-hex64 16 16 pack-base-unsigned ; + +~ (output point, integer to print, width -- output point) +: pack-hexn 16 swap pack-base-unsigned ; -- cgit 1.4.1