source: git/kernel/p_Procs_Set.h @ e6ea3d

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