source: git/dyn_modules/bigintm/bigintm.cc @ f24733

spielwiese
Last change on this file since f24733 was f24733, checked in by Oleksandr Motsak <motsak@…>, 13 years ago
MV: moved WrongOP to blackbox FIX: dynamic modules must ONLY export 'mod_init'! From: Oleksandr Motsak <motsak@mathematik.uni-kl.de> git-svn-id: file:///usr/local/Singular/svn/trunk@13981 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 7.8 KB
Line 
1#include <Singular/mod2.h>
2
3#include <omalloc/omalloc.h>
4#include <kernel/febase.h>
5#include <kernel/longrat.h>
6
7#include <Singular/ipid.h>
8#include <Singular/subexpr.h>
9#include <Singular/tok.h>
10#include <Singular/blackbox.h>
11#include <Singular/ipshell.h>
12
13#include "bigintm.h"
14
15
16#define HAVE_BIGINTM 1
17
18namespace
19{
20
21#ifdef HAVE_BIGINTM
22static int bigintm_type_id = -1;
23#endif
24
25#ifdef HAVE_BIGINTM
26static char * bigintm_String(blackbox *b, void *d)
27{ if (d==NULL) return omStrDup("oo");
28   else
29   {
30     StringSetS("");
31     number n=(number)d; nlWrite(n,NULL); d=(void*)n;
32     return omStrDup(StringAppendS(""));
33    }
34}
35static void * bigintm_Copy(blackbox*b, void *d)
36{  number n=(number)d; return nlCopy(n); }
37
38static BOOLEAN bigintm_Assign(leftv l, leftv r)
39{
40  assume( l->Typ() == bigintm_type_id );
41 
42  blackbox *ll=getBlackboxStuff(l->Typ());
43 
44  if (r->Typ()>MAX_TOK)
45  {
46    if (bigintm_type_id == r->Typ())
47    {
48      blackbox *rr=getBlackboxStuff(r->Typ());
49     
50      if (l->Data()!=NULL) { number n1=(number)l->Data(); nlDelete(&n1,NULL); }
51      number n2=(number)r->CopyD();
52      if (l->rtyp==IDHDL)
53      {
54        IDDATA((idhdl)l->data)=(char *)n2;
55      }
56      else
57      {
58        l->data=(void *)n2;
59      }
60      return FALSE;
61    }
62    else
63    {
64      Werror("bigintm_Assign: assign %s (%d) = %s (%d)",
65             getBlackboxName(l->Typ()), l->Typ(),
66             getBlackboxName(r->Typ()), r->Typ());
67      return TRUE;
68    }
69  }
70  else if (r->Typ()==INT_CMD)
71  {
72    if (l->Data()!=NULL) { number n1=(number)l->Data(); nlDelete(&n1,NULL); }
73    number n2=nlInit((int)(long)r->Data(),NULL);
74    if (l->rtyp==IDHDL)
75    {
76      IDDATA((idhdl)l->data)=(char *)n2;
77    }
78    else
79    {
80      l->data=(void *)n2;
81    }
82    return FALSE;
83  }
84  else
85    Werror("assign %d = %d",l->Typ(),r->Typ());
86 
87  return TRUE;
88}
89
90BOOLEAN bigintm_Op1(int op,leftv l, leftv r)
91{
92  // interpreter: a1 is ist bigintm
93  assume( r->Typ() == bigintm_type_id );
94/*
95  // "typeof( <blackbox> )" is handled by 'blackboxDefaultOp1'
96  if (op==TYPEOF_CMD)
97  {
98    l->data=omStrDup(getBlackboxName(r->Typ()));
99    l->rtyp=STRING_CMD;
100    return FALSE;
101  }
102*/
103 
104  if( op=='(' ) // <bigintm>  VAR();
105  {
106    Werror("bigintm_Op1: What do you mean by '<bigintm>()'?!");
107    return TRUE; 
108  }
109
110  return blackboxDefaultOp1(op, l, r);
111}
112
113
114static BOOLEAN bigintm_OpM(int op, leftv res, leftv args);
115
116
117static BOOLEAN bigintm_Op2(int op, leftv res, leftv a1, leftv a2)
118{
119  // interpreter: a1 is ist bigintm
120  assume( a1->Typ() == bigintm_type_id );
121 
122  blackbox *a=getBlackboxStuff(a1->Typ());
123  number n1=(number)a1->Data(); 
124  switch(op)
125  {
126    case '+':
127    {
128      if (a2->Typ()==INT_CMD)
129      {
130        number n2=nlInit((int)(long)a2->Data(),NULL);
131        number n=nlAdd(n1,n2);
132        res->data=(void *)n;
133        res->rtyp=a1->Typ();
134        return FALSE;
135      }
136      else if (a2->Typ()==a1->Typ())
137      {
138        number n2=(number)a2->Data(); 
139        number n=nlAdd(n1,n2);
140        res->data=(void *)n;
141        res->rtyp=a1->Typ();
142        return FALSE;
143      }
144
145      Werror("bigintm_Op2: Op: '+': Sorry unsupported 2nd argument-type: %s in", Tok2Cmdname(a2->Typ()));
146      return WrongOp("bigintm_Op2", op, a1);
147    }
148
149    case '-':
150    {
151      if (a2->Typ()==INT_CMD)
152      {
153        number n2=nlInit((int)(long)a2->Data(),NULL);
154        number n=nlSub(n1,n2);
155        res->data=(void *)n;
156        res->rtyp=a1->Typ();
157        return FALSE;
158      }
159      else if (a2->Typ()==a1->Typ())
160      {
161        number n2=(number)a2->Data(); 
162        number n=nlSub(n1,n2);
163        res->data=(void *)n;
164        res->rtyp=a1->Typ();
165        return FALSE;
166      }
167     
168      Werror("bigintm_Op2: Op: '-': Sorry unsupported 2nd argument-type: %s in", Tok2Cmdname(a2->Typ()));
169      WrongOp("bigintm_Op2", op, a1);
170      return TRUE;
171    }
172
173
174    case '*':
175    {
176      if (a2->Typ()==INT_CMD)
177      {
178        number n2=nlInit((int)(long)a2->Data(),NULL);
179        number n=nlMult(n1,n2);
180        res->data=(void *)n;
181        res->rtyp=a1->Typ();
182        return FALSE;
183      }
184      else if (a2->Typ()==a1->Typ())
185      {
186        number n2=(number)a2->Data(); 
187        number n=nlMult(n1,n2);
188        res->data=(void *)n;
189        res->rtyp=a1->Typ();
190        return FALSE;
191      }
192      Werror("bigintm_Op2: Op: '*': Sorry unsupported 2nd argument-type: '%s' in", Tok2Cmdname(a2->Typ()));
193      WrongOp("bigintm_Op2", op, a1);
194      return TRUE;
195    }
196/*
197    /// TODO: Why is this ignored???!
198    case '(' : // <bigintm>  VAR(b);
199    {
200      Werror("bigintm_Op2: What du you mean by '<bigintm>(...%s...)'?!", Tok2Cmdname(a2->Typ()));
201      return TRUE; 
202    }
203*/
204    case EQUAL_EQUAL:
205    {
206      if( a1 == a2)
207      {
208        res->data= (void *) (TRUE);
209        res->rtyp= INT_CMD;
210        return FALSE;
211      } else
212      if (a2->Typ()==INT_CMD)
213      {
214        number n2=nlInit((int)(long)a2->Data(),NULL);
215        res->data=(void *) nlEqual(n1,n2);
216        res->rtyp= INT_CMD;
217        return FALSE;
218      }
219      else if (a2->Typ()==a1->Typ())
220      {
221        number n2=(number)a2->Data(); 
222        res->data=(void *) nlEqual(n1,n2);
223        res->rtyp= INT_CMD;
224        return FALSE;
225      }
226
227      Werror("bigintm_Op2: Op: '==': Sorry unsupported 2nd argument-type: '%d' in", Tok2Cmdname(a2->Typ()));
228      WrongOp("bigintm_Op2", op, a1);
229      return TRUE;
230    }
231
232    case '.':
233    {
234
235      if (a2->name==NULL)
236      {
237        Werror("bigintm_Op2: Op: '.': 2nd argument-type: '%s'(%d) should be a NAME", Tok2Cmdname(a2->Typ()), a2->Typ());     
238        return TRUE;
239      }
240     
241      Werror("bigintm_Op2: Op: '.': 2nd argument-type: '%s'(%d) is called '%s' in ", Tok2Cmdname(a2->Typ()), a2->Typ(), a2->name);     
242      return blackboxDefaultOp2(op,res,a1,a2);
243      return TRUE;
244    }
245
246    default:
247    {
248      WrongOp("bigintm_Op2", op, a1);
249      return blackboxDefaultOp2(op,res,a1,a2);
250      break;
251    }
252  }
253}
254// BOOLEAN opM(int op, leftv res, leftv args)
255static BOOLEAN bigintm_OpM(int op, leftv res, leftv args)
256{
257  // interpreter: args->1. arg is ist bigintm
258  assume( args->Typ() == bigintm_type_id );
259  blackbox *a=getBlackboxStuff(args->Typ());
260  switch(op)
261  {
262    case STRING_CMD:
263    {
264      res->data=(void *)a->blackbox_String(a,args->Data());
265      res->rtyp=STRING_CMD;
266      return FALSE;
267    }
268
269    /// TODO: Why is this used for ALL the cases: even for "a(1)"  ???!
270    case '(' : // <bigintm>  VAR(b,...);
271    {
272      Werror("bigintm_OpM: What do you mean by '<bigintm>(...)'?!");
273      return TRUE; 
274    }
275   
276    default:
277      WrongOp("bigintm_OpM", op, args);
278      break;
279  }
280  return blackbox_default_OpM(op, res, args);
281}
282
283static void bigintm_destroy(blackbox *b, void *d)
284{
285  if (d!=NULL)
286  {
287    number n=(number)d;
288    nlDelete(&n,NULL);
289  }
290}
291
292#endif
293
294};
295
296// this is only a demo
297BOOLEAN bigintm_setup()
298{
299#ifndef HAVE_BIGINTM
300  Werror("bigintm_setup: Sorry BIGINTM was not compiled in!");
301  return TRUE; // ok, TRUE = error!
302#else
303
304  if( bigintm_type_id == -1 )
305  {
306    blackbox *b=(blackbox*)omAlloc0(sizeof(blackbox));
307    // all undefined entries will be set to default in setBlackboxStuff
308    // the default Print is quite usefule,
309    // all other are simply error messages
310    b->blackbox_destroy=bigintm_destroy;
311    b->blackbox_String=bigintm_String;
312    //b->blackbox_Print=blackbox_default_Print;
313    //b->blackbox_Init=blackbox_default_Init;
314    b->blackbox_Copy=bigintm_Copy;
315    b->blackbox_Assign=bigintm_Assign; // TO ASK: no default?!
316    b->blackbox_Op1=bigintm_Op1;
317    b->blackbox_Op2=bigintm_Op2;
318    //b->blackbox_Op3=blackbox_default_Op3;
319    b->blackbox_OpM=bigintm_OpM;
320
321    bigintm_type_id = setBlackboxStuff(b,"bigintm");
322
323    Print("bigintm_setup: created a blackbox type [%d] '%s'",bigintm_type_id, getBlackboxName(bigintm_type_id));
324    PrintLn();
325
326    return FALSE; // ok, TRUE = error!
327  } else
328  {
329    Werror("bigintm_setup: Sorry should NOT be run twice!");
330    return TRUE; // ok, TRUE = error!
331  }
332
333#endif
334}
335
336
337
Note: See TracBrowser for help on using the repository browser.