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