implement logfloor and logceil

the comparators were all backwards; that's fixed now. it wasn't caught before because eq and ne are commutative, and of the others, only lt had ever been used, and only in one place

Force-Push: yes
Change-Id: I0a44f8abd21dfc8e0327441d8009e5150ea220da

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