aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog10
-rw-r--r--src/algebra/integer.spad.pamphlet2
-rw-r--r--src/algebra/si.spad.pamphlet2
-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
-rw-r--r--src/interp/g-opt.boot2
-rw-r--r--src/interp/g-util.boot5
-rw-r--r--src/interp/spad.lisp15
-rw-r--r--src/interp/sys-globals.boot3
17 files changed, 50 insertions, 49 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 49c6b891..94060372 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,4 +1,12 @@
-2010-07-28 Gabriel Dos Reis <gdr@cse.tamu.edu>
+2010-07-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * 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.
+
+2010-07-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
* algebra/integer.spad.pamphlet (Integer): Use builtin functions
%irem and %iquo.
diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet
index 1b67fd0e..fa8cdb76 100644
--- a/src/algebra/integer.spad.pamphlet
+++ b/src/algebra/integer.spad.pamphlet
@@ -211,7 +211,7 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with
odd? x == %iodd? x
max(x,y) == %imax(x,y)
min(x,y) == %imin(x,y)
- divide(x,y) == DIVIDE2(x,y)$Lisp
+ divide(x,y) == %idivide(x,y)$Foreign(Builtin)
x quo y == %iquo(x,y)
x rem y == %irem(x,y)
shift(x, y) == ASH(x,y)$Lisp
diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet
index 6a7ef5a3..51bd9748 100644
--- a/src/algebra/si.spad.pamphlet
+++ b/src/algebra/si.spad.pamphlet
@@ -316,7 +316,7 @@ SingleInteger(): Join(IntegerNumberSystem,OrderedFinite,BooleanLogic,Logic,OpenM
(%ipow(x, n)$Foreign(Builtin) pretend Integer)::%
x quo y == %iquo(x,y)
x rem y == %irem(x,y)
- divide(x, y) == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp
+ divide(x, y) == %idivide(x,y)$Foreign(Builtin)
gcd(x,y) == %igcd(x,y)
abs(x) == %iabs x
odd?(x) == %iodd? x
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|
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index af4eb981..32f7c426 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -443,7 +443,7 @@ $VMsideEffectFreeOperators ==
%beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl
%icst0 %icst1
%imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
- %irem %iquo
+ %irem %iquo %idivide
%feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
%fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
%nil %pair? %lconcat %llength %lfirst %lsecond %lthird
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 11bc3b28..b408d077 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -263,6 +263,10 @@ expandIneg ['%ineg,x] ==
integer? x => -x
['_-,x]
+expandIdivide ['%idivide,x,y] ==
+ ['MULTIPLE_-VALUE_-CALL,['FUNCTION,'CONS],
+ ['TRUNCATE,expandToVMForm x,expandToVMForm y]]
+
expandIeq ['%ieq,a,b] ==
a := expandToVMForm a
integer? a and a = 0 => ['ZEROP,expandToVMForm b]
@@ -463,6 +467,7 @@ for x in [
['%igt, :function expandIgt],
['%ilt, :function expandIlt],
['%ineg, :function expandIneg],
+ ['%idivide, :function expandIdivide],
['%bitand, :function expandBitand],
['%bitior, :function expandBitior],
['%bitnot, :function expandBitnot],
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 72b68a6a..5c6f0f2e 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -244,20 +244,6 @@
(sort (copy-seq seq) (function (lambda (x y) (SPADCALL X Y SPADFN)))))
#-Lucid
-(defun QUOTIENT2 (X Y) (values (TRUNCATE X Y)))
-
-#+Lucid
-(defun QUOTIENT2 (X Y) ; following to force error check in division by zero
- (values (if (zerop y) (truncate 1 Y) (TRUNCATE X Y))))
-
-#-Lucid
-(define-function 'REMAINDER2 #'REM)
-
-#+Lucid
-(defun REMAINDER2 (X Y)
- (if (zerop y) (REM 1 Y) (REM X Y)))
-
-#-Lucid
(defun DIVIDE2 (X Y) (multiple-value-call #'cons (TRUNCATE X Y)))
#+Lucid
@@ -290,7 +276,6 @@
|$insideCategoryIfTrue| |$insideCapsuleFunctionIfTrue| |$form|
(|$e| |$EmptyEnvironment|)
(|$genSDVar| 0)
- (|$VariableCount| 0)
(|$previousTime| (TEMPUS-FUGIT)))
(|compileParseTree| X)))
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 28e8b594..c6e31a4d 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -209,9 +209,6 @@ $PrettyPrint := false
$previousTime := 0
++
-$VariableCount := 0
-
-++
$useBFasDefault := true
++
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 09:12:32 +0000