aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-07-28 10:41:18 +0000
committerdos-reis <gdr@axiomatics.org>2010-07-28 10:41:18 +0000
commit16979e1df537412a0baba5c95c7d0036bf0ddf9b (patch)
tree2540a198dc03ba3d529a9a293fd5015d574216ec /src/algebra/strap
parentba91d65da984ba19dff664422ca48b2a179ea4b9 (diff)
downloadopen-axiom-16979e1df537412a0baba5c95c7d0036bf0ddf9b.tar.gz
* interp/sys-globals.boot ($VariableCount): Remove.
* interp/spad.lisp (QUOTIENT2): Remove. (REMAINDER2): Likewise. * algebra/integer.spad.pamphlet (Integer): Use builtin %idivide. * algebra/si.spad.pamphlet (SingleInteger): Likewise.
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/DFLOAT.lsp4
-rw-r--r--src/algebra/strap/EUCDOM-.lsp2
-rw-r--r--src/algebra/strap/FFIELDC-.lsp31
-rw-r--r--src/algebra/strap/FPS-.lsp2
-rw-r--r--src/algebra/strap/ILIST.lsp2
-rw-r--r--src/algebra/strap/INT.lsp4
-rw-r--r--src/algebra/strap/LSAGG-.lsp2
-rw-r--r--src/algebra/strap/OUTFORM.lsp4
-rw-r--r--src/algebra/strap/SINT.lsp5
-rw-r--r--src/algebra/strap/SYMBOL.lsp4
10 files changed, 33 insertions, 27 deletions
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index defb150d..6ce53de0 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -748,7 +748,9 @@
(T
(SEQ
(LETT |#G107|
- (DIVIDE2 |s| |t|)
+ (MULTIPLE-VALUE-CALL
+ #'CONS
+ (TRUNCATE |s| |t|))
|DFLOAT;rationalApproximation;$2NniF;87|)
(LETT |q| (CAR |#G107|)
|DFLOAT;rationalApproximation;$2NniF;87|)
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 9a28b2bf..ee210403 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -299,7 +299,7 @@
(T (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58))
|EUCDOM-;multiEuclidean;LSU;11|)
(LETT |l2|
- (SPADCALL |l1| (QUOTIENT2 |n| 2)
+ (SPADCALL |l1| (TRUNCATE |n| 2)
(|getShellEntry| $ 61))
|EUCDOM-;multiEuclidean;LSU;11|)
(LETT |u|
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 2f8a01ce..874d766f 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -79,7 +79,7 @@
(DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $)
(SPADCALL |x|
- (QUOTIENT2 (SPADCALL (|getShellEntry| $ 40))
+ (TRUNCATE (SPADCALL (|getShellEntry| $ 40))
(|spadConstant| $ 41))
(|getShellEntry| $ 43)))
@@ -137,7 +137,7 @@
(T (SETQ |equalone|
(SPADCALL
(SPADCALL |a|
- (QUOTIENT2 |q| (CAR |exp|))
+ (TRUNCATE |q| (CAR |exp|))
(|getShellEntry| $ 58))
(|getShellEntry| $ 59)))))
(SETQ #0# (CDR #0#))))
@@ -161,7 +161,7 @@
((ATOM #0#) (RETURN NIL))
(T (LET ((|rec| (CAR #0#)))
(SEQ (LETT |a|
- (QUOTIENT2 |ord|
+ (TRUNCATE |ord|
(LETT |primeDivisor| (CAR |rec|)
|FFIELDC-;order;SPi;10|))
|FFIELDC-;order;SPi;10|)
@@ -182,7 +182,7 @@
(T
(SEQ (SETQ |ord| |a|)
(SETQ |a|
- (QUOTIENT2 |ord|
+ (TRUNCATE |ord|
|primeDivisor|))
(EXIT
(SETQ |goon|
@@ -245,7 +245,7 @@
(T
(SEQ
(SETQ |exp|
- (QUOTIENT2
+ (TRUNCATE
|exp| |fac|))
(LETT
|exptable|
@@ -267,7 +267,7 @@
$ 58))
|FFIELDC-;discreteLog;SNni;11|)
(LETT |end|
- (QUOTIENT2
+ (TRUNCATE
(- |fac| 1)
|n|)
|FFIELDC-;discreteLog;SNni;11|)
@@ -330,7 +330,7 @@
(SPADCALL
|gen|
(*
- (QUOTIENT2
+ (TRUNCATE
|groupord|
|fac|)
(-
@@ -392,13 +392,12 @@
((SPADCALL |b| |logbase| (|getShellEntry| $ 63))
(CONS 0 1))
(T (COND
- ((NOT (ZEROP (REMAINDER2
- (LETT |groupord|
- (SPADCALL |logbase|
- (|getShellEntry| $ 19))
- |FFIELDC-;discreteLog;2SU;12|)
- (SPADCALL |b|
- (|getShellEntry| $ 19)))))
+ ((NOT (ZEROP (REM (LETT |groupord|
+ (SPADCALL |logbase|
+ (|getShellEntry| $ 19))
+ |FFIELDC-;discreteLog;2SU;12|)
+ (SPADCALL |b|
+ (|getShellEntry| $ 19)))))
(SEQ (SPADCALL
"discreteLog: second argument not in cyclic group generated by first argument"
(|getShellEntry| $ 83))
@@ -425,7 +424,7 @@
|FFIELDC-;discreteLog;2SU;12|)
(LETT |primroot|
(SPADCALL |logbase|
- (QUOTIENT2 |groupord| |fac|)
+ (TRUNCATE |groupord| |fac|)
(|getShellEntry| $ 58))
|FFIELDC-;discreteLog;2SU;12|)
(EXIT
@@ -438,7 +437,7 @@
(T
(SEQ
(SETQ |exp|
- (QUOTIENT2 |exp| |fac|))
+ (TRUNCATE |exp| |fac|))
(LETT |rhoHelp|
(SPADCALL |primroot|
(SPADCALL |a| |exp|
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index cee87448..744e62bf 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -14,7 +14,7 @@
(DEFUN |FPS-;digits;Pi;2| ($)
(LET ((#0=#:G1402
(MAX 1
- (QUOTIENT2
+ (TRUNCATE
(SPADCALL 4004
(- (SPADCALL (|getShellEntry| $ 14)) 1)
(|getShellEntry| $ 16))
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 75666112..ff6511d6 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -401,7 +401,7 @@
(EXIT (COND
((< |n| 3) |p|)
(T (SEQ (LETT |l|
- (LET ((#0=#:G1511 (QUOTIENT2 |n| 2)))
+ (LET ((#0=#:G1511 (TRUNCATE |n| 2)))
(|check-subtype| (NOT (MINUSP #0#))
'(|NonNegativeInteger|) #0#))
|ILIST;mergeSort|)
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index 5ef3c73c..3be4c61e 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -207,7 +207,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Pair|)
|INT;divide;2$R;48|))
-(PUT '|INT;divide;2$R;48| '|SPADreplace| 'DIVIDE2)
+(PUT '|INT;divide;2$R;48| '|SPADreplace| '|%idivide|)
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
|INT;quo;3$;49|))
@@ -430,7 +430,7 @@
(DEFUN |INT;divide;2$R;48| (|x| |y| $)
(DECLARE (IGNORE $))
- (DIVIDE2 |x| |y|))
+ (MULTIPLE-VALUE-CALL #'CONS (TRUNCATE |x| |y|)))
(DEFUN |INT;quo;3$;49| (|x| |y| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 747351b5..5599f794 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -405,7 +405,7 @@
(EXIT (COND
((< |n| 3) |p|)
(T (SEQ (LETT |l|
- (LET ((#0=#:G1511 (QUOTIENT2 |n| 2)))
+ (LET ((#0=#:G1511 (TRUNCATE |n| 2)))
(|check-subtype| (NOT (MINUSP #0#))
'(|NonNegativeInteger|) #0#))
|LSAGG-;mergeSort|)
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 43a2d0bc..21ec89fa 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -594,8 +594,8 @@
(DEFUN |OUTFORM;center;$I$;22| (|a| |w| $)
(|OUTFORM;hconcat;3$;48|
- (|OUTFORM;hspace;I$;29|
- (QUOTIENT2 (- |w| (|outformWidth| |a|)) 2) $)
+ (|OUTFORM;hspace;I$;29| (TRUNCATE (- |w| (|outformWidth| |a|)) 2)
+ $)
|a| $))
(DEFUN |OUTFORM;left;$I$;23| (|a| |w| $)
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index b891bed3..540a317b 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -174,6 +174,8 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Pair|)
|SINT;divide;2$R;39|))
+(PUT '|SINT;divide;2$R;39| '|SPADreplace| '|%idivide|)
+
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;gcd;3$;40|))
@@ -420,7 +422,8 @@
(REM |x| |y|))
(DEFUN |SINT;divide;2$R;39| (|x| |y| $)
- (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|)))
+ (DECLARE (IGNORE $))
+ (MULTIPLE-VALUE-CALL #'CONS (TRUNCATE |x| |y|)))
(DEFUN |SINT;gcd;3$;40| (|x| |y| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index b1cb0a30..008cf1e5 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -388,7 +388,9 @@
(LOOP
(COND
(NIL (RETURN NIL))
- (T (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|))
+ (T (SEQ (LETT |qr|
+ (MULTIPLE-VALUE-CALL #'CONS
+ (TRUNCATE |n| (QCSIZE |s|)))
|SYMBOL;anyRadix|)
(SETQ |n| (CAR |qr|))
(SETQ |ns|
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 08:45:16 +0000