source: git/kernel/p_Procs_Set.h @ 8c5988

spielwiese
Last change on this file since 8c5988 was 35aab3, checked in by Hans Schönemann <hannes@…>, 20 years ago
This commit was generated by cvs2svn to compensate for changes in r6879, which included commits to RCS files with non-trunk default branches. git-svn-id: file:///usr/local/Singular/svn/trunk@6880 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 5.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/***************************************************************
5 *  File:    p_ProcsSet.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: p_Procs_Set.h,v 1.1.1.1 2003-10-06 12:16:00 Singular Exp $
15 *******************************************************************/
16
17// extract p_Procs properties from a ring
18static inline p_Field p_FieldIs(ring r)
19{
20  if (rField_is_Zp(r))
21#ifdef NV_OPS
22  {
23    if (r->ch<=NV_MAX_PRIME) return FieldZp;
24    else                     return FieldGeneral;
25  }
26#else
27    return FieldZp;
28#endif
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  return FieldGeneral;
39}
40
41static inline p_Length p_LengthIs(ring r)
42{
43  assume(r->ExpL_Size > 0);
44  // here is a quick hack to take care of p_MemAddAdjust
45  if (r->NegWeightL_Offset != NULL) return LengthGeneral;
46  if (r->ExpL_Size == 1) return LengthOne;
47  if (r->ExpL_Size == 2) return LengthTwo;
48  if (r->ExpL_Size == 3) return LengthThree;
49  if (r->ExpL_Size == 4) return LengthFour;
50  if (r->ExpL_Size == 5) return LengthFive;
51  if (r->ExpL_Size == 6) return LengthSix;
52  if (r->ExpL_Size == 7) return LengthSeven;
53  if (r->ExpL_Size == 8) return LengthEight;
54  return LengthGeneral;
55}
56
57static inline int p_IsNomog(long* sgn, int l)
58{
59  int i;
60  for (i=0;i<l;i++)
61    if (sgn[i] > 0) return 0;
62
63  return 1;
64}
65
66static inline int p_IsPomog(long* sgn, int l)
67{
68  int i;
69  for (i=0;i<l;i++)
70    if (sgn[i] < 0) return 0;
71  return 1;
72}
73
74static inline p_Ord p_OrdIs(ring r)
75{
76  long* sgn = r->ordsgn;
77  long l = r->ExpL_Size;
78  int zero = 0;
79
80  if (sgn[l-1] == 0)
81  {
82    l--;
83    zero = 1;
84  }
85
86  // we always favour the pomog cases
87  if (p_IsPomog(sgn,l)) return (zero ? OrdPomogZero : OrdPomog);
88  if (p_IsNomog(sgn,l)) return (zero ? OrdNomogZero : OrdNomog);
89
90  assume(l > 1);
91
92  if (sgn[0] == -1 && p_IsPomog(&sgn[1], l-1))
93    return (zero ? OrdNegPomogZero : OrdNegPomog);
94  if (sgn[l-1] == -1 && p_IsPomog(sgn, l-1))
95    return (zero ? OrdPomogNegZero : OrdPomogNeg);
96
97  if (sgn[0] == 1 && p_IsNomog(&sgn[1], l-1))
98    return (zero ? OrdPosNomogZero : OrdPosNomog);
99  if (sgn[l-1] == 1 && p_IsNomog(sgn, l-1))
100    return (zero ? OrdNomogPosZero : OrdNomogPos);
101
102  assume(l > 2);
103
104  if (sgn[0] == 1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2))
105    return (zero ? OrdPosPosNomogZero : OrdPosPosNomog);
106
107  if (sgn[0] == 1 && sgn[l-1] == 1 && p_IsNomog(&sgn[1], l-2))
108    return (zero ? OrdPosNomogPosZero : OrdPosNomogPos);
109
110  if (sgn[0] == -1 && sgn[1] == 1 && p_IsNomog(&sgn[2], l-2))
111    return (zero ? OrdNegPosNomogZero : OrdNegPosNomog);
112
113  return OrdGeneral;
114}
115
116// fields of this struct are set by DoSetProc
117static p_Procs_s *_p_procs;
118
119#ifdef RDEBUG
120// if set, then SetProcs sets only names, instead of functions
121static int set_names = 0;
122#endif
123
124#define CheckProc(which)                                    \
125do                                                          \
126{                                                           \
127  if (p_Procs->which == NULL)                               \
128  {                                                         \
129    dReportBug("p_Procs is NULL");                          \
130    Warn("Singular will work properly, but much slower");   \
131    p_Procs->which = (which##_Proc_Ptr)                     \
132      which##__FieldGeneral_LengthGeneral_OrdGeneral;       \
133  }                                                         \
134}                                                           \
135while (0)
136
137// Choose a set of p_Procs
138void p_ProcsSet(ring r, p_Procs_s* p_Procs)
139{
140  p_Field     field = p_FieldIs(r);
141  p_Length    length = p_LengthIs(r);
142  p_Ord       ord = p_OrdIs(r);
143
144  assume(p_Procs != NULL);
145//#ifdef RDEBUG
146  memset(p_Procs, 0, sizeof(p_Procs_s));
147//#endif
148  _p_procs = p_Procs;
149  assume(IsValidSpec(field, length, ord));
150
151  InitSetProcs(field, length, ord);
152  SetProcs(field, length, ord);
153  CheckProc(p_Copy);
154  CheckProc(p_Delete);
155  CheckProc(p_ShallowCopyDelete);
156  CheckProc(p_Mult_nn);
157  CheckProc(pp_Mult_nn);
158  CheckProc(pp_Mult_mm);
159  CheckProc(pp_Mult_mm_Noether);
160  CheckProc(p_Mult_mm);
161  CheckProc(p_Add_q);
162  CheckProc(p_Minus_mm_Mult_qq);
163  CheckProc(p_Neg);
164  CheckProc(pp_Mult_Coeff_mm_DivSelect);
165  CheckProc(pp_Mult_Coeff_mm_DivSelectMult);
166  CheckProc(p_Merge_q);
167  CheckProc(p_kBucketSetLm);
168
169/*
170  assume(p_Procs->pp_Mult_mm_Noether != pp_Mult_mm_Noether__FieldGeneral_LengthGeneral_OrdGeneral ||
171         p_Procs->p_Minus_mm_Mult_qq == p_Minus_mm_Mult_qq__FieldGeneral_LengthGeneral_OrdGeneral ||
172         r->OrdSgn == 1 || r->LexOrder);
173*/
174}
175
176#ifdef RDEBUG
177void p_Debug_GetSpecNames(const ring r, char* &field, char* &length, char* &ord)
178{
179  p_Field     e_field = p_FieldIs(r);
180  p_Length    e_length = p_LengthIs(r);
181  p_Ord       e_ord = p_OrdIs(r);
182
183  field  = p_FieldEnum_2_String(p_FieldIs(r));
184  length = p_LengthEnum_2_String(p_LengthIs(r));
185  ord    = p_OrdEnum_2_String(p_OrdIs(r));
186}
187
188void p_Debug_GetProcNames(const ring r, p_Procs_s* p_Procs)
189{
190  set_names = 1;
191  p_ProcsSet(r, p_Procs);
192  set_names = 0;
193}
194#endif // RDEBUG
Note: See TracBrowser for help on using the repository browser.