summaryrefslogtreecommitdiff
path: root/sci-mathematics/fricas/files/fricas-sbcl-2.3.9.patch
blob: 6f7440afecf572c30ec9c23a29198c55c0748c86 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
diff --git a/src/lisp/num_gmp.lisp b/src/lisp/num_gmp.lisp
index b58001e..9538e3c 100644
--- a/src/lisp/num_gmp.lisp
+++ b/src/lisp/num_gmp.lisp
@@ -549,6 +549,20 @@
 ;;; (gmp-bignum-isqrt (expt 10 50))
 ;;; (gmp-bignum-isqrt (expt 2 127))
 #+:sbcl
+
+(defmacro negate_bignum(x)
+    (let ((sym2
+          (find-symbol "NEGATE-BIGNUM-NOT-FULLY-NORMALIZED" "SB-BIGNUM")))
+        (if sym2
+            `(,sym2 ,x)
+            ;;; 'read-from-string' looks silly, but here we want error
+            ;;;  if NEGATE-BIGNUM is absent from SB-BIGNUM
+            (let ((sym1 (read-from-string "SB-BIGNUM::NEGATE-BIGNUM")))
+                 `(,sym1 ,x nil))
+        )
+    )
+)
+
 (defun gmp-bignum-isqrt (x)
   (let* ((len-x (sb-bignum::%bignum-length x))
          (len-res (ceiling (+ 1 len-x) 2))
@@ -652,8 +666,8 @@
                   (sb-bignum::%bignum-length a)))
          (b-plusp (sb-bignum::%bignum-0-or-plusp b
                   (sb-bignum::%bignum-length b)))
-         (a (if a-plusp a (sb-bignum::negate-bignum a)))
-         (b (if b-plusp b (sb-bignum::negate-bignum b)))
+         (a (if a-plusp a (negate_bignum a)))
+         (b (if b-plusp b (negate_bignum b)))
          (len-a (sb-bignum::%bignum-length a))
          (len-b (sb-bignum::%bignum-length b))
          (len-res (+ len-a len-b))
@@ -697,10 +711,10 @@
   (let* (
     (nx (if (sb-bignum::%bignum-0-or-plusp x (sb-bignum::%bignum-length x))
             (sb-bignum::copy-bignum x)
-            (sb-bignum::negate-bignum x nil)))
+            (negate_bignum x)))
     (ny (if (sb-bignum::%bignum-0-or-plusp y (sb-bignum::%bignum-length y))
             (sb-bignum::copy-bignum y)
-            (sb-bignum::negate-bignum y nil)))
+            (negate_bignum y)))
     (xl (sb-bignum::%bignum-length nx))
     (yl (sb-bignum::%bignum-length ny))
     (rl (if (< xl yl) xl yl))
@@ -735,9 +749,9 @@
     (x-plusp (sb-bignum::%bignum-0-or-plusp x (sb-bignum::%bignum-length x)))
     (y-plusp (sb-bignum::%bignum-0-or-plusp y (sb-bignum::%bignum-length y)))
     (nx (if x-plusp x
-           (sb-bignum::negate-bignum x nil)))
+           (negate_bignum x)))
     (ny (if y-plusp y
-           (sb-bignum::negate-bignum y nil)))
+           (negate_bignum y)))
     (len-x (sb-bignum::%bignum-length nx))
     (len-y (sb-bignum::%bignum-length ny))
     (q nil)