[0e1846] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
[2ba9a6] | 4 | /* $Id: silink.cc,v 1.13 1998-01-16 14:29:56 krueger Exp $ */ |
---|
[32df82] | 5 | |
---|
[0e1846] | 6 | /* |
---|
[6ae4f5] | 7 | * ABSTRACT: general interface to links |
---|
[d754b7] | 8 | */ |
---|
[0e1846] | 9 | |
---|
| 10 | #include <stdio.h> |
---|
| 11 | #include <string.h> |
---|
| 12 | #include "mod2.h" |
---|
| 13 | #include "tok.h" |
---|
| 14 | #include "mmemory.h" |
---|
| 15 | #include "febase.h" |
---|
| 16 | #include "subexpr.h" |
---|
| 17 | #include "ipid.h" |
---|
| 18 | #include "silink.h" |
---|
[286bd57] | 19 | #include "ipshell.h" |
---|
| 20 | #include "ring.h" |
---|
| 21 | #include "lists.h" |
---|
| 22 | #include "ideals.h" |
---|
| 23 | #include "numbers.h" |
---|
[d754b7] | 24 | #include "intvec.h" |
---|
[286bd57] | 25 | |
---|
| 26 | /* declarations */ |
---|
| 27 | static BOOLEAN DumpAscii(FILE *fd, idhdl h); |
---|
| 28 | static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h); |
---|
| 29 | static char* GetIdString(idhdl h); |
---|
| 30 | static int DumpRhs(FILE *fd, idhdl h); |
---|
[b7808e] | 31 | static BOOLEAN DumpQring(FILE *fd, idhdl h, char *type_str); |
---|
[d754b7] | 32 | static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl); |
---|
[0e1846] | 33 | |
---|
| 34 | /* ====================================================================== */ |
---|
| 35 | si_link_extension si_link_root=NULL; |
---|
[d754b7] | 36 | |
---|
[0e1846] | 37 | BOOLEAN slInit(si_link l, char *istr) |
---|
| 38 | { |
---|
[d754b7] | 39 | char *type = NULL, *mode = NULL, *name = NULL; |
---|
| 40 | int i = 0, j; |
---|
| 41 | |
---|
| 42 | // set mode and type |
---|
| 43 | if (istr != NULL) |
---|
[0e1846] | 44 | { |
---|
[d754b7] | 45 | // find the first colon char in istr |
---|
| 46 | i = 0; |
---|
| 47 | while (istr[i] != ':' && istr[i] != '\0') i++; |
---|
| 48 | if (istr[i] == ':') |
---|
[0e1846] | 49 | { |
---|
[d754b7] | 50 | // if found, set type |
---|
| 51 | if (i > 0) |
---|
[0e1846] | 52 | { |
---|
[d754b7] | 53 | istr[i] = '\0'; |
---|
| 54 | type = mstrdup(istr); |
---|
| 55 | istr[i] = ':'; |
---|
[0e1846] | 56 | } |
---|
[d754b7] | 57 | // and check for mode |
---|
| 58 | j = ++i; |
---|
| 59 | while (istr[j] != ' ' && istr[j] != '\0') j++; |
---|
| 60 | if (j > i) |
---|
[0e1846] | 61 | { |
---|
[d754b7] | 62 | mode = mstrdup(&(istr[i])); |
---|
| 63 | mode[j - i] = '\0'; |
---|
[0e1846] | 64 | } |
---|
[d754b7] | 65 | // and for the name |
---|
| 66 | while (istr[j] == ' '&& istr[j] != '\0') j++; |
---|
| 67 | if (istr[j] != '\0') name = mstrdup(&(istr[j])); |
---|
| 68 | } |
---|
| 69 | else // no colon find -- string is entire name |
---|
| 70 | { |
---|
| 71 | j=0; |
---|
| 72 | while (istr[j] == ' '&& istr[j] != '\0') j++; |
---|
| 73 | if (istr[j] != '\0') name = mstrdup(&(istr[j])); |
---|
[0e1846] | 74 | } |
---|
| 75 | } |
---|
[e6969d] | 76 | |
---|
[d754b7] | 77 | // set the link extension |
---|
| 78 | if (type != NULL) |
---|
[0e1846] | 79 | { |
---|
[d754b7] | 80 | si_link_extension s = si_link_root; |
---|
| 81 | |
---|
| 82 | while (s != NULL && (strcmp(s->type, type) != 0)) s = s->next; |
---|
| 83 | |
---|
| 84 | if (s != NULL) |
---|
| 85 | l->m = s; |
---|
| 86 | else |
---|
[0e1846] | 87 | { |
---|
[d754b7] | 88 | Warn("Found unknown link type: %s", type); |
---|
| 89 | Warn("Use default link type: %s", si_link_root->type); |
---|
| 90 | l->m = si_link_root; |
---|
[0e1846] | 91 | } |
---|
[d754b7] | 92 | FreeL(type); |
---|
[0e1846] | 93 | } |
---|
[d754b7] | 94 | else |
---|
| 95 | l->m = si_link_root; |
---|
| 96 | |
---|
| 97 | l->name = (name != NULL ? name : mstrdup("")); |
---|
| 98 | l->mode = (mode != NULL ? mode : mstrdup("")); |
---|
| 99 | l->ref = 1; |
---|
| 100 | return FALSE; |
---|
[0e1846] | 101 | } |
---|
| 102 | |
---|
[e6969d] | 103 | void slCleanUp(si_link l) |
---|
[0e1846] | 104 | { |
---|
[e6969d] | 105 | (l->ref)--; |
---|
[d754b7] | 106 | if (l->ref == 0) |
---|
[0e1846] | 107 | { |
---|
[e6969d] | 108 | if (SI_LINK_OPEN_P(l)) slClose(l); |
---|
[d754b7] | 109 | FreeL((ADDRESS)l->name); |
---|
| 110 | FreeL((ADDRESS)l->mode); |
---|
| 111 | memset((void *) l, 0, sizeof(ip_link)); |
---|
[e6969d] | 112 | } |
---|
| 113 | } |
---|
| 114 | |
---|
| 115 | void slKill(si_link l) |
---|
| 116 | { |
---|
[d754b7] | 117 | slCleanUp(l); |
---|
[e6969d] | 118 | if (l->ref == 0) |
---|
| 119 | Free((ADDRESS)l, sizeof(ip_link)); |
---|
[0e1846] | 120 | } |
---|
| 121 | |
---|
[d754b7] | 122 | char* slStatus(si_link l, char *request) |
---|
[0e1846] | 123 | { |
---|
[d754b7] | 124 | if (l == NULL) return "empty link"; |
---|
| 125 | else if (l->m == NULL) return "unknown link type"; |
---|
| 126 | else if (strcmp(request, "type") == 0) return l->m->type; |
---|
| 127 | else if (strcmp(request, "mode") == 0) return l->mode; |
---|
| 128 | else if (strcmp(request, "name") == 0) return l->name; |
---|
| 129 | else if (strcmp(request, "open") == 0) |
---|
| 130 | { |
---|
| 131 | if (SI_LINK_OPEN_P(l)) return "yes"; |
---|
| 132 | else return "no"; |
---|
| 133 | } |
---|
| 134 | else if (strcmp(request, "openread") == 0) |
---|
| 135 | { |
---|
| 136 | if (SI_LINK_R_OPEN_P(l)) return "yes"; |
---|
| 137 | else return "no"; |
---|
| 138 | } |
---|
| 139 | else if (strcmp(request, "openwrite") == 0) |
---|
| 140 | { |
---|
| 141 | if (SI_LINK_W_OPEN_P(l)) return "yes"; |
---|
| 142 | else return "no"; |
---|
| 143 | } |
---|
| 144 | else if (l->m->Status == NULL) return "unknown status request"; |
---|
| 145 | else return l->m->Status(l, request); |
---|
[0e1846] | 146 | } |
---|
| 147 | |
---|
[d754b7] | 148 | //-------------------------------------------------------------------------- |
---|
| 149 | BOOLEAN slOpen(si_link l, short flag) |
---|
[0e1846] | 150 | { |
---|
[d754b7] | 151 | BOOLEAN res; |
---|
| 152 | |
---|
| 153 | if (l->m == NULL) slInit(l, ""); |
---|
| 154 | |
---|
| 155 | if (SI_LINK_OPEN_P(l)) |
---|
| 156 | { |
---|
| 157 | Warn("open: link of type: %s, mode: %s, name: %s is already open", |
---|
| 158 | l->m->type, l->mode, l->name); |
---|
| 159 | return FALSE; |
---|
| 160 | } |
---|
[1fc83c0] | 161 | else if (l->m->Open != NULL) |
---|
| 162 | res = l->m->Open(l, flag); |
---|
| 163 | else |
---|
| 164 | res = TRUE; |
---|
[d754b7] | 165 | |
---|
| 166 | if (res) |
---|
| 167 | Werror("open: Error for link of type: %s, mode: %s, name: %s", |
---|
| 168 | l->m->type, l->mode, l->name); |
---|
| 169 | return res; |
---|
[0e1846] | 170 | } |
---|
| 171 | |
---|
| 172 | BOOLEAN slClose(si_link l) |
---|
| 173 | { |
---|
[d754b7] | 174 | BOOLEAN res; |
---|
| 175 | |
---|
[1fc83c0] | 176 | if(! SI_LINK_OPEN_P(l)) |
---|
| 177 | return FALSE; |
---|
| 178 | else if (l->m->Close != NULL) |
---|
| 179 | res = l->m->Close(l); |
---|
| 180 | else |
---|
| 181 | res = TRUE; |
---|
[d754b7] | 182 | |
---|
| 183 | if (res) |
---|
| 184 | Werror("close: Error for link of type: %s, mode: %s, name: %s", |
---|
| 185 | l->m->type, l->mode, l->name); |
---|
| 186 | return res; |
---|
[0e1846] | 187 | } |
---|
| 188 | |
---|
[d754b7] | 189 | leftv slRead(si_link l, leftv a) |
---|
[0e1846] | 190 | { |
---|
| 191 | leftv v = NULL; |
---|
| 192 | if( ! SI_LINK_R_OPEN_P(l)) // open r ? |
---|
| 193 | { |
---|
[d754b7] | 194 | if (slOpen(l, SI_LINK_READ)) return NULL; |
---|
[0e1846] | 195 | } |
---|
[d754b7] | 196 | |
---|
| 197 | if (SI_LINK_R_OPEN_P(l)) |
---|
[0e1846] | 198 | { // open r |
---|
| 199 | if (a==NULL) |
---|
| 200 | { |
---|
[d754b7] | 201 | if (l->m->Read != NULL) v = l->m->Read(l); |
---|
[0e1846] | 202 | } |
---|
| 203 | else |
---|
| 204 | { |
---|
[d754b7] | 205 | if (l->m->Read2 != NULL) v = l->m->Read2(l,a); |
---|
[0e1846] | 206 | } |
---|
| 207 | } |
---|
[d754b7] | 208 | else |
---|
[0e1846] | 209 | { |
---|
[d754b7] | 210 | Werror("read: Error to open link of type %s, mode: %s, name: %s for reading", |
---|
| 211 | l->m->type, l->mode, l->name); |
---|
| 212 | return NULL; |
---|
[0e1846] | 213 | } |
---|
[d754b7] | 214 | |
---|
| 215 | // here comes the eval: |
---|
[1fc83c0] | 216 | if (v != NULL) |
---|
| 217 | v->Eval(); |
---|
[d754b7] | 218 | else |
---|
| 219 | Werror("read: Error for link of type %s, mode: %s, name: %s", |
---|
| 220 | l->m->type, l->mode, l->name); |
---|
[0e1846] | 221 | return v; |
---|
| 222 | } |
---|
| 223 | |
---|
| 224 | BOOLEAN slWrite(si_link l, leftv v) |
---|
| 225 | { |
---|
[d754b7] | 226 | BOOLEAN res; |
---|
| 227 | |
---|
[0e1846] | 228 | if(! SI_LINK_W_OPEN_P(l)) // open w ? |
---|
| 229 | { |
---|
[d754b7] | 230 | if (slOpen(l, SI_LINK_WRITE)) return TRUE; |
---|
[0e1846] | 231 | } |
---|
[d754b7] | 232 | |
---|
| 233 | if(SI_LINK_W_OPEN_P(l)) |
---|
[0e1846] | 234 | { // now open w |
---|
[1fc83c0] | 235 | if (l->m->Write != NULL) |
---|
| 236 | res = l->m->Write(l,v); |
---|
| 237 | else |
---|
| 238 | res = TRUE; |
---|
[d754b7] | 239 | |
---|
| 240 | if (res) |
---|
| 241 | Werror("write: Error for link of type %s, mode: %s, name: %s", |
---|
| 242 | l->m->type, l->mode, l->name); |
---|
| 243 | return res; |
---|
| 244 | } |
---|
| 245 | else |
---|
| 246 | { |
---|
| 247 | Werror("write: Error to open link of type %s, mode: %s, name: %s for writing", |
---|
| 248 | l->m->type, l->mode, l->name); |
---|
| 249 | return TRUE; |
---|
[0e1846] | 250 | } |
---|
| 251 | } |
---|
| 252 | |
---|
[286bd57] | 253 | BOOLEAN slDump(si_link l) |
---|
| 254 | { |
---|
[d754b7] | 255 | BOOLEAN res; |
---|
| 256 | |
---|
[286bd57] | 257 | if(! SI_LINK_W_OPEN_P(l)) // open w ? |
---|
| 258 | { |
---|
[d754b7] | 259 | if (slOpen(l, SI_LINK_WRITE)) return TRUE; |
---|
[286bd57] | 260 | } |
---|
[d754b7] | 261 | |
---|
| 262 | if(SI_LINK_W_OPEN_P(l)) |
---|
[286bd57] | 263 | { // now open w |
---|
[1fc83c0] | 264 | if (l->m->Dump != NULL) |
---|
| 265 | res = l->m->Dump(l); |
---|
| 266 | else |
---|
| 267 | res = TRUE; |
---|
[286bd57] | 268 | |
---|
[d754b7] | 269 | if (res) |
---|
| 270 | Werror("dump: Error for link of type %s, mode: %s, name: %s", |
---|
| 271 | l->m->type, l->mode, l->name); |
---|
| 272 | return res; |
---|
[286bd57] | 273 | } |
---|
[d754b7] | 274 | else |
---|
| 275 | { |
---|
| 276 | Werror("dump: Error to open link of type %s, mode: %s, name: %s for writing", |
---|
| 277 | l->m->type, l->mode, l->name); |
---|
| 278 | return TRUE; |
---|
[286bd57] | 279 | } |
---|
| 280 | } |
---|
| 281 | |
---|
[d754b7] | 282 | BOOLEAN slGetDump(si_link l) |
---|
[0e1846] | 283 | { |
---|
[d754b7] | 284 | BOOLEAN res; |
---|
| 285 | |
---|
| 286 | if(! SI_LINK_R_OPEN_P(l)) // open r ? |
---|
[0e1846] | 287 | { |
---|
[d754b7] | 288 | if (slOpen(l, SI_LINK_READ)) return TRUE; |
---|
[0e1846] | 289 | } |
---|
[d754b7] | 290 | |
---|
| 291 | if(SI_LINK_R_OPEN_P(l)) |
---|
| 292 | { // now open r |
---|
[1fc83c0] | 293 | if (l->m->GetDump != NULL) |
---|
| 294 | res = l->m->GetDump(l); |
---|
| 295 | else |
---|
| 296 | res = TRUE; |
---|
[d754b7] | 297 | |
---|
| 298 | if (res) |
---|
| 299 | Werror("getdump: Error for link of type %s, mode: %s, name: %s", |
---|
| 300 | l->m->type, l->mode, l->name); |
---|
| 301 | return res; |
---|
[0e1846] | 302 | } |
---|
[d754b7] | 303 | else |
---|
[0e1846] | 304 | { |
---|
[d754b7] | 305 | Werror("dump: Error open link of type %s, mode: %s, name: %s for reading", |
---|
| 306 | l->m->type, l->mode, l->name); |
---|
| 307 | return TRUE; |
---|
[0e1846] | 308 | } |
---|
| 309 | } |
---|
[d754b7] | 310 | |
---|
| 311 | |
---|
| 312 | /* =============== ASCII ============================================= */ |
---|
| 313 | BOOLEAN slOpenAscii(si_link l, short flag) |
---|
[0e1846] | 314 | { |
---|
[d754b7] | 315 | char *mode; |
---|
[1fc83c0] | 316 | if (flag & SI_LINK_OPEN) |
---|
[0e1846] | 317 | { |
---|
[d754b7] | 318 | if (l->mode[0] != '\0' && (strcmp(l->mode, "r") == 0)) |
---|
| 319 | flag = SI_LINK_READ; |
---|
| 320 | else flag = SI_LINK_WRITE; |
---|
[0e1846] | 321 | } |
---|
[d754b7] | 322 | |
---|
| 323 | if (flag == SI_LINK_READ) mode = "r"; |
---|
| 324 | else if (strcmp(l->mode, "w") == 0) mode = "w"; |
---|
| 325 | else mode = "a"; |
---|
| 326 | |
---|
| 327 | |
---|
| 328 | if (l->name[0] == '\0') |
---|
[0e1846] | 329 | { |
---|
[d754b7] | 330 | // stdin or stdout |
---|
| 331 | if (flag == SI_LINK_READ) |
---|
[0e1846] | 332 | { |
---|
[d754b7] | 333 | l->data = (void *) stdin; |
---|
| 334 | mode = "r"; |
---|
[0e1846] | 335 | } |
---|
[d754b7] | 336 | else |
---|
[0e1846] | 337 | { |
---|
[d754b7] | 338 | l->data = (void *) stdout; |
---|
| 339 | mode = "a"; |
---|
[0e1846] | 340 | } |
---|
[d754b7] | 341 | } |
---|
| 342 | else |
---|
| 343 | { |
---|
| 344 | // normal ascii link to a file |
---|
| 345 | FILE *outfile; |
---|
| 346 | char *filename=l->name; |
---|
| 347 | |
---|
| 348 | if(filename[0]=='>') |
---|
[0e1846] | 349 | { |
---|
[d754b7] | 350 | if (filename[1]=='>') |
---|
| 351 | { |
---|
| 352 | filename+=2; |
---|
| 353 | mode = "a"; |
---|
| 354 | } |
---|
| 355 | else |
---|
| 356 | { |
---|
| 357 | filename++; |
---|
| 358 | mode="w"; |
---|
| 359 | } |
---|
[0e1846] | 360 | } |
---|
[c1945e] | 361 | outfile=feFopen(filename,mode); |
---|
[1fc83c0] | 362 | if (outfile!=NULL) |
---|
| 363 | l->data = (void *) outfile; |
---|
| 364 | else |
---|
| 365 | return TRUE; |
---|
[0e1846] | 366 | } |
---|
[d754b7] | 367 | |
---|
| 368 | FreeL(l->mode); |
---|
| 369 | l->mode = mstrdup(mode); |
---|
| 370 | SI_LINK_SET_OPEN_P(l, flag); |
---|
[0e1846] | 371 | return FALSE; |
---|
| 372 | } |
---|
[d754b7] | 373 | |
---|
[0e1846] | 374 | BOOLEAN slCloseAscii(si_link l) |
---|
| 375 | { |
---|
| 376 | SI_LINK_SET_CLOSE_P(l); |
---|
[d754b7] | 377 | if (l->name[0] != '\0') |
---|
[0e1846] | 378 | { |
---|
| 379 | return (fclose((FILE *)l->data)!=0); |
---|
| 380 | } |
---|
| 381 | return FALSE; |
---|
| 382 | } |
---|
[d754b7] | 383 | |
---|
[0e1846] | 384 | leftv slReadAscii(si_link l) |
---|
| 385 | { |
---|
| 386 | FILE * fp=(FILE *)l->data; |
---|
| 387 | char * buf=NULL; |
---|
[d754b7] | 388 | if (fp!=NULL && l->name[0] != '\0') |
---|
[0e1846] | 389 | { |
---|
| 390 | fseek(fp,0L,SEEK_END); |
---|
| 391 | long len=ftell(fp); |
---|
| 392 | fseek(fp,0L,SEEK_SET); |
---|
| 393 | buf=(char *)AllocL((int)len+1); |
---|
[1fc83c0] | 394 | if (BVERBOSE(V_READING)) |
---|
| 395 | Print("//Reading %d chars\n",len); |
---|
[0e1846] | 396 | fread( buf, len, 1, fp); |
---|
| 397 | buf[len]='\0'; |
---|
| 398 | } |
---|
| 399 | else |
---|
| 400 | { |
---|
| 401 | PrintS("? "); mflush(); |
---|
| 402 | buf=(char *)AllocL(80); |
---|
| 403 | fe_fgets_stdin(buf,80); |
---|
| 404 | } |
---|
| 405 | leftv v=(leftv)Alloc0(sizeof(sleftv)); |
---|
| 406 | v->rtyp=STRING_CMD; |
---|
| 407 | v->data=buf; |
---|
| 408 | return v; |
---|
| 409 | } |
---|
| 410 | BOOLEAN slWriteAscii(si_link l, leftv v) |
---|
| 411 | { |
---|
| 412 | FILE *outfile=(FILE *)l->data; |
---|
| 413 | BOOLEAN err=FALSE; |
---|
| 414 | char *s; |
---|
| 415 | while (v!=NULL) |
---|
| 416 | { |
---|
| 417 | s = v->String(); |
---|
| 418 | // free v ?? |
---|
| 419 | if (s!=NULL) |
---|
| 420 | { |
---|
| 421 | fprintf(outfile,"%s\n",s); |
---|
| 422 | FreeL((ADDRESS)s); |
---|
| 423 | } |
---|
| 424 | else |
---|
| 425 | { |
---|
| 426 | Werror("cannot convert to string"); |
---|
| 427 | err=TRUE; |
---|
| 428 | } |
---|
| 429 | v = v->next; |
---|
| 430 | } |
---|
| 431 | fflush(outfile); |
---|
| 432 | return err; |
---|
| 433 | } |
---|
| 434 | |
---|
[d754b7] | 435 | char* slStatusAscii(si_link l, char* request) |
---|
[0e1846] | 436 | { |
---|
[d754b7] | 437 | if (strcmp(request, "read") == 0) |
---|
[0e1846] | 438 | { |
---|
[d754b7] | 439 | if (SI_LINK_R_OPEN_P(l)) return "ready"; |
---|
| 440 | else return "not ready"; |
---|
| 441 | } |
---|
| 442 | else if (strcmp(request, "write") == 0) |
---|
| 443 | { |
---|
| 444 | if (SI_LINK_W_OPEN_P(l)) return "ready"; |
---|
| 445 | else return "not ready"; |
---|
[0e1846] | 446 | } |
---|
[d754b7] | 447 | else return "unknown status request"; |
---|
[0e1846] | 448 | } |
---|
| 449 | |
---|
[d754b7] | 450 | /*------------------ Dumping in Ascii format -----------------------*/ |
---|
| 451 | |
---|
[286bd57] | 452 | BOOLEAN slDumpAscii(si_link l) |
---|
| 453 | { |
---|
| 454 | FILE *fd = (FILE *) l->data; |
---|
| 455 | idhdl h = idroot, rh = currRingHdl; |
---|
| 456 | BOOLEAN status = DumpAscii(fd, h); |
---|
| 457 | |
---|
[d754b7] | 458 | if (! status ) status = DumpAsciiMaps(fd, h, NULL); |
---|
| 459 | |
---|
[286bd57] | 460 | if (currRingHdl != rh) rSetHdl(rh, TRUE); |
---|
| 461 | fflush(fd); |
---|
| 462 | |
---|
| 463 | return status; |
---|
| 464 | } |
---|
| 465 | |
---|
| 466 | // we do that recursively, to dump ids in the the order in which they |
---|
| 467 | // were actually defined |
---|
| 468 | static BOOLEAN DumpAscii(FILE *fd, idhdl h) |
---|
| 469 | { |
---|
| 470 | if (h == NULL) return FALSE; |
---|
| 471 | |
---|
| 472 | if (DumpAscii(fd, IDNEXT(h))) return TRUE; |
---|
| 473 | |
---|
[d754b7] | 474 | // need to set the ring before writing it, otherwise we get in |
---|
[286bd57] | 475 | // trouble with minpoly |
---|
| 476 | if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) |
---|
| 477 | rSetHdl(h, TRUE); |
---|
| 478 | |
---|
| 479 | if (DumpAsciiIdhdl(fd, h)) return TRUE; |
---|
| 480 | |
---|
| 481 | if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) |
---|
| 482 | return DumpAscii(fd, IDRING(h)->idroot); |
---|
| 483 | else |
---|
| 484 | return FALSE; |
---|
| 485 | } |
---|
| 486 | |
---|
[d754b7] | 487 | static BOOLEAN DumpAsciiMaps(FILE *fd, idhdl h, idhdl rhdl) |
---|
| 488 | { |
---|
| 489 | if (h == NULL) return FALSE; |
---|
| 490 | if (DumpAsciiMaps(fd, IDNEXT(h), rhdl)) return TRUE; |
---|
| 491 | |
---|
| 492 | if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) |
---|
| 493 | return DumpAsciiMaps(fd, IDRING(h)->idroot, h); |
---|
| 494 | else if (IDTYP(h) == MAP_CMD) |
---|
| 495 | { |
---|
| 496 | char *rhs; |
---|
| 497 | rSetHdl(rhdl, TRUE); |
---|
| 498 | rhs = ((leftv) h)->String(); |
---|
| 499 | |
---|
| 500 | if (fprintf(fd, "setring %s;\n", IDID(rhdl)) == EOF) return TRUE; |
---|
| 501 | if (fprintf(fd, "%s %s = %s, %s;\n", Tok2Cmdname(MAP_CMD), IDID(h), |
---|
| 502 | IDMAP(h)->preimage, rhs) == EOF) |
---|
| 503 | { |
---|
| 504 | FreeL(rhs); |
---|
| 505 | return TRUE; |
---|
| 506 | } |
---|
| 507 | else |
---|
| 508 | { |
---|
| 509 | FreeL(rhs); |
---|
| 510 | return FALSE; |
---|
| 511 | } |
---|
| 512 | } |
---|
| 513 | else return FALSE; |
---|
| 514 | } |
---|
| 515 | |
---|
[286bd57] | 516 | static BOOLEAN DumpAsciiIdhdl(FILE *fd, idhdl h) |
---|
| 517 | { |
---|
| 518 | char *type_str = GetIdString(h); |
---|
| 519 | idtyp type_id = IDTYP(h); |
---|
| 520 | |
---|
| 521 | // we do not throw an error if a wrong type was attempted to be dumped |
---|
| 522 | if (type_str == NULL) return FALSE; |
---|
| 523 | |
---|
[b7808e] | 524 | // handle qrings separately |
---|
| 525 | if (type_id == QRING_CMD) return DumpQring(fd, h, type_str); |
---|
| 526 | |
---|
[2a2c07] | 527 | if (type_id == STRING_CMD && strcmp("LIB", IDID(h)) == 0) |
---|
| 528 | { |
---|
| 529 | if (fprintf(fd, "LIB \"%s\";\n", IDSTRING(h)) == EOF) return TRUE; |
---|
| 530 | else return FALSE; |
---|
| 531 | } |
---|
| 532 | |
---|
[286bd57] | 533 | // put type and name |
---|
| 534 | if (fprintf(fd, "%s %s", type_str, IDID(h)) == EOF) return TRUE; |
---|
| 535 | |
---|
| 536 | // for matricies, append the dimension |
---|
| 537 | if (type_id == MATRIX_CMD) |
---|
| 538 | { |
---|
| 539 | ideal id = IDIDEAL(h); |
---|
| 540 | if (fprintf(fd, "[%d][%d]", id->nrows, id->ncols)== EOF) return TRUE; |
---|
| 541 | } |
---|
[d754b7] | 542 | else if (type_id == INTMAT_CMD) |
---|
[286bd57] | 543 | { |
---|
[d754b7] | 544 | if (fprintf(fd, "[%d][%d]", IDINTVEC(h)->rows(), IDINTVEC(h)->cols()) |
---|
| 545 | == EOF) return TRUE; |
---|
[286bd57] | 546 | } |
---|
[d754b7] | 547 | // write the equal sign |
---|
| 548 | if (fprintf(fd, " = ") == EOF) return TRUE; |
---|
| 549 | |
---|
| 550 | // and the right hand side |
---|
| 551 | if (DumpRhs(fd, h) == EOF) return TRUE; |
---|
[286bd57] | 552 | |
---|
| 553 | // semicolon und tschuess |
---|
| 554 | if (fprintf(fd, ";\n") == EOF) return TRUE; |
---|
| 555 | |
---|
| 556 | return FALSE; |
---|
| 557 | } |
---|
| 558 | |
---|
| 559 | static char* GetIdString(idhdl h) |
---|
| 560 | { |
---|
| 561 | idtyp type = IDTYP(h); |
---|
| 562 | |
---|
| 563 | switch(type) |
---|
| 564 | { |
---|
| 565 | case LIST_CMD: |
---|
| 566 | { |
---|
| 567 | lists l = IDLIST(h); |
---|
| 568 | int i, nl = l->nr + 1; |
---|
| 569 | char *name; |
---|
| 570 | |
---|
| 571 | for (i=0; i<nl; i++) |
---|
| 572 | if (GetIdString((idhdl) &(l->m[i])) == NULL) return NULL; |
---|
| 573 | } |
---|
| 574 | case INT_CMD: |
---|
| 575 | case INTVEC_CMD: |
---|
| 576 | case INTMAT_CMD: |
---|
| 577 | case STRING_CMD: |
---|
| 578 | case RING_CMD: |
---|
[b7808e] | 579 | case QRING_CMD: |
---|
[286bd57] | 580 | case PROC_CMD: |
---|
| 581 | case NUMBER_CMD: |
---|
| 582 | case POLY_CMD: |
---|
| 583 | case IDEAL_CMD: |
---|
| 584 | case VECTOR_CMD: |
---|
| 585 | case MODUL_CMD: |
---|
| 586 | case MATRIX_CMD: |
---|
| 587 | return Tok2Cmdname(type); |
---|
| 588 | |
---|
[d754b7] | 589 | case MAP_CMD: |
---|
[286bd57] | 590 | case LINK_CMD: |
---|
| 591 | return NULL; |
---|
| 592 | |
---|
| 593 | default: |
---|
[d754b7] | 594 | Warn("Error dump data of type %s", Tok2Cmdname(IDTYP(h))); |
---|
[286bd57] | 595 | return NULL; |
---|
| 596 | } |
---|
| 597 | } |
---|
| 598 | |
---|
[b7808e] | 599 | static BOOLEAN DumpQring(FILE *fd, idhdl h, char *type_str) |
---|
| 600 | { |
---|
[d754b7] | 601 | char *ring_str = ((leftv) h)->String(); |
---|
| 602 | if (fprintf(fd, "%s temp_ring = %s;\n", Tok2Cmdname(RING_CMD), ring_str) |
---|
| 603 | == EOF) return TRUE; |
---|
| 604 | if (fprintf(fd, "%s temp_ideal = %s;\n", Tok2Cmdname(IDEAL_CMD), |
---|
| 605 | iiStringMatrix((matrix) IDRING(h)->qideal, 1)) |
---|
[b7808e] | 606 | == EOF) return TRUE; |
---|
| 607 | if (fprintf(fd, "attrib(temp_ideal, \"isSB\", 1);\n") == EOF) return TRUE; |
---|
| 608 | if (fprintf(fd, "%s %s = temp_ideal;\n", type_str, IDID(h)) == EOF) |
---|
| 609 | return TRUE; |
---|
[d754b7] | 610 | if (fprintf(fd, "kill temp_ring;\n") == EOF) return TRUE; |
---|
[b7808e] | 611 | else |
---|
[d754b7] | 612 | { |
---|
| 613 | FreeL(ring_str); |
---|
[b7808e] | 614 | return FALSE; |
---|
[d754b7] | 615 | } |
---|
[b7808e] | 616 | } |
---|
| 617 | |
---|
| 618 | |
---|
[286bd57] | 619 | static int DumpRhs(FILE *fd, idhdl h) |
---|
| 620 | { |
---|
| 621 | idtyp type_id = IDTYP(h); |
---|
| 622 | |
---|
| 623 | if (type_id == LIST_CMD) |
---|
| 624 | { |
---|
| 625 | lists l = IDLIST(h); |
---|
| 626 | int i, nl = l->nr; |
---|
| 627 | |
---|
[d754b7] | 628 | fprintf(fd, "list("); |
---|
| 629 | |
---|
[286bd57] | 630 | for (i=0; i<nl; i++) |
---|
| 631 | { |
---|
[d754b7] | 632 | if (DumpRhs(fd, (idhdl) &(l->m[i])) == EOF) return EOF; |
---|
| 633 | fprintf(fd, ","); |
---|
[286bd57] | 634 | } |
---|
[d754b7] | 635 | if (nl > 0) |
---|
| 636 | { |
---|
| 637 | if (DumpRhs(fd, (idhdl) &(l->m[nl])) == EOF) return EOF; |
---|
[286bd57] | 638 | } |
---|
[d754b7] | 639 | fprintf(fd, ")"); |
---|
[286bd57] | 640 | } |
---|
[2ba9a6] | 641 | else if (type_id == STRING_CMD) |
---|
[286bd57] | 642 | { |
---|
| 643 | char *pstr = IDSTRING(h), c; |
---|
| 644 | fputc('"', fd); |
---|
| 645 | while (*pstr != '\0') |
---|
| 646 | { |
---|
| 647 | if (*pstr == '"') fputc('\\', fd); |
---|
| 648 | fputc(*pstr, fd); |
---|
| 649 | pstr++; |
---|
| 650 | } |
---|
| 651 | fputc('"', fd); |
---|
| 652 | } |
---|
[2ba9a6] | 653 | else if (type_id == PROC_CMD) |
---|
| 654 | { |
---|
| 655 | procinfov pi = IDPROC(h); |
---|
| 656 | if (pi->language == LANG_SINGULAR) { |
---|
| 657 | if( pi->data.s.body==NULL) iiGetLibProcBuffer(pi); |
---|
| 658 | char *pstr = pi->data.s.body, c; |
---|
| 659 | fputc('"', fd); |
---|
| 660 | while (*pstr != '\0') { |
---|
| 661 | if (*pstr == '"') fputc('\\', fd); |
---|
| 662 | fputc(*pstr, fd); |
---|
| 663 | pstr++; |
---|
| 664 | } |
---|
| 665 | fputc('"', fd); |
---|
| 666 | } else fputs("(null)", fd); |
---|
| 667 | } |
---|
[286bd57] | 668 | else |
---|
| 669 | { |
---|
| 670 | char *rhs = ((leftv) h)->String(); |
---|
| 671 | |
---|
| 672 | if (rhs == NULL) return EOF; |
---|
| 673 | |
---|
[d754b7] | 674 | if (type_id == INTVEC_CMD) fprintf(fd, "intvec("); |
---|
[286bd57] | 675 | |
---|
| 676 | if (fprintf(fd, "%s", rhs) == EOF) return EOF; |
---|
| 677 | FreeL(rhs); |
---|
| 678 | |
---|
| 679 | if ((type_id == RING_CMD || type_id == QRING_CMD) && |
---|
| 680 | IDRING(h)->minpoly != NULL) |
---|
| 681 | { |
---|
| 682 | StringSetS(""); |
---|
| 683 | nWrite(IDRING(h)->minpoly); |
---|
| 684 | rhs = StringAppend(""); |
---|
| 685 | if (fprintf(fd, "; minpoly = %s", rhs) == EOF) return EOF; |
---|
| 686 | } |
---|
[d754b7] | 687 | else if (type_id == INTVEC_CMD) fprintf(fd, ")"); |
---|
[286bd57] | 688 | } |
---|
| 689 | return 1; |
---|
| 690 | } |
---|
| 691 | |
---|
| 692 | BOOLEAN slGetDumpAscii(si_link l) |
---|
| 693 | { |
---|
| 694 | if (l->name[0] == '\0') |
---|
| 695 | { |
---|
[d754b7] | 696 | Werror("getdump: Can not get dump from stdin"); |
---|
[286bd57] | 697 | return TRUE; |
---|
| 698 | } |
---|
| 699 | else |
---|
| 700 | { |
---|
| 701 | BOOLEAN status = iiPStart(NULL, l->name, NULL); |
---|
| 702 | |
---|
| 703 | if (status) |
---|
| 704 | return TRUE; |
---|
| 705 | else |
---|
| 706 | { |
---|
[d754b7] | 707 | // lets reset the file pointer to the end to reflect that |
---|
[286bd57] | 708 | // we are finished with reading |
---|
| 709 | FILE *f = (FILE *) l->data; |
---|
| 710 | fseek(f, 0L, SEEK_END); |
---|
| 711 | return FALSE; |
---|
| 712 | } |
---|
| 713 | } |
---|
| 714 | } |
---|
[d754b7] | 715 | |
---|
| 716 | |
---|
| 717 | /*------------Initialization at Start-up time------------------------*/ |
---|
[0e1846] | 718 | |
---|
| 719 | #ifdef HAVE_DBM |
---|
| 720 | #include "sing_dbm.h" |
---|
| 721 | #endif |
---|
| 722 | |
---|
| 723 | #ifdef HAVE_MPSR |
---|
| 724 | #include "sing_mp.h" |
---|
| 725 | #endif |
---|
| 726 | |
---|
| 727 | void slStandardInit() |
---|
| 728 | { |
---|
[d754b7] | 729 | si_link_extension s; |
---|
[0e1846] | 730 | si_link_root=(si_link_extension)Alloc0(sizeof(*si_link_root)); |
---|
[d754b7] | 731 | si_link_root->Open=slOpenAscii; |
---|
[0e1846] | 732 | si_link_root->Close=slCloseAscii; |
---|
| 733 | si_link_root->Read=slReadAscii; |
---|
| 734 | si_link_root->Write=slWriteAscii; |
---|
[286bd57] | 735 | si_link_root->Dump=slDumpAscii; |
---|
| 736 | si_link_root->GetDump=slGetDumpAscii; |
---|
[d754b7] | 737 | si_link_root->Status=slStatusAscii; |
---|
[6ea5315] | 738 | si_link_root->type="Ascii"; |
---|
[d754b7] | 739 | s = si_link_root; |
---|
[0e1846] | 740 | #ifdef HAVE_DBM |
---|
| 741 | #ifndef HAVE_MODULE_DBM |
---|
[d754b7] | 742 | s->next = (si_link_extension)Alloc0(sizeof(*si_link_root)); |
---|
| 743 | s = s->next; |
---|
| 744 | slInitDBMExtension(s); |
---|
[0e1846] | 745 | #endif |
---|
| 746 | #endif |
---|
| 747 | #ifdef HAVE_MPSR |
---|
[d754b7] | 748 | s->next = (si_link_extension)Alloc0(sizeof(*si_link_root)); |
---|
| 749 | s = s->next; |
---|
| 750 | slInitMPFileExtension(s); |
---|
| 751 | s->next = (si_link_extension)Alloc0(sizeof(*si_link_root)); |
---|
| 752 | s = s->next; |
---|
| 753 | slInitMPTcpExtension(s); |
---|
[0e1846] | 754 | #endif |
---|
| 755 | } |
---|