diff options
| -rw-r--r-- | quine.asm | 102 |
1 files changed, 86 insertions, 16 deletions
diff --git a/quine.asm b/quine.asm index de98b2b..e4804dc 100644 --- a/quine.asm +++ b/quine.asm @@ -2186,8 +2186,8 @@ cold_start: ; This was "eq". Jonesforth calls it "="; most languages would call it "==". dq litstring, "=", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_equal, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2198,8 +2198,8 @@ cold_start: ; recognize C's legacy and allow "!=" these days. As someone who learned C ; in childhood, this is not actually a hard call for us. dq litstring, "!=", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_not_equal, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2208,8 +2208,8 @@ cold_start: ; This was "gt". dq litstring, ">", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_greater, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2218,8 +2218,8 @@ cold_start: ; This was "lt". dq litstring, "<", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_less, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2228,8 +2228,8 @@ cold_start: ; This was "ge". dq litstring, ">=", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_greater_equal, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2238,8 +2238,8 @@ cold_start: ; This was "le". dq litstring, "<=", early_create, early_self_codeword, early_here, fetch - dq rbx, pop_reg64 dq rax, pop_reg64 + dq rbx, pop_reg64 dq rbx, rax, cmp_reg64_reg64 dq cc_less_equal, al, set_reg8_cc dq lit, 0x01, rax, and_reg64_imm8 @@ -2406,7 +2406,7 @@ cold_start: dq dup, lit, 4, roll, sub, lit, 2, add ; It's slightly counterintuitive that the condition is called cc_equal; ; that's a result of the condition names favoring cmp over test. While cmp - ; simulates subtraction, test simulates biwise AND. What we're testing is + ; simulates subtraction, test simulates bitwise AND. What we're testing is ; that the result is zero. dq cc_equal, jmp_cc_rel_imm8 dq lods64 @@ -3048,10 +3048,23 @@ defword divmod, 0 ;;; ------------------- ;;; +; So. This is subtle. These comparison routines all have the same structure. +; Notice that eq and ne are commutative, whereas the others are not, so +; consider gt as the archetypical one when reasoning about correctness. To +; test if A > B, we do cmp A, B, which sets the flags the same way as +; subtracting B from A does. The mnemonic names of the condition codes are +; based on the assumption you do it in this order. +; +; We want to treat the top of the stack as the first operand, so we carefully +; pop in the appropriate order. +; +; There are both signed and unsigned variants of the condition codes. We use +; the signed ones. + defword eq, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax + pop.qreg rbx cmp.qreg.qreg rax, rbx set.breg.cc al, equal and.qreg.bimm rax, 0x01 @@ -3060,8 +3073,8 @@ defword eq, 0 defword ne, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax + pop.qreg rbx cmp.qreg.qreg rax, rbx set.breg.cc al, not_equal and.qreg.bimm rax, 0x01 @@ -3070,8 +3083,8 @@ defword ne, 0 defword gt, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax + pop.qreg rbx cmp.qreg.qreg rax, rbx set.breg.cc al, greater and.qreg.bimm rax, 0x01 @@ -3081,8 +3094,8 @@ defword gt, 0 ; Is the top of the stack less than the second item in the stack? defword lt, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax + pop.qreg rbx cmp.qreg.qreg rax, rbx set.breg.cc al, less and.qreg.bimm rax, 0x01 @@ -3091,19 +3104,21 @@ defword lt, 0 defword ge, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax - set.breg.cc al, greater_equal + pop.qreg rbx cmp.qreg.qreg rax, rbx + set.breg.cc al, greater_equal + and.qreg.bimm rax, 0x01 push.qreg rax next defword le, 0 dq $ + 8 - pop.qreg rbx pop.qreg rax - set.breg.cc al, less_equal + pop.qreg rbx cmp.qreg.qreg rax, rbx + set.breg.cc al, less_equal + and.qreg.bimm rax, 0x01 push.qreg rax next @@ -3668,6 +3683,61 @@ defword pow, 0 ; (base, updated result so far, updated count of remaining powers) dq branch, -22*8 +; In: +; base +; value +; Out: +; floor of logarithm of value, in base base +defword logfloor, 0 + dq docol + + ; Start with a product equal to the base, and a count of 0. + dq swap, dup, unroll3, lit, 0 + + ; This is the start of the loop body. + ; (base, value, product so far, count of powers included so far) + dq unroll3, dup2 + ; (base, count so far, value, product so far) + dq gt, zbranch, 6*8 + + ; If we get here, we're done. + ; (base, count so far, value, product so far) + dq drop, drop, swap, drop, exit + + ; If we're here, we need to do another loop. + ; (base, count so far, value, product so far) + dq lit, 4, roll, dup, lit, 5, unroll, mul, roll3, lit, 1, add + ; (base, value, updated product so far, updated count so far) + dq branch, -23*8 + +; In: +; base +; value +; Out: +; celing of logarithm of value, in base base +defword logceil, 0 + dq docol + + ; Start with a product of 1 and a count of 0. + dq lit, 1, lit, 0 + + ; This is the start of the loop body. + ; (base, value, product so far, count of powers included so far) + dq unroll3, dup2 + ; (base, count so far, value, product so far) + dq ge, zbranch, 6*8 + + ; If we get here, we're done. + ; (base, count so far, value, product so far) + dq drop, drop, swap, drop, exit + + ; If we're here, we need to do another loop. + ; (base, count so far, value, product so far) + dq lit, 4, roll, dup, lit, 5, unroll, mul, roll3, lit, 1, add + ; (base, value, updated product so far, updated count so far) + dq branch, -23*8 + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Development utilities ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -5028,7 +5098,7 @@ defword show_source_between, 0 dq docol dq swap, entry_to_execution_token, lit, 8, add ; (end address, current address) - dq dup2, lt, zbranch, 4*8, drop, drop, exit + dq dup2, ge, zbranch, 4*8, drop, drop, exit dq dup, fetch, execution_token_to_entry, entry_to_name ; (end address, current address, name) dq dup, emitstring, litstring, " ", emitstring |