source: git/libpolys/polys/templates/p_Procs_Set.h @ 014b65

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