diff options
Diffstat (limited to 'src/algebra/strap/FFIELDC-.lsp')
| -rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 469 |
1 files changed, 217 insertions, 252 deletions
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index c4fb644f..36320aa1 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -118,240 +118,214 @@ (EXIT |e|)))))) (DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (PROG (|explist| |q| |equalone|) - (RETURN - (COND - ((SPADCALL |a| (|getShellEntry| $ 16)) NIL) - (T (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;primitive?;SB;9|) - (LETT |q| (- (SPADCALL (|getShellEntry| $ 40)) 1) - |FFIELDC-;primitive?;SB;9|) - (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) - (LET ((#0=#:G1488 |explist|) (|exp| NIL)) - (LOOP - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NOT (NOT |equalone|))) - (RETURN NIL)) - (T (SETQ |equalone| - (SPADCALL - (SPADCALL |a| - (TRUNCATE |q| (CAR |exp|)) - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59))))) - (SETQ #0# (CDR #0#)))) - (EXIT (NOT |equalone|)))))))) + (COND + ((SPADCALL |a| (|getShellEntry| $ 16)) NIL) + (T (LET ((|explist| (SPADCALL (|getShellEntry| $ 56))) + (|q| (- (SPADCALL (|getShellEntry| $ 40)) 1)) + (|equalone| NIL)) + (SEQ (LET ((#0=#:G1488 |explist|) (|exp| NIL)) + (LOOP + (COND + ((OR (ATOM #0#) (PROGN (SETQ |exp| (CAR #0#)) NIL) + (NOT (NOT |equalone|))) + (RETURN NIL)) + (T (SETQ |equalone| + (SPADCALL + (SPADCALL |a| + (TRUNCATE |q| (CAR |exp|)) + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))))) + (SETQ #0# (CDR #0#)))) + (EXIT (NOT |equalone|))))))) (DEFUN |FFIELDC-;order;SPi;10| (|e| $) - (PROG (|primeDivisor| |a| |goon| |ord| |lof|) + (PROG (|primeDivisor| |a| |goon|) (RETURN (COND ((SPADCALL |e| (|spadConstant| $ 7) (|getShellEntry| $ 63)) (|error| "order(0) is not defined ")) - (T (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 40)) 1) - |FFIELDC-;order;SPi;10|) - (LETT |lof| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;order;SPi;10|) - (LET ((#0=#:G1489 |lof|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|rec| (CAR #0#))) - (SEQ (LETT |a| - (TRUNCATE |ord| - (LETT |primeDivisor| (CAR |rec|) - |FFIELDC-;order;SPi;10|)) - |FFIELDC-;order;SPi;10|) - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;order;SPi;10|) - (LET ((|j| 0) - (#1=#:G1490 (- (CDR |rec|) 2))) - (LOOP - (COND - ((OR (> |j| #1#) (NOT |goon|)) - (RETURN NIL)) - (T - (SEQ (SETQ |ord| |a|) - (SETQ |a| - (TRUNCATE |ord| - |primeDivisor|)) - (EXIT - (SETQ |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59))))))) - (SETQ |j| (+ |j| 1)))) - (EXIT (COND (|goon| (SETQ |ord| |a|)))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |ord|))))))) + (T (LET ((|ord| (- (SPADCALL (|getShellEntry| $ 40)) 1)) + (|lof| (SPADCALL (|getShellEntry| $ 56)))) + (SEQ (LET ((#0=#:G1489 |lof|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|rec| (CAR #0#))) + (SEQ (LETT |a| + (TRUNCATE |ord| + (LETT |primeDivisor| + (CAR |rec|) + |FFIELDC-;order;SPi;10|)) + |FFIELDC-;order;SPi;10|) + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59)) + |FFIELDC-;order;SPi;10|) + (LET ((|j| 0) + (#1=#:G1490 (- (CDR |rec|) 2))) + (LOOP + (COND + ((OR (> |j| #1#) (NOT |goon|)) + (RETURN NIL)) + (T + (SEQ (SETQ |ord| |a|) + (SETQ |a| + (TRUNCATE |ord| + |primeDivisor|)) + (EXIT + (SETQ |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))))))) + (SETQ |j| (+ |j| 1)))) + (EXIT (COND + (|goon| (SETQ |ord| |a|)))))))) + (SETQ #0# (CDR #0#)))) + (EXIT |ord|)))))))) (DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) - (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |faclist| - |a| |gen| |disclog| |mult| |groupord| |exp|) + (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |disclog| + |mult| |groupord| |exp|) (RETURN (COND ((SPADCALL |b| (|getShellEntry| $ 16)) (|error| "discreteLog: logarithm of zero")) - (T (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 56)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) - (LETT |gen| (SPADCALL (|getShellEntry| $ 65)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT (COND - ((SPADCALL |b| |gen| (|getShellEntry| $ 63)) 1) - (T (SEQ (LETT |disclog| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |mult| 1 - |FFIELDC-;discreteLog;SNni;11|) - (LETT |groupord| - (- - (SPADCALL - (|getShellEntry| $ 40)) - 1) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exp| |groupord| - |FFIELDC-;discreteLog;SNni;11|) - (LET ((#0=#:G1491 |faclist|)) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T - (LET ((|f| (CAR #0#))) - (SEQ - (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LET - ((|t| 0) - (#1=#:G1492 - (- (CDR |f|) 1))) - (LOOP - (COND - ((> |t| #1#) - (RETURN NIL)) - (T - (SEQ - (SETQ |exp| - (TRUNCATE |exp| - |fac|)) - (LETT |exptable| - (SPADCALL |fac| - (|getShellEntry| $ - 67)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |n| - (SPADCALL - |exptable| - (|getShellEntry| $ - 68)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |c| - (SPADCALL |a| |exp| - (|getShellEntry| $ - 58)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |end| - (TRUNCATE - (- |fac| 1) |n|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |found| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disc1| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LET ((|i| 0)) - (LOOP - (COND - ((OR - (> |i| - |end|) - (NOT - (NOT - |found|))) - (RETURN NIL)) - (T - (SEQ - (LETT |rho| - (SPADCALL - (SPADCALL - |c| - (|getShellEntry| - $ 11)) - |exptable| - (|getShellEntry| - $ 71)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (COND - ((ZEROP - (CAR - |rho|)) - (SEQ - (SETQ - |found| - T) - (EXIT - (SETQ - |disc1| - (* - (+ - (* - |n| - |i|) - (CDR - |rho|)) - |mult|))))) - (T - (SETQ - |c| - (SPADCALL - |c| - (SPADCALL - |gen| - (* - (TRUNCATE - |groupord| - |fac|) - (- - |n|)) - (|getShellEntry| - $ - 58)) - (|getShellEntry| - $ 77))))))))) - (SETQ |i| - (+ |i| 1)))) - (EXIT + (T (LET ((|faclist| (SPADCALL (|getShellEntry| $ 56))) + (|a| |b|) (|gen| (SPADCALL (|getShellEntry| $ 65)))) + (COND + ((SPADCALL |b| |gen| (|getShellEntry| $ 63)) 1) + (T (SEQ (LETT |disclog| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |mult| 1 |FFIELDC-;discreteLog;SNni;11|) + (LETT |groupord| + (- (SPADCALL (|getShellEntry| $ 40)) 1) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;SNni;11|) + (LET ((#0=#:G1491 |faclist|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|f| (CAR #0#))) + (SEQ (LETT |fac| (CAR |f|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LET + ((|t| 0) + (#1=#:G1492 (- (CDR |f|) 1))) + (LOOP + (COND + ((> |t| #1#) + (RETURN NIL)) + (T + (SEQ + (SETQ |exp| + (TRUNCATE |exp| |fac|)) + (LETT |exptable| + (SPADCALL |fac| + (|getShellEntry| $ + 67)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |n| + (SPADCALL |exptable| + (|getShellEntry| $ + 68)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |c| + (SPADCALL |a| |exp| + (|getShellEntry| $ + 58)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |end| + (TRUNCATE (- |fac| 1) + |n|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |found| NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disc1| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LET ((|i| 0)) + (LOOP (COND - (|found| + ((OR + (> |i| |end|) + (NOT + (NOT |found|))) + (RETURN NIL)) + (T (SEQ - (SETQ |mult| - (* |mult| - |fac|)) - (SETQ |disclog| - (+ |disclog| - |disc1|)) - (EXIT - (SETQ |a| - (SPADCALL |a| - (SPADCALL - |gen| - (- |disc1|) - (|getShellEntry| - $ 58)) + (LETT |rho| + (SPADCALL + (SPADCALL |c| (|getShellEntry| - $ 77)))))) - (T - (|error| - "discreteLog: ?? discrete logarithm"))))))) - (SETQ |t| (+ |t| 1))))))))) - (SETQ #0# (CDR #0#)))) - (EXIT |disclog|))))))))))) + $ 11)) + |exptable| + (|getShellEntry| + $ 71)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (COND + ((ZEROP + (CAR + |rho|)) + (SEQ + (SETQ + |found| + T) + (EXIT + (SETQ + |disc1| + (* + (+ + (* |n| + |i|) + (CDR + |rho|)) + |mult|))))) + (T + (SETQ |c| + (SPADCALL + |c| + (SPADCALL + |gen| + (* + (TRUNCATE + |groupord| + |fac|) + (- |n|)) + (|getShellEntry| + $ 58)) + (|getShellEntry| + $ 77))))))))) + (SETQ |i| + (+ |i| 1)))) + (EXIT + (COND + (|found| + (SEQ + (SETQ |mult| + (* |mult| |fac|)) + (SETQ |disclog| + (+ |disclog| + |disc1|)) + (EXIT + (SETQ |a| + (SPADCALL |a| + (SPADCALL |gen| + (- |disc1|) + (|getShellEntry| + $ 58)) + (|getShellEntry| + $ 77)))))) + (T + (|error| + "discreteLog: ?? discrete logarithm"))))))) + (SETQ |t| (+ |t| 1))))))))) + (SETQ #0# (CDR #0#)))) + (EXIT |disclog|)))))))))) (DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) (PROG (|rhoHelp| |rho| |fac| |primroot| |groupord| |faclist| |a| @@ -456,39 +430,30 @@ (SPADCALL |f| (|getShellEntry| $ 98))) (DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $) - (PROG (|flist|) - (RETURN - (COND - ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100)) - (|spadConstant| $ 101)) - (T (SEQ (LETT |flist| (SPADCALL |f| T (|getShellEntry| $ 105)) - |FFIELDC-;factorSquareFreePolynomial|) - (EXIT (SPADCALL - (SPADCALL (CAR |flist|) - (|getShellEntry| $ 106)) - (LET ((#0=#:G1483 NIL) (#1=#:G1484 T) - (#2=#:G1495 (CDR |flist|))) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND - (#1# (|spadConstant| $ 109)) - (T #0#)))) - (T (LET ((|u| (CAR #2#))) - (LET - ((#3=#:G1482 - (SPADCALL (CAR |u|) (CDR |u|) - (|getShellEntry| $ 107)))) - (COND - (#1# (SETQ #0# #3#)) - (T - (SETQ #0# - (SPADCALL #0# #3# - (|getShellEntry| $ 108))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|getShellEntry| $ 110))))))))) + (COND + ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100)) + (|spadConstant| $ 101)) + (T (LET ((|flist| (SPADCALL |f| T (|getShellEntry| $ 105)))) + (SPADCALL (SPADCALL (CAR |flist|) (|getShellEntry| $ 106)) + (LET ((#0=#:G1483 NIL) (#1=#:G1484 T) + (#2=#:G1495 (CDR |flist|))) + (LOOP + (COND + ((ATOM #2#) + (RETURN + (COND (#1# (|spadConstant| $ 109)) (T #0#)))) + (T (LET ((|u| (CAR #2#))) + (LET ((#3=#:G1482 + (SPADCALL (CAR |u|) (CDR |u|) + (|getShellEntry| $ 107)))) + (COND + (#1# (SETQ #0# #3#)) + (T (SETQ #0# + (SPADCALL #0# #3# + (|getShellEntry| $ 108))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 110)))))) (DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) (SPADCALL |f| |g| (|getShellEntry| $ 112))) |