# 20nov24 Software Lab. Alexander Burger

(symbols '(llvm))

(local) (pos neg divErr)

(inline pos (N)
   (any (& N -9)) )

(inline neg (N)
   (if (== N ZERO)
      N
      (any (x| N 8)) ) )

(de NIL divErr (Exe)
   (err Exe 0 ($ "Div/0") null) )

### Bignum byte access ###
(local) (symByte symChar byteNum byteSym charSym)

(de i8 symByte ((i64* . P))  # [cnt name]
   (let C (val P)  # Get cnt
      (unless C  # New round
         (let Nm (val 2 P)
            (cond
               ((== Nm ZERO) (ret (i8 0)))  # Done
               ((cnt? Nm)  # Short
                  (setq C (int Nm))
                  (set 2 P ZERO) )
               (T  # Big: Next digit
                  (setq C (set P (val (dig Nm))))
                  (set 2 P (val (big Nm))) ) ) ) )
      (set P (shr C 8))
      (i8 C) ) )

(de i32 symChar ((i64* . P))  # [cnt name]
   (let C (i32 (symByte P))
      (cond
         ((>= 127 C) C)  # Single byte
         ((== C (hex "FF")) (i32 TOP))  # Infinite
         (T
            (|
               (shl
                  (ifn (& C (hex "20"))
                     (& C (hex "1F"))
                     (|
                        (shl
                           (ifn (& C (hex "10"))
                              (& C (hex "0F"))
                              (|
                                 (shl (& C (hex "7")) 6)
                                 (& (i32 (symByte P)) (hex "3F")) ) )
                           6 )
                        (& (i32 (symByte P)) (hex "3F")) ) )
                  6 )
               (& (i32 (symByte P)) (hex "3F")) ) ) ) ) )

(de void byteNum ((i8 . B) (i64* . P))  # [cnt last name link]
   (let (Cnt (val P)  Nm (val 3 P))
      (if (cnt? Nm)
         # xxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxS010
         #    59      51      43      35      27      19      11       3
         (cond
            ((== Cnt 67)  # Short full
               (set 3 P
                  (set 2 P
                     (consNum (shr Nm 3) (cnt (i64 B))) ) )
               (set P 12) )  # Next digit in bignum
            ((and (== Cnt 59) (>= B 32))  # Fit into 5 bits
               (set 3 P
                  (set 2 P
                     (boxNum
                        (| (shr Nm 3) (shl (i64 B) 56)) ) ) )
               (set P 4) )  # Start next digit in bignum
            (T
               (set
                  3 P (| Nm (shl (i64 B) Cnt))
                  P (+ Cnt 8) ) ) )
         (let (Q (val 2 P)  N (val (big Q)))
            (cond
               ((== Cnt 68)  # Last short full
                  (set 2 P
                     (set (big Q)
                        (consNum (int N) (cnt (i64 B))) ) )
                  (set P 12) )  # Next digit in bignum
               ((and (== Cnt 60) (>= B 16))  # Fit into 4 bits
                  (set 2 P
                     (set (big Q)
                        (boxNum
                           (| (int N) (shl (i64 B) 56)) ) ) )
                  (set P 4) )  # Start next digit in bignum
               (T
                  (set
                     (big Q) (| N (shl (i64 B) Cnt))
                     P (+ Cnt 8) ) ) ) ) ) ) )

(de void byteSym ((i8 . B) (i64* . P))  # [cnt last name link]
   (let (Cnt (val P)  Nm (val 3 P))
      (if (cnt? Nm)
         # 0000.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx.xxxxxxx0010
         #   60      52      44      36      28      20      12       4
         (if (> 60 Cnt)  # Digit not full
            (set
               3 P (| Nm (shl (i64 B) Cnt))
               P (+ Cnt 8) )
            (set 3 P
               (set 2 P
                  (boxNum  # Make big
                     (| (int Nm) (shl (i64 B) 56)) ) ) )
            (set P 4) )  # Start new digit
         (let (Q (val 2 P)  N (val (big Q)))
            (if (> 60 Cnt)  # Digit not full
               (set
                  (big Q) (| N (shl (i64 B) Cnt))
                  P (+ Cnt 8) )
               (set 2 P
                  (set (big Q)
                     (boxNum  # Make big
                        (| (int N) (shl (i64 B) 56)) ) ) )
               (set P 4) ) ) ) ) )  # Start new digit

(de void charSym ((i32 . C) (i64* . P))  # [cnt last name link]
   (cond
      ((>= 127 C) (byteSym (i8 C) P))  # Single byte
      ((== TOP C) (byteSym (hex "FF") P))  # Infinite
      (T
         (cond
            ((> (hex "800") C)  # Double-byte
               (byteSym (i8 (| (hex "C0") (& (shr C 6) (hex "1F")))) P) )  # 10xxxxx 10xxxxxx
            ((> (hex "10000") C)  # Three bytes
               (byteSym (i8 (| (hex "E0") (& (shr C 12) (hex "0F")))) P)  # 1110xxxx 10xxxxxx 10xxxxxx
               (byteSym (i8 (| (hex "80") (& (shr C 6) (hex "3F")))) P) )
            (T
               (byteSym (i8 (| (hex "F0") (& (shr C 18) (hex "07")))) P)  # 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
               (byteSym (i8 (| (hex "80") (& (shr C 12) (hex "3F")))) P)
               (byteSym (i8 (| (hex "80") (& (shr C 6) (hex "3F")))) P) ) )
         (byteSym (i8 (| (hex "80") (& C (hex "3F")))) P) ) ) )

### Destructive primitives ###
(local) (zapZero twiceBig twice half tenfold)

# Remove leading zeroes
(de zapZero (N)
   (let (P (push N)  X P  Y P  Z T)
      (until (cnt? (setq Z (val (big N))))  # Last cell
         (when (val (dig N))  # Null digit?
            (setq X Y) )  # New null-tail
         (setq
            Y (big N)  # New short-tail
            N (val Y) ) )  # Next cell
      (when (== Z ZERO)
         (cond
            ((setq N (val (dig N)))  # Final digit
               (unless (& N (hex "F000000000000000"))
                  (set Y (cnt N)) ) )  # Store in short-tail
            ((&
                  (setq N (val (dig (val X))))  # Digit in null-tail
                  (hex "F000000000000000") )
               (set (big (val X)) ZERO) )  # Trim null-tail
            (T (set X (cnt N))) ) )  # Store in null-tail
      (val P) ) )

# Multiply (unsigned) number by 2
(de twiceBig (N)
   (let (X N  A (val (dig X))  Y (val (big X)))
      (set (dig X) (shl A 1))
      (while (big? Y)
         (let B (val (dig Y))
            (set (dig (setq X Y))
               (| (shl B 1) (shl 0 A 1)) )
            (setq A B  Y (val (big Y))) ) )
      (set (big X)
         (box64
            (| (shl (int Y) 1) (shl 0 A 1)) ) ) )
   N )

(de twice (N)
   (if (cnt? N)
      (let X (add N N)  # Shift left
         (if @@  # Overflow
            (boxNum (shr N 3))  # Make big
            (x| X 6) ) )  # Fix tag bit
      (twiceBig N) ) )

# Divide (unsigned) number by 2
(de half (N)
   (if (cnt? N)
      (| (& (shr N 1) -10) 2)  # Clear lowest bit and tag
      (let (X N  A (shr (val (dig X)) 1)  Y (val (big X)))
         (if (big? Y)
            (let Z (val (big Y))
               (loop
                  (let B (val (dig Y))
                     (set (dig X) (| (shr B 0 1) A))
                     (setq A (shr B 1)) )
                  (? (cnt? Z))
                  (setq X Y  Y Z  Z (val (big Z))) )
               (setq
                  Z (int Z)
                  A (| (shr Z 0 1) A) )
               (ifn
                  (or
                     (setq Z (shr Z 1))
                     (& A (hex "F000000000000000")) )
                  (set (big X) (cnt A))
                  (set (dig Y) A)
                  (set (big Y) (cnt Z)) ) )
            (setq
               Y (int Y)
               A (| (shr Y 0 1) A) )
            (unless
               (or
                  (setq Y (shr Y 1))
                  (& A (hex "F000000000000000")) )
               (ret (cnt A)) )
            (set (dig X) A)
            (set (big X) (cnt Y)) )
         N ) ) )

# Multiply (unsigned) number by 10
(de tenfold (N)
   (if (cnt? N)
      (box64 (* 10 (int N)))
      (let (X N  Lo (mul 10 (val (dig X)))  Hi @@@)
         (loop
            (set (dig X) Lo)
            (? (cnt? (val (big X)))
               (set (big X)
                  (box64 (+ Hi (* 10 (int @)))) ) )
            (setq X @)
            (setq
               Lo (add (mul 10 (val (dig X))) Hi)
               Hi (+ @@@ @@) ) )
         N ) ) )

### Non-destructive unsigned primitives ###
(local) (shlu shru andu oru xoru addu sub1 subu mulAddHiLo mulu div1 divu remu)

# Multiply (unsigned) number by 2
(de shlu (N)
   (if (cnt? N)
      (let X (add N N)  # Shift left
         (if @@  # Overflow
            (boxNum (shr N 3))  # Make big
            (x| X 6) ) )  # Fix tag bit
      (let
         (A (val (dig N))
            X (boxNum (shl A 1))
            Y (val (big N))
            R (save X) )
         (while (big? Y)
            (let B (val (dig Y))
               (setq X
                  (set (big X)
                     (boxNum (| (shl B 1) (shl 0 A 1))) ) )
               (setq A B  Y (val (big Y))) ) )
         (set (big X)
            (box64
               (| (shl (int Y) 1) (shl 0 A 1)) ) )
         R ) ) )

# Divide (unsigned) number by 2
(de shru (N)
   (if (cnt? N)
      (| (& (shr N 1) -10) 2)  # Clear lowest bit and tag
      (let A (shr (val (dig N)) 1)
         (if (big? (setq N (val (big N))))
            (let
               (B (val (dig N))
                  P (boxNum (| (shr B 0 1) A))
                  R (save P) )
               (loop
                  (setq A (shr B 1))
                  (? (cnt? (setq N (val (big N)))))
                  (setq
                     B (val (dig N))
                     P
                     (set (big P)
                        (boxNum (| (shr B 0 1) A)) ) ) )
               (setq
                  N (int N)
                  A (| (shr N 0 1) A) )
               (set (big P)
                  (ifn
                     (or
                        (setq N (shr N 1))
                        (& A (hex "F000000000000000")) )
                     (cnt A)
                     (prog1
                        (boxNum A)
                        (set (big @) (cnt N)) ) ) )
               R )
            (setq
               N (int N)
               A (| (shr N 0 1) A) )
            (ifn
               (or
                  (setq N (shr N 1))
                  (& A (hex "F000000000000000")) )
               (cnt A)
               (prog1
                  (boxNum A)
                  (set (big @) (cnt N)) ) ) ) ) ) )

# Bitwise AND of two (unsigned) numbers
(de andu (A B)
   (cond
      ((cnt? A)
         (& A
            (if (cnt? B) B (cnt (val (dig B)))) ) )
      ((cnt? B)  # A is big
         (& B (cnt (val (dig A)))) )
      (T  # Both are big
         (let
            (P
               (boxNum
                  (& (val (dig A)) (val (dig B))) )
               R (save P) )
            (loop
               (setq A (val (big A))  B (val (big B)))
               (? (cnt? A)
                  (set (big P)
                     (& A
                        (if (cnt? B) B (cnt (val (dig B)))) ) ) )
               (? (cnt? B)
                  (set (big P)
                     (& B (cnt (val (dig A)))) ) )
               (setq P
                  (set (big P)
                     (boxNum
                        (& (val (dig A)) (val (dig B))) ) ) ) )
            (zapZero R) ) ) ) )

# Bitwise OR of two (unsigned) numbers
(de oru (A B)
   (cond
      ((cnt? A)
         (if (cnt? B)
            (| A B)
            (consNum
               (| (int A) (val (dig B)))
               (val (big B)) ) ) )
      ((cnt? B)  # A is big
         (consNum
            (| (int B) (val (dig A)))
            (val (big A)) ) )
      (T  # Both are big
         (let
            (P
               (boxNum
                  (| (val (dig A)) (val (dig B))) )
               R (save P) )
            (loop
               (setq A (val (big A))  B (val (big B)))
               (? (cnt? A)
                  (set (big P)
                     (if (cnt? B)
                        (| A B)
                        (consNum
                           (| (int A) (val (dig B)))
                           (val (big B)) ) ) ) )
               (? (cnt? B)
                  (set (big P)
                     (consNum
                        (| (int B) (val (dig A)))
                        (val (big A)) ) ) )
               (setq P
                  (set (big P)
                     (boxNum
                        (| (val (dig A)) (val (dig B))) ) ) ) )
            R ) ) ) )

# Bitwise XOR of two (unsigned) numbers
(de xoru (A B)
   (cond
      ((cnt? A)
         (if (cnt? B)
            (| (x| A B) 2)
            (zapZero
               (consNum
                  (x| (int A) (val (dig B)))
                  (val (big B)) ) ) ) )
      ((cnt? B)  # A is big
         (zapZero
            (consNum
               (x| (int B) (val (dig A)))
               (val (big A)) ) ) )
      (T  # Both are big
         (let
            (P
               (boxNum
                  (x| (val (dig A)) (val (dig B))) )
               R (save P) )
            (loop
               (setq A (val (big A))  B (val (big B)))
               (? (cnt? A)
                  (set (big P)
                     (if (cnt? B)
                        (| (x| A B) 2)
                        (consNum
                           (x| (int A) (val (dig B)))
                           (val (big B)) ) ) ) )
               (? (cnt? B)
                  (set (big P)
                     (consNum
                        (x| (int B) (val (dig A)))
                        (val (big A)) ) ) )
               (setq P
                  (set (big P)
                     (boxNum
                        (x| (val (dig A)) (val (dig B))) ) ) ) )
            (zapZero R) ) ) ) )

# Add two (unsigned) numbers
(de addu (A B)
   (cond
      ((cnt? A)
         (if (cnt? B)
            (box64 (+ (int A) (int B)))
            (xchg 'A 'B)
            (goto 1) ) )
      ((cnt? B)  # A is big
         (: 1
            (let N (val (big A))
               (setq B (add (int B) (val (dig A))))
               (ifn @@
                  (consNum B N)  # No carry
                  (let R (save (setq B (consNum B N)))  # Else build new head
                     (loop
                        (? (cnt? N)
                           (setq N (add N (hex "10")))  # Add carry
                           (set (big B)
                              (ifn @@  # No further carry
                                 N  # Append it
                                 (boxNum (| (int N) (hex "1000000000000000"))) ) ) )  # Set top bit
                        (let D (val (dig N))  # Next digit
                           (setq
                              N (val (big N))
                              D (add D 1) )  # Add carry
                           (? (not @@)  # No carry
                              (set (big B) (consNum D N)) )
                           (setq B (set (big B) (consNum D N))) ) )
                     R ) ) ) ) )
      (T  # Both are big
         (let
            (N (add (val (dig A)) (val (dig B)))
               C @@
               P (boxNum N)
               R (save P) )
            (loop
               (setq A (val (big A))  B (val (big B)))
               (? (cnt? A)
                  (if (cnt? B)
                     (set (big P)
                        (box64 (add (int A) (int B) C)) )
                     (xchg 'A 'B)
                     (goto 2) ) )
               (? (cnt? B)
                  (: 2
                     (setq
                        N (add (int B) (val (dig A)) C)
                        C @@ )
                     (loop
                        (setq P
                           (set (big P)
                              (consNum N (setq A (val (big A)))) ) )
                        (? (not C))
                        (? (cnt? A)
                           (set (big P) (box64 (+ (int A) C))) )
                        (setq
                           N (add (val (dig A)) 1)
                           C @@ ) ) ) )
               (setq
                  N (add (val (dig A)) (val (dig B)) C)
                  C @@
                  P (set (big P) (boxNum N)) ) )
            R ) ) ) )

# Subtract short from big number
(de sub1 (B N)
   (setq
      N (sub (val (dig B)) (int N))
      B (val (big B)) )
   (nond
      (@@  # No borrow
         (if (== B ZERO)
            (box64 N)
            (consNum N B) ) )
      ((big? B)  # Single cell
         (setq B (sub B (hex "10")))  # Subtract borrow
         (if @@  # Again borrow
            (sign (cnt (- N)))  # Lowest digit
            (zapZero (consNum N B)) ) )
      (NIL
         (let (P (boxNum N B)  R (save P))
            (loop
               (setq
                  N (sub (val (dig B)) 1)  # Subtract borrow
                  B (val (big B)) )
               (? (not @@)
                  (set (big P) (consNum N B)) )
               (setq P (set (big P) (consNum N B)))
               (? (cnt? B)
                  (set (big P) (sub B (hex "10"))) ) )  # Subtract borrow
            (zapZero R) ) ) ) )

# Subtract two (unsigned) numbers
(de subu (A B)
   (cond
      ((cnt? A)
         (if (cnt? B)
            (let N (sub A (& B -3))  # Clear tag
               (if @@
                  (+ (x| N -16) (hex "18"))  # 2-complement
                  N ) )
            (neg (sub1 B A)) ) )
      ((cnt? B)  # A is big
         (sub1 A B) )
      (T  # Both are big
         (let
            (N (sub (val (dig A)) (val (dig B)))
               C @@
               P (boxNum N)
               R (save P) )
            (loop
               (setq A (val (big A))  B (val (big B)))
               (? (cnt? B)
                  (setq B (int B))
                  (until (cnt? A)
                     (setq
                        N (sub (val (dig A)) B C)
                        C @@
                        A (val (big A))
                        P (set (big P) (consNum N A)) )
                     (unless C
                        (ret (zapZero R)) )
                     (setq B 0) )
                  (setq A (int A)) )
               (? (cnt? A)
                  (setq A (int A))
                  (loop
                     (setq
                        N (sub A (val (dig B)) C)
                        C @@
                        P (set (big P) (boxNum N)) )
                     (setq A 0)
                     (? (cnt? (setq B (val (big B))))) )
                  (setq B (int B)) )
               (setq
                  N (sub (val (dig A)) (val (dig B)) C)
                  C @@
                  P (set (big P) (boxNum N)) ) )
            (set (big P) (cnt (sub A B C)))  # Subtract final shorts with borrow
            (ifn @@
               (zapZero R)
               # 2-complement
               (let Q R
                  (loop  # Invert
                     (set (dig Q) (x| (val (dig Q)) -1))
                     (? (cnt? (setq N (val (big Q)))))
                     (setq Q N) )
                  (set (big Q) (x| N -16)) )
               (let Q R
                  (loop  # Increment
                     (set (dig Q) (add (val (dig Q)) 1))
                     (unless @@
                        (goto 9) )
                     (? (cnt? (setq N (val (big Q)))))
                     (setq Q N) )
                  (set (big Q) (+ N (hex "10"))) )
               (: 9
                  (sign (zapZero R)) ) ) ) ) ) )

# Multiply two (unsigned) numbers
(inline (Lo Hi) mulAddHiLo (X Y P)
   (let H Hi
      (setq
         Lo (add (mul X Y) (val (dig P)))
         Hi (+ @@@ @@)
         Lo (add Lo H)
         Hi (+ Hi @@) ) ) )

(de mulu (A B)
   (cond
      ((== A ZERO) A)
      ((cnt? A)
         (setq A (int A))
         (if (cnt? B)
            (let N (mul A (int B))
               (if (or @@@ (& N (hex "F000000000000000")))  # Fit in short number
                  (consNum N (cnt @@@))
                  (cnt N) ) )
            (: 1
               (let
                  (Lo (mul A (val (dig B)))
                     Hi @@@
                     P (boxNum Lo)
                     R (save P) )
                  (while (big? (setq B (val (big B))))
                     (setq
                        Lo (add (mul A (val (dig B))) Hi)
                        Hi (+ @@@ @@)
                        P (set (big P) (boxNum Lo)) ) )
                  (setq
                     Lo (add (mul A (int B)) Hi)
                     Hi (+ @@@ @@) )
                  (set (big P)
                     (if (or Hi (& Lo (hex "F000000000000000")))  # Fit in short number
                        (consNum Lo (cnt Hi))
                        (cnt Lo) ) )
                  R ) ) ) )
      ((== B ZERO) B)
      ((cnt? B)  # A is big
         (setq B (int B))
         (xchg 'A 'B)
         (goto 1) )
      (T  # Both are big
         (let (P (boxNum 0)  R (save P))
            (loop
               (let
                  (X A
                     Q P
                     Lo
                     (add
                        (mul (val (dig X)) (val (dig B)))
                        (val (dig Q)) )
                     Hi (+ @@@ @@) )
                  (loop
                     (set (dig Q) Lo)
                     (setq Q
                        (if (cnt? (val (big Q)))
                           (set (big Q) (boxNum 0))
                           @ ) )
                     (? (cnt? (setq X (val (big X)))))
                     (mulAddHiLo (val (dig X)) (val (dig B)) Q) )
                  (mulAddHiLo (int X) (val (dig B)) Q)
                  (set (dig Q) Lo)
                  (when Hi
                     (if (cnt? (val (big Q)))
                        (set (big Q) (boxNum Hi))
                        (set (big @) Hi) ) ) )
               (setq P (val (big P)))
               (? (cnt? (setq B (val (big B))))) )
            (setq B (int B))
            (let
               (Lo
                  (add
                     (mul (val (dig A)) B)
                     (val (dig P)) )
                  Hi (+ @@@ @@) )
               (loop
                  (set (dig P) Lo)
                  (setq P
                     (if (cnt? (val (big P)))
                        (set (big P) (boxNum 0))
                        @ ) )
                  (? (cnt? (setq A (val (big A)))))
                  (mulAddHiLo (val (dig A)) B P) )
               (mulAddHiLo (int A) B P)
               (set (dig P) Lo)
               (when Hi
                  (if (cnt? (val (big P)))
                     (set (big P) (boxNum Hi))
                     (set (big @) Hi) ) ) )
            (zapZero R) ) ) ) )

# Divide big number (Knuth Vol.2, p.257)
(de div1 (A B (i1 . Rem))
   (let
      (R (save ZERO)  # Quotient
         P (boxNum (val (dig A)))
         U (link (push P NIL))  # Dividend 'u'
         V (link (push B NIL))  # Divisor 'v'
         V1 T
         V2 0  # Last cell
         M 0  # 'm'
         N 1  # 'n'
         D 0
         Q T )
      # Copy dividend
      (while (big? (setq A (val (big A))))
         (setq P
            (set (big P) (boxNum (val (dig A)))) )
         (inc 'M) )  # Calculate 'm'
      (unless (== A ZERO)
         (setq P (set (big P) (boxNum (int A))))
         (inc 'M) )
      # Copy divisor
      (if (cnt? B)
         (setq Q (set V (boxNum (int B))))
         (setq Q
            (set V (boxNum (val (dig B)))) )
         (while (big? (setq B (val (big B))))
            (setq
               V2 Q  # Keep last cell
               Q (set (big Q) (boxNum (val (dig B)))) )
            (dec 'M)  # Decrement 'm'
            (inc 'N) )  # Calculate 'n'
         (unless (== B ZERO)
            (setq
               V2 Q  # Keep last cell
               Q (set (big Q) (boxNum (int B))))
            (dec 'M)
            (inc 'N) )
         (when (lt0 M)
            (ret
               (if Rem
                  (zapZero (val U))
                  ZERO ) ) ) )
      (set (big P) (boxNum 0))
      (while (ge0 (val (dig Q)))  # Shift to max left position
         (twiceBig (val U))
         (twiceBig (val V))
         (inc 'D) )
      (setq V1 (val (dig Q)))
      (when V2
         (setq V2 (val (dig V2))) )
      (loop
         (let (X (val U)  U1 0  U2 0  U3 T)
            (let I M  # Index X -> 'u'
               (while (ge0 (dec 'I))
                  (setq X (val (big X))) ) )
            (let (I N  Y X)
               (loop
                  (setq
                     U3 U2
                     U2 U1
                     U1 (val (dig Y))
                     Y (val (big Y)) )
                  (? (lt0 (dec 'I))) ) )
            (let (Hi U1  Lo U2)  # 'r'
               (setq Q
                  (if (== U1 V1)  # 'u1' = 'v1'
                     -1  # 'q' = MAX
                     (div Hi Lo V1) ) )  # 'q' = 'r' / 'v1'
               (setq
                  Lo (sub Lo (mul Q V1))  # 'r' - 'q' * 'v1'
                  Hi (sub Hi @@@ @@) )
               (until Hi  # 'r' <= MAX  and
                  (let L (mul Q V2)  # 'q' * 'v2 '> [lo(r) u3]
                     (? (> Lo @@@))
                     (? (and (== Lo @@@) (>= U3 L))) )
                  (dec 'Q)
                  (setq   # Increment 'r' by 'v1'
                     Lo (add Lo V1)
                     Hi (+ Hi @@) ) )
               (let (Z X  Y (val V))
                  (set (dig Z)
                     (sub
                        (val (dig Z))
                        (mul Q (val (dig Y))) ) )
                  (setq Hi (+ @@@ @@))  # Borrow
                  (while (big? (setq Y (val (big Y))))  # More in 'v'
                     (setq Z (val (big Z)))
                     (set (dig Z) (sub (val (dig Z)) Hi))  # Subtract borrow
                     (setq Hi (- Hi Hi @@))  # New borrow
                     (set (dig Z)
                        (sub
                           (val (dig Z))
                           (mul Q (val (dig Y))) ) )
                     (setq Hi (- (sub Hi @@@ @@))) )
                  (when Hi  # Borrow
                     (setq Z (val (big Z)))
                     (set (dig Z) (sub (val (dig Z)) Hi))  # Subtract borrow
                     (when @@
                        (dec 'Q)
                        (when (or Rem M)
                           (setq Y (val V))
                           (set (dig X)  # 'x' += 'v'
                              (add (val (dig X)) (val (dig Y))) )
                           (let C @@
                              (loop
                                 (setq X (val (big X)))
                                 (? (cnt? (setq Y (val (big Y)))))
                                 (set (dig X)
                                    (add (val (dig X)) (val (dig Y)) C) )
                                 (setq C @@) )
                              (set (dig X) (+ (val (dig X)) C)) ) ) ) ) ) ) )
         (setq R (safe (consNum Q R)))
         (? (lt0 (dec 'M))) )
      (ifn Rem
         (zapZero R)
         (setq A (zapZero (val U)))
         (while D
            (setq A (half A))  # Shift right (destructive)
            (dec 'D) )
         A ) ) )

# Divide two (unsigned) numbers
(de divu (A B)
   (cond
      ((big? A) (div1 A B NO))
      ((big? B) ZERO)
      (T (cnt (/ (int A) (int B)))) ) )

# Remainder of two (unsigned) numbers
(de remu (A B)
   (cond
      ((big? A) (div1 A B YES))
      ((big? B) A)
      (T (cnt (% (int A) (int B)))) ) )

### Non-destructive signed primitives ###
(local) (incs decs adds subs)

# Increment a (signed) number
(de incs (A)
   (if (sign? A)
      (neg (subu (pos A) ONE))
      (addu A ONE) ) )

# Decrement a (signed) number
(de decs (A)
   (if (sign? A)
      (neg (addu (pos A) ONE))
      (subu A ONE) ) )

# Add two (signed) numbers
(de adds (A B)
   (ifn (sign? A)
      (ifn (sign? B)
         (addu A B)
         (subu A (pos B)) )
      (neg
         (ifn (sign? B)
            (subu (pos A) B)
            (addu (pos A) (pos B)) ) ) ) )

# Subtract to (signed) numbers
(de subs (A B)
   (ifn (sign? A)
      (ifn (sign? B)
         (subu A B)
         (addu A (pos B)) )
      (neg
         (ifn (sign? B)
            (addu (pos A) B)
            (subu (pos A) (pos B)) ) ) ) )

### Comparisons ###
(local) (cmpu cmpNum)

(de i64 cmpu (A B)
   (if (cnt? A)
      (cond
         ((or (big? B) (> B A)) -1)
         ((== B A) 0)
         (T +1) )
      # A is big
      (if (cnt? B)
         +1
         # Both are big
         (let (X 0  Y 0)
            (prog1
               (loop
                  (let (C (val (big A))  D (val (big B)))
                     (? (== C D)  # Tails equal
                        (loop
                           (setq
                              C (val (dig A))
                              D (val (dig B)) )
                           (? (> D C) -1)
                           (? (> C D) +1)
                           (? (=0 X) 0)
                           (let Z (val (big X))
                              (set (big X) A)  # Restore A
                              (setq A X  X Z) )
                           (let Z (val (big Y))
                              (set (big Y) B)  # Restore B
                              (setq B Y  Y Z) ) ) )
                     (? (cnt? C)  # End of A
                        (cond
                           ((or (big? D) (> D C)) -1)
                           ((== D C) 0)
                           (T +1) ) )
                     (? (cnt? D) +1)  # End of B
                     (set (big A) X)  # Reverse A
                     (setq X A  A C)
                     (set (big B) Y)  # Reverse B
                     (setq Y B  B D) ) )
               (while X  # Revert
                  (let Z (val (big X))
                     (set (big X) A)  # Restore A
                     (setq A X  X Z) )
                  (let Z (val (big Y))
                     (set (big Y) B)  # Restore B
                     (setq B Y  Y Z) ) ) ) ) ) ) )

(de i64 cmpNum (A B)
   (ifn (sign? A)
      (ifn (sign? B)
         (cmpu A B)
         +1 )
      (ifn (sign? B)
         -1
         (cmpu (pos B) (pos A)) ) ) )

### Formatting ###
(local) (symToNum fmtScl outScl fmtNum)

# Make number from symbol
(de symToNum (Name (i64 . Scl) (i8 . Sep) (i8 . Ign))
   (let
      (P (push 0 Name)  # [cnt name]
         Num (push ZERO NIL)  # Result
         Sign NO
         Frac NO
         B T )
      (until (> (setq B (symByte P)) (char " "))  # Skip white space
         (unless B  # None
            (ret 0) ) )
      (cond
         ((== B (char "+"))
            (goto 1) )
         ((== B (char "-"))
            (setq Sign YES)
            (: 1
               (unless (setq B (symByte P))
                  (ret 0) ) ) ) )
      (when (> (dec 'B (char "0")) 9)
         (ret 0) )
      (set (link Num T) (cnt (i64 B)))
      (while (setq B (symByte P))
         (? (and Frac (=0 Scl))
            (when (> (dec 'B (char "0")) 9)
               (ret 0) )
            (when (>= B 5)  # Round
               (set Num (addu (val Num) ONE)) )
            (while (setq B (symByte P))
               (when (> (dec 'B (char "0")) 9)
                  (ret 0) ) ) )
         (cond
            ((== B Sep)
               (when Frac
                  (ret 0) )
               (setq Frac YES) )
            ((<> B Ign)
               (when (> (dec 'B (char "0")) 9)
                  (ret 0) )
               (set Num
                  (addu
                     (tenfold (val Num))
                     (cnt (i64 B)) ) )
               (when Frac
                  (dec 'Scl) ) ) ) )
      (when Frac
         (while (ge0 (dec 'Scl))
            (set Num (tenfold (val Num))) ) )
      (setq Num (val Num))
      (if Sign (neg Num) Num) ) )

(de i64 fmtScl ((i64 . N) (i64 . Scl) (i8 . Sep) (i8 . Ign) (i64* . P))
   (when (> N 9)
      (setq Scl (fmtScl (/ N 10) Scl Sep Ign P))
      (cond
         ((=0 Scl) (byteSym Sep P))
         ((and Ign (gt0 Scl) (=0 (% Scl 3)))
            (byteSym Ign P) ) )
      (dec 'Scl)
      (setq N (% N 10)) )
   (byteSym (+ (i8 N) (char "0")) P)
   Scl )

(de i64 outScl ((i64 . N) (i64 . Scl) (i8 . Sep))
   (when (> N 9)
      (setq Scl (outScl (/ N 10) Scl Sep))
      (when (=0 Scl)
         (call $Put Sep) )
      (dec 'Scl)
      (setq N (% N 10)) )
   (call $Put (+ (i8 N) (char "0")))
   Scl )

# Format number to output, length, or symbol
(de fmtNum (Num (i64 . Scl) (i8 . Sep) (i8 . Ign) (i64* . P))
   (let (Sign (sign? Num)  Len (+ 19 17))  # Length of 'cnt' (60 bit) plus round up div/18
      # Calculate buffer size
      (let N (setq Num (& Num -9))  # Clear sign bit
         (until (cnt? N)  # Calculate length
            (inc 'Len 20)
            (setq N (val (big N))) ) )  # Add length of 'digit'
      (setq Len (/ Len 18))  # Divide by 18 (rounded), word count
      (let (Acc (b64 Len)  TopA Acc)
         # Build BCD
         (let (Inc (b64 Len)  TopI Inc)
            (set Acc 0  Inc 1)  # Init accumulator to 0 and incrementor to 1
            (loop
               (let (Dig Num  Mask 16)
                  (when (big? Num)  # and first digit and mask
                     (setq Dig (val (dig Num))  Mask 1) )
                  (loop
                     (when (& Dig Mask)  # Bit is set
                        # Add incrementor to accumulator
                        (let (A Acc  I Inc  C 0)  # Carry for BCD addition
                           (loop
                              (let N (+ (val A) (val I) C)  # Add BCDs and Carry
                                 (setq C
                                    (if (> 1000000000000000000 N)
                                       0
                                       (dec 'N 1000000000000000000)  # BCD overflow
                                       1 ) )
                                 (set A N) )
                              (? (> (inc 'I) TopI))
                              (when (> (inc 'A) TopA)
                                 (inc 'TopA)  # Extend accumulator
                                 (set A 0) ) )  # with 0
                           (when C  # BCD-Carry
                              (set (inc 'TopA) 1) ) ) )  # Extend accumulator with 1
                     # Shift incrementor left
                     (let (I Inc  C 0)
                        (loop
                           (let N (val I)
                              (setq C
                                 (if (> 1000000000000000000 (setq N (+ N N C)))  # Double digit
                                    0
                                    (dec 'N 1000000000000000000)  # BCD overflow
                                    1 ) )
                              (set I N) )
                           (? (> (inc 'I) TopI)) )
                        (when C  # BCD-Carry
                           (inc 'TopI)  # Extend incrementor
                           (set I 1) ) )  # with 1
                     (? (=0 (setq Mask (shl Mask 1)))) ) )
               (? (cnt? Num))
               (setq Num (val (big Num))) ) )
         (let (N (* (shr (- TopA Acc) 3) 18)  D (val TopA))  # Calculate length~1
            (cond
               (P  # Build symbol
                  (when Sign
                     (byteSym (char "-") P) )
                  (while (setq D (/ D 10))
                     (inc 'N) )
                  (when (lt0 (setq Scl (- N Scl)))
                     (byteSym (char "0") P)
                     (byteSym Sep P)
                     (while (> -1 Scl)
                        (inc 'Scl)
                        (byteSym (char "0") P) ) )
                  (setq Scl (fmtScl (val TopA) Scl Sep Ign P))  # Pack highest word
                  (while (>= (dec 'TopA) Acc)
                     (let (N (val TopA)  D 100000000000000000)
                        (loop
                           (cond
                              ((=0 Scl) (byteSym Sep P))
                              ((and Ign (gt0 Scl) (=0 (% Scl 3)))
                                 (byteSym Ign P) ) )
                           (dec 'Scl)
                           (byteSym (+ (i8 (/ N D)) (char "0")) P)
                           (setq N (% N D))
                           (? (== 1 (setq D (/ D 10)))) )
                        (byteSym (+ (i8 N) (char "0")) P) ) )
                  0 )
               ((== Scl -1)  # Calculate length
                  (loop
                     (inc 'N)
                     (? (=0 (setq D (/ D 10)))) )
                  (when Sign
                     (inc 'N) )
                  (cnt N) )
               (T  # Direct print
                  (when Sign
                     (call $Put (char "-")) )  # Output sign
                  (if (=0 Sep)
                     (outWord (val TopA))  # Output highest word
                     (while (setq D (/ D 10))
                        (inc 'N) )
                     (when (lt0 (setq Scl (- N Scl)))
                        (call $Put (char "0"))
                        (call $Put Sep)
                        (while (> -1 Scl)
                           (inc 'Scl)
                           (call $Put (char "0")) ) )
                     (setq Scl (outScl (val TopA) Scl Sep)) )
                  (while (>= (dec 'TopA) Acc)
                     (let (N (val TopA)  D 100000000000000000)
                        (loop
                           (when (and Sep (=0 Scl))
                              (call $Put Sep) )
                           (dec 'Scl)
                           (call $Put (+ (i8 (/ N D)) (char "0")))  # Output next digit
                           (setq N (% N D))
                           (? (== 1 (setq D (/ D 10)))) )
                        (call $Put (+ (i8 N) (char "0"))) ) )  # Output last digit
                  0 ) ) ) ) ) )

# (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
# (format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num
(de _Format (Exe)
   (let
      (X (cdr Exe)
         A (save (eval (++ X)))
         Y (eval (++ X))
         Scl (if (nil? Y) 0 (xCnt Exe Y))
         Sep (i8 (char "."))
         Ign (i8 0) )
      (when (pair X)
         (setq Sep (firstByte (needSymb Exe (eval (++ X)))))
         (when (pair X)
            (setq Ign (firstByte (needSymb Exe (eval (car X))))) ) )
      (cond
         ((num? A)
            (let P (push 4 NIL ZERO NIL)  # [cnt last name link]
               (link (ofs P 2))
               (fmtNum A Scl Sep Ign P)
               (consStr (val 3 P)) ) )
         ((sym? A)
            (cond
               ((sym? (val (tail A))) $Nil)
               ((=0 (symToNum (name @) Scl Sep Ign)) $Nil)
               (T @) ) )
         (T
            (if
               (symToNum
                  (let P (push 4 NIL ZERO NIL)  # [cnt last name link]
                     (link (ofs P 2))
                     (pack A P)
                     (val 3 P) )
                  Scl Sep Ign )
               @
               $Nil ) ) ) ) )

### Arithmetics ###
# (+ 'num ..) -> num
(de _Add (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let R (link (push (needNum Exe @) NIL))
               (loop
                  (? (atom (shift X)) (val R))
                  (? (nil? (eval (car X))) @)
                  (safe (needNum Exe @))
                  (set R (adds (val R) @)) ) ) ) ) ) )

# (- 'num ..) -> num
(de _Sub (Exe)
   (let (X (cdr Exe)  N (eval (++ X)))
      (if (nil? N)
         N
         (needNum Exe N)
         (if (atom X)  # Unary minus
            (neg N)
            (save -ZERO
               (let R (link (push N NIL))
                  (loop
                     (? (nil? (eval (++ X))) @)
                     (safe (needNum Exe @))
                     (set R (subs (val R) @))
                     (? (atom X) (val R)) ) ) ) ) ) ) )

# (inc 'num) -> num
# (inc 'var ['num]) -> num
(de _Inc (Exe)
   (let X (cdr Exe)
      (cond
         ((nil? (eval (car X))) @)
         ((num? @) (incs @))
         (T
            (let Y (save (chkVar Exe @))  # Symbol or cell
               (when (and (sym? Y) (sym? (val (tail Y))))  # External
                  (dbTouch Exe Y) )
               (if (atom (shift X))
                  (if (nil? (val Y))
                     @
                     (set Y (incs (needNum Exe @))) )
                  (let (D (save (eval (car X)))  N (val Y))
                     (cond
                        ((nil? N) N)
                        ((nil? D) D)
                        (T (set Y (adds (needNum Exe N) (needNum Exe D)))) ) ) ) ) ) ) ) )

# (dec 'num) -> num
# (dec 'var ['num]) -> num
(de _Dec (Exe)
   (let X (cdr Exe)
      (cond
         ((nil? (eval (car X))) @)
         ((num? @) (decs @))
         (T
            (let Y (save (chkVar Exe @))  # Symbol or cell
               (when (and (sym? Y) (sym? (val (tail Y))))  # External
                  (dbTouch Exe Y) )
               (if (atom (shift X))
                  (if (nil? (val Y))
                     @
                     (set Y (decs (needNum Exe @))) )
                  (let (D (save (eval (car X)))  N (val Y))
                     (cond
                        ((nil? N) N)
                        ((nil? D) D)
                        (T (set Y (subs (needNum Exe N) (needNum Exe D)))) ) ) ) ) ) ) ) )

# (* 'num ..) -> num
(de _Mul (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let
               (Sign (sign? (needNum Exe @))
                  R (link (push (pos @) NIL)) )
               (loop
                  (? (atom (shift X))
                     (let N (val R)
                        (if Sign (neg N) N) ) )
                  (let N (eval (car X))
                     (? (nil? N) N)
                     (? (== N ZERO) N)
                     (when (sign? (needNum Exe N))
                        (setq Sign (not Sign)  N (pos N)) )
                     (safe N)
                     (set R (mulu (val R) N)) ) ) ) ) ) ) )

# (*/ 'num1 ['num2 ..] 'num3) -> num
(de _MulDiv (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let
               (Sign (sign? (needNum Exe @))
                  R (link (push (pos @) NIL)) )
               (shift X)
               (loop
                  (let N (eval (car X))
                     (? (nil? N) N)
                     (when (sign? (needNum Exe N))
                        (setq Sign (not Sign)  N (pos N)) )
                     (safe N)
                     (? (atom (shift X))
                        (when (== N ZERO)
                           (divErr Exe) )
                        (let Half (save (shru N))
                           (setq N
                              (divu  # Divide by last arg
                                 (set R (addu (val R) Half))  # Round
                                 N ) ) )
                        (if Sign (neg N) N) )
                     (? (== N ZERO) N)
                     (set R (mulu (val R) N)) ) ) ) ) ) ) )

# (/ 'num ..) -> num
(de _Div (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let
               (Sign (sign? (needNum Exe @))
                  R (link (push (pos @) NIL)) )
               (loop
                  (? (atom (shift X))
                     (let N (val R)
                        (if Sign (neg N) N) ) )
                  (let N (eval (car X))
                     (? (nil? N) N)
                     (when (== N ZERO)
                        (divErr Exe) )
                     (when (sign? (needNum Exe N))
                        (setq Sign (not Sign)  N (pos N)) )
                     (safe N)
                     (set R (divu (val R) N)) ) ) ) ) ) ) )

# (% 'num ..) -> num
(de _Rem (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let
               (Sign (sign? (needNum Exe @))
                  R (link (push (pos @) NIL)) )
               (loop
                  (? (atom (shift X))
                     (let N (val R)
                        (if Sign (neg N) N) ) )
                  (let N (eval (car X))
                     (? (nil? N) N)
                     (when (== N ZERO)
                        (divErr Exe) )
                     (set R
                        (remu
                           (val R)
                           (safe (pos (needNum Exe N))) ) ) ) ) ) ) ) ) )

# (>> 'cnt 'num) -> num
(de _Shr (Exe)
   (let
      (X (cdr Exe)
         N (evCnt Exe X)
         Y (eval (cadr X)) )
      (if
         (or
            (=0 N)
            (nil? Y)
            (== ZERO (needNum Exe Y)) )
         Y
         (let Sign (sign? Y)
            (setq Y (save (pos Y)))
            (cond
               ((gt0 N)
                  (while (and (big? Y) (>= N 64))  # Large shift count
                     (setq Y (val (big Y)))  # Discard 64 bits
                     (unless (dec 'N 64)
                        (goto 9) ) )
                  (setq Y (safe (shru Y)))  # Non-destructive
                  (while (dec 'N)
                     (setq Y (half Y)) ) )  # Shift right (destructive)
               (T
                  (while (>= -64 N)
                     (setq Y (safe (consNum 0 Y)))
                     (unless (inc 'N 64)
                        (goto 9) ) )
                  (setq Y (safe (shlu Y)))  # Non-destructive
                  (while (inc 'N)
                     (setq Y (safe (twice Y))) ) ) )  # Shift left (destructive)
            (: 9
               (if Sign (neg Y) Y) ) ) ) ) )

# (rev 'cnt1 'cnt2) -> cnt
(de _Rev (Exe)
   (let
      (X (cdr Exe)
         C (evCnt Exe X)
         N (evCnt Exe (cdr X))
         R 0 )
      (loop
         (setq
            R (+ R R (& N 1))
            N (shr N 1) )
         (? (=0 (dec 'C))) )
      (cnt R) ) )

# (lt0 'any) -> num | NIL
(de _Lt0 (Exe)
   (if (and (num? (eval (cadr Exe))) (sign? @))
      @
      $Nil ) )

# (le0 'any) -> num | NIL
(de _Le0 (Exe)
   (if
      (and
         (num? (eval (cadr Exe)))
         (or (== @ ZERO) (sign? @)) )
      @
      $Nil ) )

# (ge0 'any) -> num | NIL
(de _Ge0 (Exe)
   (if
      (and
         (num? (eval (cadr Exe)))
         (not (sign? @)) )
      @
      $Nil ) )

# (gt0 'any) -> num | NIL
(de _Gt0 (Exe)
   (if
      (and
         (num? (eval (cadr Exe)))
         (<> @ ZERO)
         (not (sign? @)) )
      @
      $Nil ) )

# (abs 'num) -> num
(de _Abs (Exe)
   (if (nil? (eval (cadr Exe)))
      @
      (pos (needNum Exe @)) ) )

### Bit operations ###
# (bit? 'num ..) -> num | NIL
(de _BitQ (Exe)
   (let
      (X (cdr Exe)
         N (save (pos (needNum Exe (eval (++ X))))) )
      (loop
         (? (atom X) N)  # All matched
         (let Y (eval (++ X))
            (? (nil? Y) Y)  # Abort with NIL
            (setq Y (pos (needNum Exe Y)))
            (let Z N
               (while (big? Z)
                  (unless (big? Y)
                     (ret $Nil) )
                  (let A (val (dig Z))
                     (unless (== A (& A (val (dig Y))))
                        (ret $Nil) ) )
                  (setq
                     Y (val (big Y))
                     Z (val (big Z)) ) )
               (when (big? Y)
                  (setq Z (int Z)  Y (val (dig Y))) )
               (? (<> Z (& Y Z)) $Nil) ) ) ) ) )

# (& 'num ..) -> num
(de _BitAnd (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let R (link (push (pos (needNum Exe @)) NIL))
               (loop
                  (? (atom (shift X)) (val R))
                  (? (nil? (eval (car X))) @)
                  (safe (needNum Exe @))
                  (set R (andu (val R) (pos @))) ) ) ) ) ) )

# (| 'num ..) -> num
(de _BitOr (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let R (link (push (pos (needNum Exe @)) NIL))
               (loop
                  (? (atom (shift X)) (val R))
                  (? (nil? (eval (car X))) @)
                  (safe (needNum Exe @))
                  (set R (oru (val R) (pos @))) ) ) ) ) ) )

# (x| 'num ..) -> num
(de _BitXor (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (save -ZERO
            (let R (link (push (pos (needNum Exe @)) NIL))
               (loop
                  (? (atom (shift X)) (val R))
                  (? (nil? (eval (car X))) @)
                  (safe (needNum Exe @))
                  (set R (xoru (val R) (pos @))) ) ) ) ) ) )

# (sqrt 'num ['flg|num]) -> num
(de _Sqrt (Exe)
   (let X (cdr Exe)
      (if (nil? (eval (car X)))
         @
         (when (sign? (needNum Exe @))
            (argErr Exe @) )
         (let (Y (save @)  Z (save (eval (cadr X))))
            (when (num? Z)
               (setq Y (safe (mulu Y Z))) )
            (prog1
               (if (cnt? Y)
                  (let (M (hex "400000000000000")  R 0)
                     (setq Y (int Y))
                     (loop
                        (let N (+ R M)
                           (when (>= Y N)
                              (dec 'Y N)
                              (setq R (+ N M)) ) )
                        (setq R (shr R 1))
                        (? (=0 (setq M (shr M 2)))) )
                     (or (nil? Z) (>= R Y) (inc 'R))  # Round
                     (cnt R) )
                  (let
                     (M (consNum 0 ONE)
                        M* (link (push M NIL))
                        R (link (push ZERO NIL))
                        C (boxNum (val (dig Y)))  # Copy number
                        C* (link (push C NIL)) )
                     (while (big? (setq Y (val (big Y))))
                        (setq C
                           (set (big C) (boxNum (val (dig Y)))) )
                        (setq M (set M* (consNum 0 M))) )
                     (set (big C) Y)
                     (setq Y (safe (val C*)))
                     (while (le0 (cmpu M Y))
                        (twiceBig M)
                        (twiceBig M) )
                     (loop
                        (let N (set C* (addu (val R) M))
                           (when (ge0 (cmpu Y N))
                              (setq Y (safe (subu Y N)))
                              (set R (addu N M)) ) )
                        (set R (half (val R)))
                        (?
                           (==
                              ZERO
                              (setq M (set M* (half (half M)))) ) ) )
                     (setq R (val R))
                     (if (or (nil? Z) (ge0 (cmpu R Y)))
                        R
                        (addu R ONE) ) ) ) ) ) ) ) )  # Round


### Random generator ###
(local) initSeed

(de initSeed (X)
   (let C 0
      (while (pair X)
         (inc 'C (initSeed (++ X))) )
      (unless (nil? X)
         (unless (num? X)  # Need number
            (setq X (name (& (val (tail X)) -9))) )
         (if (cnt? X)
            (inc 'C (shr X 3))  # Keep sign
            (when (sign? X)
               (inc 'C)
               (setq X (pos X)) )
            (loop
               (inc 'C (val (dig X)))
               (? (cnt? (setq X (val (big X))))) )
            (inc 'C (int X)) ) )
      C ) )

# (seed 'any) -> cnt
(de _Seed (Exe)
   (let N (mul 6364136223846793005 (initSeed (eval (cadr Exe))))
      (set $SeedL N  $SeedH @@@)
      (| (& (shr N (- 32 3)) -8) 2) ) )  # Get higher 32 bits

# (hash 'any) -> cnt
(de _Hash (Exe)
   (let (N (initSeed (eval (cadr Exe)))  C 64  R 0)
      (loop
         (when (& (x| N R) 1)
            (setq R (x| R (hex "14002"))) )  # CRC Polynom x**16 + x**15 + x**2 + 1
         (setq N (shr N 1)  R (shr R 1))
         (? (=0 (dec 'C))) )
      (cnt (inc R)) ) )

# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
(de _Rand (Exe)
   (let
      (X (cdr Exe)
         Y (eval (++ X))
         N (add (mul 6364136223846793005 (val $SeedL)) 1) )
      (set $SeedL N  $SeedH (+ @@@ @@))
      (cond
         ((nil? Y)
            (| (& (shr N (- 32 3)) -8) 2) )  # Get higher 32 bits
         ((t? Y)
            (add N N)
            (if @@ Y $Nil) )
         (T
            (when (sign? (needCnt Exe Y))
               (argErr Exe Y) )
            (let A (int Y)
               (when (sign? (needCnt Exe (setq Y (eval (car X)))))
                  (argErr Exe Y) )
               (let B (inc (int Y))  # Seed % (cnt2 + 1 - cnt1) + cnt1
                  (when (>= A B)
                     (argErr Exe Y) )
                  (setq N
                     (+
                        (%
                           (shr (val $SeedH) (val $SeedL) 32)  # Get middle 64 bits
                           (- B A) )
                        A ) )
                  (if (lt0 N)
                     (sign (cnt (- N)))
                     (cnt N) ) ) ) ) ) ) )
