source: git/libpolys/polys/templates/p_Procs_Set.h @ f17318

spielwiese
Last change on this file since f17318 was f17318, checked in by Hans Schoenemann <hannes@…>, 11 years ago
chg: removed SI_THREADS (unsed code)
  • Property mode set to 100644
File size: 6.3 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
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
20static 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
39static 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
55static 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
64static 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
72static 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
115static p_Procs_s *_p_procs;
116
117#ifdef RDEBUG
118// if set, then SetProcs sets only names, instead of functions
119static 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)                                    \
124do                                                          \
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]135while (0);
[35aab3]136
[80ca3c]137void nc_p_ProcsSet(ring rGR, p_Procs_s* p_Procs);
138
[35aab3]139// Choose a set of p_Procs
140void 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
[35aab3]162  CheckProc(p_Copy);
163  CheckProc(p_Delete);
164  CheckProc(p_ShallowCopyDelete);
165  CheckProc(p_Mult_nn);
166  CheckProc(pp_Mult_nn);
[a408b76]167  CheckProc(pp_Mult_mm);
168  CheckProc(p_Mult_mm);
169  CheckProc(p_Minus_mm_Mult_qq);
[35aab3]170  CheckProc(pp_Mult_mm_Noether);
171  CheckProc(p_Add_q);
172  CheckProc(p_Neg);
173  CheckProc(pp_Mult_Coeff_mm_DivSelect);
174  CheckProc(pp_Mult_Coeff_mm_DivSelectMult);
175  CheckProc(p_Merge_q);
176  CheckProc(p_kBucketSetLm);
177
178/*
179  assume(p_Procs->pp_Mult_mm_Noether != pp_Mult_mm_Noether__FieldGeneral_LengthGeneral_OrdGeneral ||
180         p_Procs->p_Minus_mm_Mult_qq == p_Minus_mm_Mult_qq__FieldGeneral_LengthGeneral_OrdGeneral ||
181         r->OrdSgn == 1 || r->LexOrder);
182*/
[86016d]183#ifdef HAVE_PLURAL
[cf315c]184#ifndef NDEBUG
[a408b76]185  if (rIsPluralRing(r))
[52e2f6]186  {
[80ca3c]187    dReportError("Setting pProcs in p_ProcsSet (rDebugPrint!?)!!!");
188    nc_p_ProcsSet(r, _p_procs); // Setup non-commutative p_Procs table!
[52e2f6]189  }
[86016d]190#endif
[cf315c]191#endif
[35aab3]192}
193
194#ifdef RDEBUG
[85e68dd]195void p_Debug_GetSpecNames(const ring r, const char* &field, const char* &length, const char* &ord)
[35aab3]196{
[6909cfb]197  /*p_Field     e_field =*/ (void) p_FieldIs(r);
198  /*p_Length    e_length =*/ (void) p_LengthIs(r);
199  /*p_Ord       e_ord =*/ (void) p_OrdIs(r);
[35aab3]200
201  field  = p_FieldEnum_2_String(p_FieldIs(r));
202  length = p_LengthEnum_2_String(p_LengthIs(r));
203  ord    = p_OrdEnum_2_String(p_OrdIs(r));
204}
205
206void p_Debug_GetProcNames(const ring r, p_Procs_s* p_Procs)
207{
208  set_names = 1;
[52e2f6]209  p_ProcsSet(r, p_Procs); // changes p_Procs!!!
[35aab3]210  set_names = 0;
211}
212#endif // RDEBUG
Note: See TracBrowser for help on using the repository browser.