factor.lisp: rename special variable P to *P*

P was at least partially used like a special variable, not purely lexical.

There are probably some (or many) instances where it was used in a lexical way,
but deciding that for every instance is tricky (nested function calls, poor
documentation).

Author: TomasRiker

src/factor.lisp

@@ -601,7 +601,12 @@
 	 (or (numberp u) (alg u)))
 	(t (quick-sqfr-check u var))))
 
-(declare-top (special p))
+(declare-top (special *p*))
+
+;; Note: *P* used to be P. In some functions below, *P* can probably be
+;;       renamed back to P (lexical variable), but some do really need a special
+;;       variable because they use it to transport state from one function to
+;;       another.
 
 (defun fixvl0 (l1 l2 ov)
   (prog (a b c)
@@ -633,8 +638,8 @@
 
 (defun multfact (poly)
   (prog (*inl3 *i* *min* *mx* nn* *odr* lc elm listelm plim origenvar ne var valist val1
-	 ovarlist p subvar subvar1 subval1 subval dlp)
-     ;;	     (declare (special p))
+	 ovarlist *p* subvar subvar1 subval1 subval dlp)
+     ;;	     (declare (special *p*))
      (setq var (car poly) elm (listovars poly)
 	   origenvar genvar
 	   genvar (intersect genvar (if algfac*
@@ -652,7 +657,7 @@
 					  (> (cadddr subval) 1))
 				      (degvector nil 1 (car subval)))))))
      (setq subval nil)
-     (setq p poly)
+     (setq *p* poly)
      (when (null val1)
        (setq subvar1 ovarlist)
        (setq subval1 (polysubst (make-list (length subvar1) :initial-element 0) subvar1))
@@ -665,20 +670,20 @@
      (setq subval1 nil subvar1 nil)
      (fixvl0 subvar subval (reverse ovarlist))
      (when algfac* (push (car *alpha*) genvar))
-     (setq poly (cpber3 poly p))
+     (setq poly (cpber3 poly *p*))
      (setq genvar origenvar)
      (return poly)))
 
 (defun polysubst (a b)
   (prog (lc *inl3 d n modulus)
      (when modulu* (setq modulus modulu*))
-     (setq *inl3 t lc (caddr p) n (length a))
+     (setq *inl3 t lc (caddr *p*) n (length a))
      loop (setq d (pcsubsty a b lc))
      (when (equal 0 d) (go inl))
      (let ((modulus nil))
-       (setq d (pcsubsty a b p)))
+       (setq d (pcsubsty a b *p*)))
      (when (sqfrp (pmod d) (car d))
-       (setq p d) (return a))
+       (setq *p* d) (return a))
      inl  (setq a (increaselist a n))
      (go loop)))
 
@@ -706,14 +711,14 @@
    (setq r (cdr r))
    (go loop)))
 
-(defun maxcoef (p)
-  (maxcoefficient p))
+(defun maxcoef (*p*)
+  (maxcoefficient *p*))
 
-(defun incrlimk (p)
+(defun incrlimk (*p*)
   (prog (v min-plim)
      (cond (modulu* (setq plim modulu* *prime modulu* limk -1) (return nil))
 	   ((null limk)(setq plim *alpha *prime *alpha limk -1)(return nil)))
-     (setq v (butlast (pdegreevector p)))
+     (setq v (butlast (pdegreevector *p*)))
      (setq v
 	   (apply
 	    '*
@@ -727,7 +732,7 @@
 			       (expt b a)))))
 	     v
 	     valist)))
-     (setq min-plim (* (max (maxcoef p) plim) v))
+     (setq min-plim (* (max (maxcoef *p*) plim) v))
      loop (cond ((< min-plim plim) (return nil)))
      (incf limk)
      (setq plim (* plim plim))
@@ -798,12 +803,12 @@
      (go test)
      out  (return ans)))
 
