source: git/libpolys/polys/templates/p_Procs_Set.h @ 80ca3c

spielwiese
Last change on this file since 80ca3c was 80ca3c, checked in by Oleksandr Motsak <motsak@…>, 12 years ago
NC-subsystem preparations fix: gnc_GB properly add: gb_hack.h to help handling the circular dependency (GB&NC) chg: moved stuff around and misc changes
  • Property mode set to 100644
File size: 6.4 KB
RevLine 
[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
21static 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
40static 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
56static 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
65static 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
73static 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
116static p_Procs_s *_p_procs;
117
118#ifdef RDEBUG
119// if set, then SetProcs sets only names, instead of functions
120static 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)                                    \
125do                                                          \
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]136while (0);
[35aab3]137
[80ca3c]138void nc_p_ProcsSet(ring rGR, p_Procs_s* p_Procs);
139
[35aab3]140// Choose a set of p_Procs
141void 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]199void 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
210void 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
Note: See TracBrowser for help on using the repository browser.