[f6b5f0] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
[6a0839] | 4 | /* $Id: mpsr_GetMisc.cc,v 1.6 1997-05-06 11:00:48 obachman Exp $ */ |
---|
[f6b5f0] | 5 | |
---|
[0e1846] | 6 | /*************************************************************** |
---|
| 7 | * |
---|
| 8 | * File: mpsr_GetMisc.cc |
---|
| 9 | * Purpose: Miscellanous routines which are needed by mpsr_Get |
---|
| 10 | * Author: Olaf Bachmann (10/95) |
---|
| 11 | * |
---|
| 12 | * Change History (most recent first): |
---|
| 13 | * |
---|
| 14 | ***************************************************************/ |
---|
| 15 | |
---|
| 16 | #include "mod2.h" |
---|
| 17 | |
---|
| 18 | #ifdef HAVE_MPSR |
---|
| 19 | |
---|
| 20 | #include"mpsr_Get.h" |
---|
| 21 | #include "ring.h" |
---|
| 22 | #include "longalg.h" |
---|
| 23 | #include "tok.h" |
---|
| 24 | #include "maps.h" |
---|
| 25 | #include "lists.h" |
---|
| 26 | |
---|
| 27 | BOOLEAN currComplete = FALSE; |
---|
| 28 | |
---|
| 29 | static ring rDefault(short ch, char *name); |
---|
| 30 | static char* GenerateRingName(); |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | // use the varname so that they are compatible with the ones generated |
---|
| 34 | // by GetRingAnnots |
---|
| 35 | #define MPSR_DEFAULT_VARNAME "x(1)" |
---|
| 36 | |
---|
| 37 | // returns some default ring |
---|
| 38 | int mpsr_rDefault(short ch, char *name, ring &r) |
---|
| 39 | { |
---|
| 40 | // check for currRing |
---|
| 41 | if (currRing != NULL && currRing->ch == ch) |
---|
| 42 | { |
---|
| 43 | int i, n = currRing->N; |
---|
| 44 | char **names = currRing->names; |
---|
| 45 | |
---|
| 46 | for (i=0; i<n; i++) |
---|
| 47 | { |
---|
| 48 | if (strcmp(names[i], name) == 0) |
---|
| 49 | { |
---|
| 50 | (currRing->ref)++; |
---|
| 51 | r = currRing; |
---|
| 52 | return i; |
---|
| 53 | } |
---|
| 54 | } |
---|
| 55 | } |
---|
| 56 | r = rDefault(ch, name); |
---|
| 57 | return 0; |
---|
| 58 | } |
---|
| 59 | |
---|
| 60 | ring mpsr_rDefault(short ch) |
---|
| 61 | { |
---|
| 62 | if (currRing != NULL && currRing->ch == ch) |
---|
| 63 | { |
---|
| 64 | (currRing->ref)++; |
---|
| 65 | return currRing; |
---|
| 66 | } |
---|
| 67 | else |
---|
| 68 | return rDefault(ch, MPSR_DEFAULT_VARNAME); |
---|
| 69 | } |
---|
| 70 | |
---|
| 71 | static ring rDefault(short ch, char *name) |
---|
| 72 | { |
---|
| 73 | ring r = (ring) Alloc0(sizeof(sip_sring)); |
---|
| 74 | r->ch = ch; |
---|
| 75 | r->N = 1; |
---|
| 76 | r->names = (char **) Alloc(sizeof(char *)); |
---|
| 77 | r->names[0] = mstrdup(name); |
---|
| 78 | |
---|
| 79 | r->wvhdl = (short **)Alloc0(3 * sizeof(short *)); |
---|
| 80 | /*order: dp,C,0*/ |
---|
| 81 | r->order = (int *) Alloc(3 * sizeof(int *)); |
---|
| 82 | r->block0 = (int *)Alloc(3 * sizeof(int *)); |
---|
| 83 | r->block1 = (int *)Alloc(3 * sizeof(int *)); |
---|
| 84 | /* ringorder dp for the first block: var 1..3 */ |
---|
| 85 | r->order[0] = ringorder_unspec; |
---|
| 86 | r->block0[0] = 1; |
---|
| 87 | r->block1[0] = 1; |
---|
| 88 | /* ringorder C for the second block: no vars */ |
---|
| 89 | r->order[1] = ringorder_C; |
---|
| 90 | r->block0[1] = 0; |
---|
| 91 | r->block1[1] = 0; |
---|
| 92 | /* the last block: everything is 0 */ |
---|
| 93 | r->order[2] = 0; |
---|
| 94 | r->block0[2] = 0; |
---|
| 95 | r->block1[2] = 0; |
---|
| 96 | |
---|
| 97 | return r; |
---|
| 98 | } |
---|
| 99 | |
---|
| 100 | // returns TRUE, if r1 equals r2 |
---|
| 101 | // FALSE, otherwise |
---|
| 102 | // Equality is determined componentwise |
---|
| 103 | BOOLEAN mpsr_RingEqual(ring r1, ring r2) |
---|
| 104 | { |
---|
| 105 | int i, j; |
---|
| 106 | |
---|
| 107 | if (r1 == r2) return 1; |
---|
| 108 | |
---|
| 109 | if (r1 == NULL || r2 == NULL) return 0; |
---|
| 110 | |
---|
| 111 | if ((r1->ch != r2->ch) || (r1->N != r2->N) || (r1->OrdSgn != r2->OrdSgn) |
---|
| 112 | || (r1->P != r2->P)) |
---|
| 113 | return 0; |
---|
| 114 | |
---|
| 115 | for (i=0; i<r1->N; i++) |
---|
| 116 | if (strcmp(r1->names[i], r2->names[i])) return 0; |
---|
| 117 | |
---|
| 118 | i=0; |
---|
| 119 | while (r1->order[i] != 0) |
---|
| 120 | { |
---|
| 121 | if (r2->order[i] == 0) return 0; |
---|
| 122 | if ((r1->order[i] != r2->order[i]) || |
---|
| 123 | (r1->block0[i] != r2->block0[i]) || (r2->block0[i] != r1->block0[i])) |
---|
| 124 | return 0; |
---|
| 125 | if (r1->wvhdl[i] != NULL) |
---|
| 126 | { |
---|
| 127 | if (r2->wvhdl[i] == NULL) |
---|
| 128 | return 0; |
---|
| 129 | for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++) |
---|
| 130 | if (r2->wvhdl[i][j] != r1->wvhdl[i][j]) |
---|
| 131 | return 0; |
---|
| 132 | } |
---|
| 133 | else if (r2->wvhdl[i] != NULL) return 0; |
---|
| 134 | i++; |
---|
| 135 | } |
---|
| 136 | |
---|
| 137 | for (i=0; i<rPar(r1);i++) |
---|
| 138 | { |
---|
| 139 | if (strcmp(r1->parameter[i], r2->parameter[i])!=0) |
---|
| 140 | return 0; |
---|
| 141 | } |
---|
| 142 | |
---|
| 143 | if (r1->minpoly != NULL) |
---|
| 144 | { |
---|
| 145 | if (r2->minpoly == NULL) return 0; |
---|
| 146 | mpsr_SetCurrRing(r1, FALSE); |
---|
| 147 | if (! naEqual(r1->minpoly, r2->minpoly)) return 0; |
---|
| 148 | } |
---|
| 149 | else if (r2->minpoly != NULL) return 0; |
---|
| 150 | |
---|
| 151 | if (r1->qideal != NULL) |
---|
| 152 | { |
---|
| 153 | ideal id1 = r1->qideal, id2 = r2->qideal; |
---|
| 154 | int i, n; |
---|
| 155 | poly *m1, *m2; |
---|
| 156 | |
---|
| 157 | if (id2 == NULL) return 0; |
---|
| 158 | if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0; |
---|
| 159 | |
---|
| 160 | mpsr_SetCurrRing(r1, FALSE); |
---|
| 161 | m1 = id1->m; |
---|
| 162 | m2 = id2->m; |
---|
| 163 | for (i=0; i<n; i++) |
---|
| 164 | if (! pEqualPolys(m1[i],m2[i])) return 0; |
---|
| 165 | } |
---|
| 166 | else if (r2->qideal != NULL) return 0; |
---|
| 167 | |
---|
| 168 | return 1; |
---|
| 169 | } |
---|
[ad42cac] | 170 | |
---|
[0e1846] | 171 | |
---|
| 172 | // returns TRUE, if r1 less or equals r2 |
---|
| 173 | // FALSE, otherwise |
---|
| 174 | // Less or equal means that r1 is a strong subring of r2 |
---|
| 175 | inline BOOLEAN RingLessEqual(ring r1, ring r2) |
---|
| 176 | { |
---|
| 177 | int i, j; |
---|
| 178 | |
---|
| 179 | if (r1 == r2) return 1; |
---|
| 180 | |
---|
| 181 | if (r1 == NULL) return 1; |
---|
| 182 | |
---|
[ad42cac] | 183 | if (r2 == NULL) return 0; |
---|
| 184 | |
---|
[0e1846] | 185 | if ((r1->N > r2->N) || (r1->OrdSgn != r2->OrdSgn) || (r1->P > r2->P)) |
---|
| 186 | return 0; |
---|
| 187 | |
---|
| 188 | if (r1->ch != 0 && r1->ch != r2->ch) return 0; |
---|
| 189 | |
---|
| 190 | for (i=0, j=0; j<r1->N && i<r2->N; i++) |
---|
| 191 | if (strcmp(r1->names[j], r2->names[i]) == 0) j++; |
---|
| 192 | if (j < r1->N) return 0; |
---|
| 193 | |
---|
| 194 | // for ordering, suppose that they are only simple orderings |
---|
| 195 | if (r1->order[2] != 0 || r2->order[2] != 0 || |
---|
| 196 | (r1->order[0] != r2->order[0] && r1->order[0] != ringorder_unspec) || |
---|
| 197 | r1->order[1] != r2->order[1]) |
---|
| 198 | return 0; |
---|
| 199 | |
---|
| 200 | for (i=0; i<r1->P;i++) |
---|
| 201 | { |
---|
| 202 | if (strcmp(r1->parameter[i], r2->parameter[i])!=0) |
---|
| 203 | return 0; |
---|
| 204 | } |
---|
| 205 | // r1->parameter == NULL && r2->parameter != NULL is ok |
---|
| 206 | |
---|
| 207 | if (r1->minpoly != NULL) |
---|
| 208 | { |
---|
| 209 | if (r2->minpoly == NULL) return 0; |
---|
| 210 | mpsr_SetCurrRing(r1, FALSE); |
---|
| 211 | if (! naEqual(r1->minpoly, r2->minpoly)) return 0; |
---|
| 212 | } |
---|
| 213 | return 1; |
---|
| 214 | } |
---|
| 215 | |
---|
| 216 | // returns MP_Success and lv2 appended to lv1, both over the same ring, |
---|
| 217 | // or MP_Failure |
---|
| 218 | mpsr_Status_t mpsr_MergeLeftv(mpsr_leftv mlv1, mpsr_leftv mlv2) |
---|
| 219 | { |
---|
| 220 | ring r, r1 = mlv1->r, r2 = mlv2->r; |
---|
| 221 | leftv lv; |
---|
| 222 | |
---|
| 223 | if (mpsr_RingEqual(r1,r2)) |
---|
| 224 | { |
---|
| 225 | if (r2 != NULL) rKill(r2); |
---|
| 226 | r = r1; |
---|
| 227 | } |
---|
| 228 | else if (RingLessEqual(r1, r2)) |
---|
| 229 | { |
---|
| 230 | r = r2; |
---|
| 231 | if (r1 != NULL) |
---|
| 232 | { |
---|
| 233 | mpsr_MapLeftv(mlv1->lv, r1, r); |
---|
| 234 | rKill(r1); |
---|
| 235 | } |
---|
| 236 | } |
---|
[ad42cac] | 237 | else if (RingLessEqual(r2, r1)) |
---|
| 238 | { |
---|
| 239 | r = r1; |
---|
| 240 | if (r2 != NULL) |
---|
| 241 | { |
---|
| 242 | mpsr_MapLeftv(mlv2->lv, r2, r); |
---|
| 243 | rKill(r2); |
---|
| 244 | } |
---|
| 245 | } |
---|
[0e1846] | 246 | else if (rSum(r1, r2, r) >= 0) |
---|
| 247 | { |
---|
| 248 | mpsr_MapLeftv(mlv1->lv, r1, r); |
---|
| 249 | mpsr_MapLeftv(mlv2->lv, r2, r); |
---|
| 250 | rKill(r1); |
---|
| 251 | rKill(r2); |
---|
| 252 | } |
---|
| 253 | else return mpsr_Failure; |
---|
| 254 | |
---|
| 255 | lv = mlv1->lv; |
---|
| 256 | while (lv->next != NULL) lv = lv->next; |
---|
| 257 | |
---|
| 258 | lv->next = mlv2->lv; |
---|
| 259 | mlv1->r = r; |
---|
| 260 | |
---|
| 261 | // this is an optimization for the mpsr_rDefault routines |
---|
| 262 | currRing = r; |
---|
| 263 | return mpsr_Success; |
---|
| 264 | } |
---|
| 265 | |
---|
| 266 | void mpsr_MapLeftv(leftv l, ring from_ring, ring to_ring) |
---|
| 267 | { |
---|
| 268 | int i, n; |
---|
| 269 | |
---|
| 270 | while (l != NULL) |
---|
| 271 | { |
---|
| 272 | short typ = l->Typ(); |
---|
| 273 | |
---|
| 274 | switch(typ) |
---|
| 275 | { |
---|
| 276 | case POLY_CMD: |
---|
| 277 | case VECTOR_CMD: |
---|
| 278 | { |
---|
| 279 | poly p = (poly) l->data; |
---|
| 280 | mpsr_SetCurrRing(to_ring, TRUE); |
---|
| 281 | l->data = (void *) maIMap(from_ring, (poly) l->data); |
---|
| 282 | ppDelete(&p, from_ring); |
---|
| 283 | break; |
---|
| 284 | } |
---|
| 285 | |
---|
| 286 | case MODUL_CMD: |
---|
| 287 | case IDEAL_CMD: |
---|
| 288 | case MATRIX_CMD: |
---|
| 289 | case MAP_CMD: |
---|
| 290 | { |
---|
| 291 | ideal id = (ideal) l->Data(); |
---|
| 292 | n = IDELEMS(id); |
---|
| 293 | poly *m = id->m, *m1 = (poly *) Alloc(n*sizeof(poly)); |
---|
| 294 | mpsr_SetCurrRing(to_ring, TRUE); |
---|
| 295 | for (i=0; i<n; i++) |
---|
| 296 | { |
---|
| 297 | m1[i] = m[i]; |
---|
| 298 | m[i] = maIMap(from_ring, m[i]); |
---|
| 299 | } |
---|
| 300 | mpsr_SetCurrRing(from_ring, FALSE); |
---|
| 301 | for (i=0; i<n; i++) pDelete(&(m1[i])); |
---|
| 302 | Free(m1, n*sizeof(poly)); |
---|
| 303 | break; |
---|
| 304 | } |
---|
| 305 | |
---|
| 306 | case LIST_CMD: |
---|
| 307 | { |
---|
| 308 | lists ll = (lists) l->Data(); |
---|
| 309 | n = ll->nr + 1; |
---|
| 310 | for (i=0; i<n; i++) mpsr_MapLeftv(&(ll->m[i]), from_ring, to_ring); |
---|
| 311 | break; |
---|
| 312 | } |
---|
| 313 | |
---|
| 314 | case COMMAND: |
---|
| 315 | { |
---|
| 316 | command cmd = (command) l->Data(); |
---|
| 317 | if (cmd->op == PROC_CMD && cmd->argc == 2) |
---|
| 318 | mpsr_MapLeftv(&(cmd->arg2), from_ring, to_ring); |
---|
| 319 | else if (cmd->argc > 0) |
---|
| 320 | { |
---|
| 321 | mpsr_MapLeftv(&(cmd->arg1), from_ring, to_ring); |
---|
| 322 | if (cmd->argc > 1) |
---|
| 323 | { |
---|
| 324 | mpsr_MapLeftv(&(cmd->arg2), from_ring, to_ring); |
---|
| 325 | if (cmd->argc > 2) |
---|
| 326 | mpsr_MapLeftv(&(cmd->arg3), from_ring, to_ring); |
---|
| 327 | } |
---|
| 328 | } |
---|
| 329 | break; |
---|
| 330 | } |
---|
| 331 | |
---|
| 332 | case NUMBER_CMD: |
---|
| 333 | { |
---|
| 334 | number nn = (number) l->data; |
---|
| 335 | mpsr_SetCurrRing(to_ring, TRUE); |
---|
| 336 | nSetMap(from_ring->ch, from_ring->parameter, from_ring->P, from_ring->minpoly); |
---|
| 337 | l->data = (void *) nMap(nn); |
---|
| 338 | mpsr_SetCurrRing(from_ring, FALSE); |
---|
| 339 | nDelete(&nn); |
---|
| 340 | } |
---|
| 341 | } |
---|
| 342 | l = l->next; |
---|
| 343 | } |
---|
| 344 | } |
---|
| 345 | |
---|
| 346 | |
---|
| 347 | // searches for a ring handle which has a ring which is equal to r |
---|
| 348 | // if one is found, then this one is set to the new global ring |
---|
| 349 | // otherwise, a ring name is generated, and a new idhdl is created |
---|
| 350 | void mpsr_SetCurrRingHdl(ring r) |
---|
| 351 | { |
---|
| 352 | idhdl h = idroot, rh = NULL; |
---|
| 353 | |
---|
| 354 | if (r == NULL) |
---|
| 355 | { |
---|
| 356 | if (currRingHdl != NULL && currRing != IDRING(currRingHdl)) |
---|
| 357 | mpsr_SetCurrRing(IDRING(currRingHdl), TRUE); |
---|
| 358 | return; |
---|
| 359 | } |
---|
| 360 | |
---|
| 361 | // try to find an idhdl which is an equal ring |
---|
| 362 | while (h != NULL) |
---|
| 363 | { |
---|
| 364 | if ((IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) && |
---|
| 365 | (mpsr_RingEqual(IDRING(h), r))) |
---|
| 366 | { |
---|
| 367 | // found one |
---|
| 368 | rh = h; |
---|
| 369 | break; |
---|
| 370 | } |
---|
| 371 | h = h->next; |
---|
| 372 | } |
---|
| 373 | |
---|
| 374 | if (rh != NULL) |
---|
| 375 | { |
---|
| 376 | // found an idhdl to an equal ring |
---|
| 377 | // we better reset currRing, so that rSetHdl does not choke (see |
---|
| 378 | // sLastPrinted) |
---|
| 379 | if (currRingHdl != NULL && IDRING(currRingHdl) != currRing) |
---|
| 380 | mpsr_SetCurrRing(IDRING(currRingHdl), TRUE); |
---|
| 381 | |
---|
| 382 | rSetHdl(rh, TRUE); |
---|
| 383 | |
---|
| 384 | if (currRing != r) |
---|
| 385 | { |
---|
| 386 | mpsr_assume(r->ref <= 0); |
---|
| 387 | rKill(r); |
---|
| 388 | } |
---|
| 389 | } |
---|
| 390 | else |
---|
| 391 | { |
---|
| 392 | rh = mpsr_InitIdhdl((r->qideal == NULL ? (short) RING_CMD |
---|
| 393 | : (short) QRING_CMD), |
---|
| 394 | (void *) r, GenerateRingName()); |
---|
| 395 | // reset currRing for reasons explained above |
---|
| 396 | if (currRingHdl != NULL) mpsr_SetCurrRing(IDRING(currRingHdl), TRUE); |
---|
| 397 | rSetHdl(rh, TRUE); |
---|
| 398 | rh->next = idroot; |
---|
| 399 | idroot = rh; |
---|
| 400 | r->ref = 0; |
---|
| 401 | } |
---|
| 402 | } |
---|
| 403 | |
---|
| 404 | |
---|
| 405 | int gringcounter = 0; |
---|
| 406 | char grname[14]; |
---|
| 407 | |
---|
| 408 | static char* GenerateRingName() |
---|
| 409 | { |
---|
| 410 | sprintf(grname, "mpsr_r%d", gringcounter++); |
---|
| 411 | return grname; |
---|
| 412 | } |
---|
| 413 | |
---|
| 414 | // searches through the Singular namespace for a matching name: |
---|
| 415 | // the first found is returned together witht the respective ring |
---|
| 416 | idhdl mpsr_FindIdhdl(char *name, ring &r) |
---|
| 417 | { |
---|
[6a0839] | 418 | idhdl h = (idroot != NULL ? idroot->get(name, 0): (idhdl) NULL), h2; |
---|
[0e1846] | 419 | r = NULL; |
---|
| 420 | |
---|
| 421 | if (h != NULL) |
---|
| 422 | { |
---|
| 423 | r = NULL; |
---|
| 424 | return h; |
---|
| 425 | } |
---|
| 426 | |
---|
| 427 | h = idroot; |
---|
| 428 | while ( h != NULL) |
---|
| 429 | { |
---|
| 430 | if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) |
---|
| 431 | { |
---|
[6a0839] | 432 | h2 = (IDRING(h)->idroot!=NULL ?IDRING(h)->idroot->get(name, 0) : |
---|
| 433 | (idhdl) NULL); |
---|
[2a2c07] | 434 | |
---|
[0e1846] | 435 | if (h2 != NULL) |
---|
| 436 | { |
---|
| 437 | r = IDRING(h); |
---|
| 438 | r->ref++; |
---|
| 439 | return h2; |
---|
| 440 | } |
---|
| 441 | } |
---|
| 442 | h = h->next; |
---|
| 443 | } |
---|
| 444 | return NULL; |
---|
| 445 | } |
---|
| 446 | |
---|
| 447 | |
---|
| 448 | /*************************************************************** |
---|
| 449 | * |
---|
| 450 | * Stuff which deals with External Data |
---|
| 451 | * |
---|
| 452 | ***************************************************************/ |
---|
| 453 | |
---|
| 454 | void mpsr_DeleteExternalData(MPT_ExternalData_t edata) |
---|
| 455 | { |
---|
| 456 | mpsr_leftv mlv = (mpsr_leftv) edata; |
---|
| 457 | |
---|
| 458 | if (edata != NULL) |
---|
| 459 | { |
---|
| 460 | if (mlv->r != NULL) mpsr_SetCurrRing(mlv->r, FALSE); |
---|
| 461 | if (mlv->lv != NULL) |
---|
| 462 | { |
---|
| 463 | mlv->lv->CleanUp(); |
---|
| 464 | Free(mlv->lv, sizeof(sleftv)); |
---|
| 465 | } |
---|
| 466 | if (mlv->r != NULL) rKill(mlv->r); |
---|
| 467 | } |
---|
| 468 | Free(mlv, sizeof(mpsr_sleftv)); |
---|
| 469 | } |
---|
| 470 | |
---|
| 471 | void mpsr_CopyExternalData(MPT_ExternalData_t *dest, |
---|
| 472 | MPT_ExternalData_t src) |
---|
| 473 | { |
---|
| 474 | mpsr_leftv slv = (mpsr_leftv) src, dlv; |
---|
| 475 | |
---|
| 476 | if (slv != NULL) |
---|
| 477 | { |
---|
| 478 | dlv = (mpsr_leftv) Alloc0(sizeof(mpsr_sleftv)); |
---|
| 479 | dlv->r = rCopy(slv->r); |
---|
| 480 | dlv->lv = (leftv) Alloc0(sizeof(sleftv)); |
---|
| 481 | if (slv->lv != NULL) dlv->lv->Copy(slv->lv); |
---|
| 482 | else dlv->lv = NULL; |
---|
| 483 | |
---|
| 484 | *dest = (MPT_ExternalData_t) dlv; |
---|
| 485 | } |
---|
| 486 | else |
---|
| 487 | *dest = NULL; |
---|
| 488 | } |
---|
| 489 | |
---|
| 490 | /*************************************************************** |
---|
| 491 | * |
---|
| 492 | * mpsr initialization |
---|
| 493 | * |
---|
| 494 | ***************************************************************/ |
---|
| 495 | |
---|
| 496 | #ifdef MDEBUG |
---|
| 497 | void * mpAllocBlock( size_t t) |
---|
| 498 | { |
---|
| 499 | return mmDBAllocBlock(t,"mp",0); |
---|
| 500 | } |
---|
| 501 | void mpFreeBlock( void* a, size_t t) |
---|
| 502 | { |
---|
| 503 | mmDBFreeBlock(a,t,"mp",0); |
---|
| 504 | } |
---|
| 505 | |
---|
| 506 | void * mpAlloc( size_t t) |
---|
| 507 | { |
---|
| 508 | return mmDBAlloc(t,"mp",0); |
---|
| 509 | } |
---|
| 510 | void mpFree(void* a) |
---|
| 511 | { |
---|
| 512 | mmDBFree(a,"mp",0); |
---|
| 513 | } |
---|
| 514 | #endif |
---|
| 515 | |
---|
| 516 | void mpsr_Init() |
---|
| 517 | { |
---|
| 518 | // memory management functions of MP (and MPT) |
---|
| 519 | #ifndef MDEBUG |
---|
| 520 | IMP_RawMemAllocFnc = mmAlloc; |
---|
| 521 | IMP_RawMemFreeFnc = mmFree; |
---|
| 522 | IMP_MemAllocFnc = mmAllocBlock; |
---|
| 523 | IMP_MemFreeFnc = mmFreeBlock; |
---|
| 524 | #else |
---|
| 525 | IMP_RawMemAllocFnc = mpAlloc; |
---|
| 526 | IMP_RawMemFreeFnc = mpFree; |
---|
| 527 | IMP_MemAllocFnc = mpAllocBlock; |
---|
| 528 | IMP_MemFreeFnc = mpFreeBlock; |
---|
| 529 | #endif |
---|
| 530 | |
---|
| 531 | // Init of the MPT External Data functions |
---|
| 532 | MPT_GetExternalData = mpsr_GetExternalData; |
---|
| 533 | MPT_DeleteExternalData = mpsr_DeleteExternalData; |
---|
| 534 | |
---|
| 535 | #ifdef PARI_BIGINT_TEST |
---|
| 536 | init(4000000, 2); |
---|
| 537 | #endif |
---|
| 538 | } |
---|
| 539 | |
---|
| 540 | #ifdef MPSR_DEBUG |
---|
| 541 | // this is just a dummy function, where we can set a debugger breakpoint |
---|
| 542 | void mpsr_Break() |
---|
| 543 | { |
---|
| 544 | Werror("mpsr_Error"); |
---|
| 545 | } |
---|
| 546 | #endif |
---|
| 547 | |
---|
| 548 | #endif // HAVE_MPSR |
---|