[35aab3] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
| 4 | /*************************************************************** |
---|
[5a9e7b] | 5 | * File: p_Procs_Set.h |
---|
[35aab3] | 6 | * Purpose: Procedures for setting p_Procs at run time |
---|
| 7 | * Note: this file is included by p_Procs_Dynamic/Static.cc |
---|
| 8 | * The macros |
---|
| 9 | * DoSetProc(what, field, length, ord) |
---|
| 10 | * InitSetProc(field, length ord) |
---|
| 11 | * have to be defined before this file is included |
---|
| 12 | * Author: obachman (Olaf Bachmann) |
---|
| 13 | * Created: 12/00 |
---|
[341696] | 14 | * Version: $Id$ |
---|
[35aab3] | 15 | *******************************************************************/ |
---|
[da55c8] | 16 | #include <coeffs/modulop.h> |
---|
[35aab3] | 17 | |
---|
[cf3743] | 18 | #include <reporter/reporter.h> |
---|
[5a9e7b] | 19 | |
---|
[35aab3] | 20 | // extract p_Procs properties from a ring |
---|
| 21 | static inline p_Field p_FieldIs(ring r) |
---|
| 22 | { |
---|
| 23 | if (rField_is_Zp(r)) |
---|
| 24 | return FieldZp; |
---|
| 25 | if (rField_is_R(r)) return FieldR; |
---|
| 26 | if (rField_is_GF(r)) return FieldGF; |
---|
| 27 | if (rField_is_Q(r)) return FieldQ; |
---|
| 28 | #ifdef HAVE_MORE_FIELDS_IMPLEMENTED |
---|
| 29 | if (rField_is_long_R(r)) return FieldLong_R; |
---|
| 30 | if (rField_is_long_C(r)) return FieldLong_C; |
---|
| 31 | if (rField_is_Zp_a(r)) return FieldZp_a; |
---|
| 32 | if (rField_is_Q_a(r)) return FieldQ_a; |
---|
[009d80] | 33 | #endif |
---|
| 34 | #ifdef HAVE_RINGS |
---|
| 35 | if (rField_is_Ring(r)) return RingGeneral; |
---|
[35aab3] | 36 | #endif |
---|
| 37 | return FieldGeneral; |
---|
| 38 | } |
---|
| 39 | |
---|
| 40 | static inline p_Length p_LengthIs(ring r) |
---|
| 41 | { |
---|
| 42 | assume(r->ExpL_Size > 0); |
---|
| 43 | // here is a quick hack to take care of p_MemAddAdjust |
---|
| 44 | if (r->NegWeightL_Offset != NULL) return LengthGeneral; |
---|
| 45 | if (r->ExpL_Size == 1) return LengthOne; |
---|
| 46 | if (r->ExpL_Size == 2) return LengthTwo; |
---|
| 47 | if (r->ExpL_Size == 3) return LengthThree; |
---|
| 48 | if (r->ExpL_Size == 4) return LengthFour; |
---|
| 49 | if (r->ExpL_Size == 5) return LengthFive; |
---|
| 50 | if (r->ExpL_Size == 6) return LengthSix; |
---|
| 51 | if (r->ExpL_Size == 7) return LengthSeven; |
---|
| 52 | if (r->ExpL_Size == 8) return LengthEight; |
---|
| 53 | return LengthGeneral; |
---|
| 54 | } |
---|
| 55 | |
---|
| 56 | static inline int p_IsNomog(long* sgn, int l) |
---|
| 57 | { |
---|
| 58 | int i; |
---|
| 59 | for (i=0;i<l;i++) |
---|
| 60 | if (sgn[i] > 0) return 0; |
---|
| 61 | |
---|
| 62 | return 1; |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | static inline int p_IsPomog(long* sgn, int l) |
---|
| 66 | { |
---|
| 67 | int i; |
---|
| 68 | for (i=0;i<l;i++) |
---|
| 69 | if (sgn[i] < 0) return 0; |
---|
| 70 | return 1; |
---|
| 71 | } |
---|
| 72 | |
---|
| 73 | static inline p_Ord p_OrdIs(ring r) |
---|
| 74 | { |
---|
| 75 | long* sgn = r->ordsgn; |
---|
| 76 | long l = r->ExpL_Size; |
---|
| 77 | int zero = 0; |
---|
| 78 | |
---|
| 79 | if (sgn[l-1] == 0) |
---|
| 80 | { |
---|
| 81 | l--; |
---|
| 82 | zero = 1; |
---|
| 83 | } |
---|
| 84 | |
---|
| 85 | // we always favour the pomog cases |
---|
| 86 | if (p_IsPomog(sgn,l)) return (zero ? OrdPomogZero : OrdPomog); |
---|
| 87 | if (p_IsNomog(sgn,l)) return (zero ? OrdNomogZero : OrdNomog); |
---|
| 88 | |
---|
| 89 | assume(l > 1); |
---|
| 90 | |
---|
| 91 | if (sgn[0] == -1 && p_IsPomog(&sgn[1], l-1)) |
---|
| 92 | return (zero ? OrdNegPomogZero : OrdNegPomog); |
---|
| 93 | if (sgn[l-1] == -1 && p_IsPomog(sgn, l-1)) |
---|
| 94 | return (zero ? OrdPomogNegZero : OrdPomogNeg); |
---|
| 95 | |
---|
| 96 | if (sgn[0] == 1 && p_IsNomog(&sgn[1], l-1)) |
---|
| 97 | return (zero ? OrdPosNomogZero : OrdPosNomog); |
---|
| 98 | if (sgn[l-1] == 1 && p_IsNomog(sgn, l-1)) |
---|
| 99 | return (zero ? OrdNomogPosZero : OrdNomogPos); |
---|
| 100 | |
---|
| 101 | assume(l > 2); |
---|
| 102 | |
---|
| 103 | if (sgn[0] == 1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2)) |
---|
| 104 | return (zero ? OrdPosPosNomogZero : OrdPosPosNomog); |
---|
| 105 | |
---|
| 106 | if (sgn[0] == 1 && sgn[l-1] == 1 && p_IsNomog(&sgn[1], l-2)) |
---|
| 107 | return (zero ? OrdPosNomogPosZero : OrdPosNomogPos); |
---|
| 108 | |
---|
| 109 | if (sgn[0] == -1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2)) |
---|
| 110 | return (zero ? OrdNegPosNomogZero : OrdNegPosNomog); |
---|
| 111 | |
---|
| 112 | return OrdGeneral; |
---|
| 113 | } |
---|
| 114 | |
---|
| 115 | // fields of this struct are set by DoSetProc |
---|
| 116 | static p_Procs_s *_p_procs; |
---|
| 117 | |
---|
| 118 | #ifdef RDEBUG |
---|
| 119 | // if set, then SetProcs sets only names, instead of functions |
---|
| 120 | static int set_names = 0; |
---|
| 121 | #endif |
---|
| 122 | |
---|
[825966] | 123 | // (which##_Proc_Ptr)F ->-> cast_vptr_to_A<which##_Proc_Ptr>(F)? |
---|
[35aab3] | 124 | #define CheckProc(which) \ |
---|
| 125 | do \ |
---|
| 126 | { \ |
---|
| 127 | if (p_Procs->which == NULL) \ |
---|
| 128 | { \ |
---|
| 129 | dReportBug("p_Procs is NULL"); \ |
---|
[dcbad6] | 130 | WarnS("Singular will work properly, but much slower"); \ |
---|
[009d80] | 131 | WarnS("If you chose a coef ring, it may not work at all");\ |
---|
[825966] | 132 | p_Procs->which = (which##_Proc_Ptr)( \ |
---|
| 133 | which##__FieldGeneral_LengthGeneral_OrdGeneral); \ |
---|
[35aab3] | 134 | } \ |
---|
| 135 | } \ |
---|
[7b8cb0] | 136 | while (0); |
---|
[35aab3] | 137 | |
---|
[80ca3c] | 138 | void nc_p_ProcsSet(ring rGR, p_Procs_s* p_Procs); |
---|
| 139 | |
---|
[35aab3] | 140 | // Choose a set of p_Procs |
---|
| 141 | void p_ProcsSet(ring r, p_Procs_s* p_Procs) |
---|
| 142 | { |
---|
| 143 | p_Field field = p_FieldIs(r); |
---|
| 144 | p_Length length = p_LengthIs(r); |
---|
| 145 | p_Ord ord = p_OrdIs(r); |
---|
| 146 | |
---|
| 147 | assume(p_Procs != NULL); |
---|
| 148 | memset(p_Procs, 0, sizeof(p_Procs_s)); |
---|
| 149 | _p_procs = p_Procs; |
---|
| 150 | assume(IsValidSpec(field, length, ord)); |
---|
| 151 | |
---|
[dcbad6] | 152 | SetProcs(field, length, ord); |
---|
[896561] | 153 | extern poly p_Mult_nn_pthread(poly p, const number n, const ring r); |
---|
[90969d] | 154 | #ifdef NV_OPS |
---|
[01c1d0] | 155 | if ((field==FieldZp) && (r->cf->ch>NV_MAX_PRIME)) |
---|
[90969d] | 156 | { |
---|
| 157 | // set all (mult/div.) routines to FieldGeneral-variants |
---|
| 158 | SetProcs(FieldGeneral, length,ord); // p_Mult_nn, ... |
---|
| 159 | // set all non-mult/div. routines to FieldZp-variants |
---|
| 160 | SetProcs_nv(FieldZp, length,ord); // p_Delete, p_ShallowCopyDelete... |
---|
| 161 | } |
---|
[009d80] | 162 | #endif |
---|
[896561] | 163 | #ifdef SI_THREADS |
---|
| 164 | else if (field==FieldQ) p_Procs->p_Mult_nn=p_Mult_nn_pthread; |
---|
| 165 | #endif |
---|
[35aab3] | 166 | CheckProc(p_Copy); |
---|
| 167 | CheckProc(p_Delete); |
---|
| 168 | CheckProc(p_ShallowCopyDelete); |
---|
| 169 | CheckProc(p_Mult_nn); |
---|
| 170 | CheckProc(pp_Mult_nn); |
---|
[a408b76] | 171 | CheckProc(pp_Mult_mm); |
---|
| 172 | CheckProc(p_Mult_mm); |
---|
| 173 | CheckProc(p_Minus_mm_Mult_qq); |
---|
[35aab3] | 174 | CheckProc(pp_Mult_mm_Noether); |
---|
| 175 | CheckProc(p_Add_q); |
---|
| 176 | CheckProc(p_Neg); |
---|
| 177 | CheckProc(pp_Mult_Coeff_mm_DivSelect); |
---|
| 178 | CheckProc(pp_Mult_Coeff_mm_DivSelectMult); |
---|
| 179 | CheckProc(p_Merge_q); |
---|
| 180 | CheckProc(p_kBucketSetLm); |
---|
| 181 | |
---|
| 182 | /* |
---|
| 183 | assume(p_Procs->pp_Mult_mm_Noether != pp_Mult_mm_Noether__FieldGeneral_LengthGeneral_OrdGeneral || |
---|
| 184 | p_Procs->p_Minus_mm_Mult_qq == p_Minus_mm_Mult_qq__FieldGeneral_LengthGeneral_OrdGeneral || |
---|
| 185 | r->OrdSgn == 1 || r->LexOrder); |
---|
| 186 | */ |
---|
[86016d] | 187 | #ifdef HAVE_PLURAL |
---|
[cf315c] | 188 | #ifndef NDEBUG |
---|
[a408b76] | 189 | if (rIsPluralRing(r)) |
---|
[52e2f6] | 190 | { |
---|
[80ca3c] | 191 | dReportError("Setting pProcs in p_ProcsSet (rDebugPrint!?)!!!"); |
---|
| 192 | nc_p_ProcsSet(r, _p_procs); // Setup non-commutative p_Procs table! |
---|
[52e2f6] | 193 | } |
---|
[86016d] | 194 | #endif |
---|
[cf315c] | 195 | #endif |
---|
[35aab3] | 196 | } |
---|
| 197 | |
---|
| 198 | #ifdef RDEBUG |
---|
[85e68dd] | 199 | void p_Debug_GetSpecNames(const ring r, const char* &field, const char* &length, const char* &ord) |
---|
[35aab3] | 200 | { |
---|
| 201 | p_Field e_field = p_FieldIs(r); |
---|
| 202 | p_Length e_length = p_LengthIs(r); |
---|
| 203 | p_Ord e_ord = p_OrdIs(r); |
---|
| 204 | |
---|
| 205 | field = p_FieldEnum_2_String(p_FieldIs(r)); |
---|
| 206 | length = p_LengthEnum_2_String(p_LengthIs(r)); |
---|
| 207 | ord = p_OrdEnum_2_String(p_OrdIs(r)); |
---|
| 208 | } |
---|
| 209 | |
---|
| 210 | void p_Debug_GetProcNames(const ring r, p_Procs_s* p_Procs) |
---|
| 211 | { |
---|
| 212 | set_names = 1; |
---|
[52e2f6] | 213 | p_ProcsSet(r, p_Procs); // changes p_Procs!!! |
---|
[35aab3] | 214 | set_names = 0; |
---|
| 215 | } |
---|
| 216 | #endif // RDEBUG |
---|