-(defun multideg (p)
+(defun multideg (*p*)
   (prog (m d)
-     (cond ((numberp p) (return 0)) ((onevarp p) (return (cadr p))))
-     (setq p (cdr p) m (car p))
-     loop (cond ((null p) (return m)))
-     (setq d (+ (car p) (multideg (cadr p))) p (cddr p) m (max d m))
+     (cond ((numberp *p*) (return 0)) ((onevarp *p*) (return (cadr *p*))))
+     (setq *p* (cdr *p*) m (car *p*))
+     loop (cond ((null *p*) (return m)))
+     (setq d (+ (car *p*) (multideg (cadr *p*))) *p* (cddr *p*) m (max d m))
      (go loop)))
 
 (defun oddelm (list)
@@ -1083,9 +1088,9 @@
 
 
 (defun fact2z (u f g limk)
-  (prog (a a1 w pk mpk b c r p ql qlp h (k 0) b1)
+  (prog (a a1 w pk mpk b c r *p* ql qlp h (k 0) b1)
      (declare (fixnum k))
-     (setq p modulus)
+     (setq *p* modulus)
      (setq r (ppprog f g))
      (setq a (car r))
      (setq b (cadr r))
@@ -1119,69 +1124,69 @@
      (setq b (pplus b (npctimes mpk b1)))
      (setq h nil b1 nil qlp nil)
      (go sharp)
-     on   (set-modulus p)
+     on   (set-modulus *p*)
      (return (list f g))))
 
 
 
-(defun npctimes (c p)
-  (setq p (npctimes1 c p))
-  (if (and (not (atom p)) (null (cdr p)))
+(defun npctimes (c *p*)
+  (setq *p* (npctimes1 c *p*))
+  (if (and (not (atom *p*)) (null (cdr *p*)))
       0
-      p))
+      *p*))
 
-(defun npquo (p c)
+(defun npquo (*p* c)
   (prog (u modulus)
-     (cond ((equal c 1) (return p))
-	   ((pcoefp p) (return (quotient p c))))
-     (setq u p)
-     loop (cond ((null (cdr u)) (return p)))
+     (cond ((equal c 1) (return *p*))
+	   ((pcoefp *p*) (return (quotient *p* c))))
+     (setq u *p*)
+     loop (cond ((null (cdr u)) (return *p*)))
      (setq u (cddr u))
      (rplaca u (cond ((pcoefp (car u))
 		      (quotient (car u) c))
 		     (t (npquo (copy-list (car u)) c))))
      (go loop)))
 
-(defun npctimes1 (c p)
+(defun npctimes1 (c *p*)
   (prog (u a)
-     (cond((equal c 1)(return p))
-	  ((pcoefp p)(return (ctimes c p))))
-     (setq u p)
-     loop (cond ((null (cdr u))(return p)))
+     (cond((equal c 1)(return *p*))
+	  ((pcoefp *p*)(return (ctimes c *p*))))
+     (setq u *p*)
+     loop (cond ((null (cdr u))(return *p*)))
      (setq a (cond ((pcoefp (caddr u)) (ctimes c (caddr u)))
 		   (t (npctimes c (copy-list (caddr u))))))
      (cond ((equal a 0) (rplacd u (cdddr u)))
 	   (t (setq u (cddr u))
 	      (rplaca u a)))
      (go loop)))
 
-(defun x**q1 (term u m p)
+(defun x**q1 (term u m *p*)
   (declare (fixnum m))
   (prog ((i 1))
      (declare (fixnum i))
      (setq trl* (list term))
-     loop (when (= i m) (return (pexptmod term p u)))
-     (setq term (pexptmod term p u))
+     loop (when (= i m) (return (pexptmod term *p* u)))
+     (setq term (pexptmod term *p* u))
      (setq trl* (cons term trl*))
      (incf i)
      (go loop)))
 
-(defun cptomf (p u n)
-  (declare (fixnum n p))
+(defun cptomf (*p* u n)
+  (declare (fixnum n *p*))
   (prog (l s *xn (j 0) (i 0) ind (n-1 (1- n)) )
      (declare (fixnum i j))
      loop (incf j)
      (cond ((= j n) (return nil))
 	   (ind (go sa))
-	   ((> (* p j) n-1)
+	   ((> (* *p* j) n-1)
 	    (setq *xn (mapcar #'- (p2cpol (cddr u) n-1))
 		  s (copy-tree *xn)
 		  ind t)
-	    (setq i (- (* p j) n))
+	    (setq i (- (* *p* j) n))
 	    (go sa1)))
-     (setq s (p2cpol (list var (* p j) 1) n-1))
+     (setq s (p2cpol (list var (* *p* j) 1) n-1))
      (go st)
-     sa   (setq i p)
+     sa   (setq i *p*)
      sa1  (cond ((= i 0) (go st)))
      (cptimesx s)
      (decf i)
@@ -1200,25 +1205,25 @@
      on   (decf (aref *afixn* j j))
      (go loop)))
 
-(defun p2cpol (p n)
+(defun p2cpol (*p* n)
   (declare (fixnum n))
   (prog (l)
-     (setq p (cdr p))
+     (setq *p* (cdr *p*))
      loop (cond ((= n -1) (return (nreverse l)))
-		((or (null p) (> n (car p))) (setq l (cons 0 l)))
-		((= n (car p))
-		 (setq l (cons (cadr p) l))
-		 (setq p (cddr p))))
+		((or (null *p*) (> n (car *p*))) (setq l (cons 0 l)))
+		((= n (car *p*))
+		 (setq l (cons (cadr *p*) l))
+		 (setq *p* (cddr *p*))))
      (decf n)
      (go loop)))
 
-(defun cptimesx (p)
+(defun cptimesx (*p*)
   (prog (xn q lc)
-     (setq xn *xn q p lc (car p))
+     (setq xn *xn q *p* lc (car *p*))
      loop (cond ((cdr q)
 		 (rplaca q (cplus (cadr q) (ctimes lc (car xn))))
 		 (setq q (cdr q) xn (cdr xn)))
-		(t (rplaca q (ctimes lc (car xn))) (return p)))
+		(t (rplaca q (ctimes lc (car xn))) (return *p*)))
      (go loop)))
 
 
@@ -1339,25 +1344,25 @@
      (return (list linfac (cpbq1 u (cadr u)) u))))
 
 
-(defun factor1972 (p)
+(defun factor1972 (*p*)
   (let ((modulu* modulus) many* *stop* modulus mcflag *negflag*)
-    (if (or (atom p) (numberp p) (and algfac* (alg p)))
-	(list p)
-	(factor72 p))))
+    (if (or (atom *p*) (numberp *p*) (and algfac* (alg *p*)))
+	(list *p*)
+	(factor72 *p*))))
 
-(defun factor72 (p)
+(defun factor72 (*p*)
   (let ((sharpcont 1) plim)
-    (setq p (cond ((onevarp p)
-		   (mapcar #'posize (fact5 p)))
+    (setq *p* (cond ((onevarp *p*)
+		   (mapcar #'posize (fact5 *p*)))
 		  (t
 		   (setq many* t)
-		   (multfact p))))
+		   (multfact *p*))))
     (if *negflag*
-	(cons (pminus (car p)) (cdr p))
-	p)))
+	(cons (pminus (car *p*)) (cdr *p*))
+	*p*)))
 
-(defun posize (p)
-  (cond ((pminusp p)
+(defun posize (*p*)
+  (cond ((pminusp *p*)
 	 (setq *negflag* (not *negflag*))
-	 (pminus p))
-	(t p)))
+	 (pminus *p*))
+	(t *p*)))