![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to spexpr.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / io|
Return to spexpr.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / io |
1.3 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.4 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.3 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: */
1.1 noro 48: #include "ca.h"
1.2 noro 49: #include "al.h"
1.1 noro 50: #include "parse.h"
51: #include "comp.h"
52: #include "base.h"
1.26 ! noro 53:
! 54: #if defined(PARI)
1.25 noro 55: #include "genpari.h"
56: #endif
1.1 noro 57:
58: #ifndef SPRINT
59: #define SPRINT
60: #endif
61:
1.2 noro 62: #define PRINTHAT (fortran_output?PUTS("**"):PUTS("^"))
1.23 saito 63: extern int outputstyle;
1.2 noro 64:
1.1 noro 65: #ifdef FPRINT
66: FILE *asir_out;
67: #define OUT asir_out
68: char DFORMAT[BUFSIZ];
1.2 noro 69: int hex_output;
70: int fortran_output;
1.14 noro 71: int double_output;
72: int real_digit;
1.26 ! noro 73: int real_binary;
1.14 noro 74: int print_quote;
1.1 noro 75:
76: #define TAIL
77: #define PUTS(s) fputs(s,OUT)
78: #define PRINTF fprintf
79: #define PRINTN printn
80: #define PRINTBF printbf
81: #define PRINTCPLX printcplx
1.2 noro 82: #define PRINTLM printlm
83: #define PRINTUP2 printup2
1.1 noro 84: #define PRINTV printv
85: #define PRINTEXPR printexpr
86: #define PRINTNUM printnum
1.20 noro 87: #define PRINTP asir_printp
1.1 noro 88: #define PRINTR printr
89: #define PRINTLIST printlist
90: #define PRINTVECT printvect
91: #define PRINTMAT printmat
92: #define PRINTSTR printstr
93: #define PRINTCOMP printcomp
94: #define PRINTDP printdp
1.2 noro 95: #define PRINTUI printui
96: #define PRINTGF2MAT printgf2mat
97: #define PRINTGFMMAT printgfmmat
1.5 noro 98: #define PRINTBYTEARRAY printbytearray
1.13 noro 99: #define PRINTQUOTE printquote
1.2 noro 100: #define PRINTERR printerr
101: #define PRINTLF printlf
102: #define PRINTLOP printlop
103: #define PRINTFOP printfop
104: #define PRINTEOP printeop
105: #define PRINTQOP printqop
106: #define PRINTUP printup
1.16 noro 107: #define PRINTUM printum
108: #define PRINTSF printsf
1.26 ! noro 109: #define PRINTSYMBOL printsymbol
1.1 noro 110: #endif
111:
112: #ifdef SPRINT
113: static char *buf;
114: #define OUT buf
115: extern char DFORMAT[BUFSIZ];
1.2 noro 116: extern int hex_output;
117: extern int fortran_output;
1.6 noro 118: extern int double_output;
1.10 noro 119: extern int real_digit;
1.26 ! noro 120: extern int real_binary;
1.14 noro 121: extern int print_quote;
1.1 noro 122:
1.22 saito 123:
1.1 noro 124: #define TAIL while ( *OUT ) OUT++;
125: #define PUTS(s) strcat(OUT,s)
126: #define PRINTF sprintf
127: #define PRINTN sprintn
128: #define PRINTBF sprintbf
129: #define PRINTCPLX sprintcplx
1.2 noro 130: #define PRINTLM sprintlm
131: #define PRINTUP2 sprintup2
1.1 noro 132: #define PRINTV sprintv
133: #define PRINTEXPR sprintexpr
134: #define PRINTNUM sprintnum
1.20 noro 135: #define PRINTP asir_sprintp
1.1 noro 136: #define PRINTR sprintr
137: #define PRINTLIST sprintlist
138: #define PRINTVECT sprintvect
139: #define PRINTMAT sprintmat
140: #define PRINTSTR sprintstr
141: #define PRINTCOMP sprintcomp
142: #define PRINTDP sprintdp
1.2 noro 143: #define PRINTUI sprintui
144: #define PRINTGF2MAT sprintgf2mat
145: #define PRINTGFMMAT sprintgfmmat
1.5 noro 146: #define PRINTBYTEARRAY sprintbytearray
1.13 noro 147: #define PRINTQUOTE sprintquote
1.2 noro 148: #define PRINTERR sprinterr
149: #define PRINTLF sprintlf
150: #define PRINTLOP sprintlop
151: #define PRINTFOP sprintfop
152: #define PRINTEOP sprinteop
153: #define PRINTQOP sprintqop
154: #define PRINTUP sprintup
1.16 noro 155: #define PRINTUM sprintum
156: #define PRINTSF sprintsf
1.26 ! noro 157: #define PRINTSYMBOL sprintsymbol
1.1 noro 158: #endif
159:
160: void PRINTEXPR();
161: void PRINTNUM();
162: void PRINTN();
163: void PRINTV();
164: void PRINTP();
165: void PRINTR();
166: void PRINTLIST();
167: void PRINTVECT();
168: void PRINTMAT();
169: void PRINTSTR();
170: void PRINTCOMP();
171: void PRINTDP();
1.2 noro 172: void PRINTUI();
173: void PRINTGF2MAT();
174: void PRINTGFMMAT();
1.5 noro 175: void PRINTBYTEARRAY();
1.13 noro 176: void PRINTQUOTE();
1.2 noro 177: void PRINTERR();
1.1 noro 178: void PRINTCPLX();
1.2 noro 179: void PRINTLM();
180: void PRINTLF();
181: void PRINTUP2();
1.17 noro 182: void PRINTUP();
183: void PRINTUM();
184: void PRINTFOP();
185: void PRINTEOP();
186: void PRINTLOP();
187: void PRINTQOP();
188: void PRINTSF();
1.26 ! noro 189: void PRINTSYMBOL();
1.1 noro 190:
191: #ifdef FPRINT
192: void output_init() {
193: OUT = stdout;
194: sprintf(DFORMAT,"%%0%dd",DLENGTH);
195: }
196:
197: int mmono(p)
198: P p;
199: {
200: if ( NUM(p) )
1.9 saito 201: #if defined(INTERVAL)
1.18 kondoh 202: if ( NID(p) != N_IP && NID(p) != N_IntervalDouble && NID(p) != N_IntervalQuad && NID(p) != N_IntervalBigFloat
1.14 noro 203: && compnum(CO,(Num)p,0) < 0 )
1.9 saito 204: #else
1.1 noro 205: if ( compnum(CO,(Num)p,0) < 0 )
1.9 saito 206: #endif
1.1 noro 207: return ( 1 );
208: else
209: return ( 0 );
210: else if ( NEXT(DC(p)) )
211: return ( 0 );
212: else
213: return (mmono(COEF(DC(p))));
214: }
215:
1.21 ohara 216: #if defined(PARI)
1.2 noro 217: void printbf(a)
1.1 noro 218: BF a;
219: {
1.7 noro 220: sor(a->body,double_output ? 'f' : 'g',-1,0);
1.1 noro 221: }
222: #endif
223: #endif
224:
225: #ifdef SPRINT
226: void soutput_init(s)
227: char *s;
228: {
229: s[0] = 0; buf = s;
230: }
231:
1.21 ohara 232: #if defined(PARI)
1.8 noro 233: void myoutbrute(g)
234: GEN g;
235: {
236: bruteall(g,'f',-1,1);
237: }
238:
1.1 noro 239: void sprintbf(a)
240: BF a;
241: {
242: char *str;
1.8 noro 243: char *GENtostr0();
1.1 noro 244:
1.8 noro 245: if ( double_output ) {
246: str = GENtostr0(a->body,myoutbrute);
247: } else {
248: str = GENtostr(a->body);
249: }
1.1 noro 250: TAIL PRINTF(OUT,"%s",str);
251: free(str);
252: }
253: #endif
254: #endif
255:
256: void PRINTEXPR(vl,p)
257: VL vl;
258: Obj p;
259: {
260: if ( !p ) {
261: PRINTR(vl,(R)p);
262: return;
263: }
264:
265: switch ( OID(p) ) {
266: case O_N:
267: PRINTNUM((Num)p); break;
268: case O_P:
269: PRINTP(vl,(P)p); break;
270: case O_R:
271: PRINTR(vl,(R)p); break;
272: case O_LIST:
273: PRINTLIST(vl,(LIST)p); break;
274: case O_VECT:
275: PRINTVECT(vl,(VECT)p); break;
276: case O_MAT:
277: PRINTMAT(vl,(MAT)p); break;
278: case O_STR:
279: PRINTSTR((STRING)p); break;
280: case O_COMP:
281: PRINTCOMP(vl,(COMP)p); break;
282: case O_DP:
283: PRINTDP(vl,(DP)p); break;
1.2 noro 284: case O_USINT:
285: PRINTUI(vl,(USINT)p); break;
286: case O_GF2MAT:
287: PRINTGF2MAT(vl,(GF2MAT)p); break;
288: case O_ERR:
289: PRINTERR(vl,(ERR)p); break;
290: case O_MATHCAP:
291: PRINTLIST(vl,((MATHCAP)p)->body); break;
292: case O_F:
293: PRINTLF(vl,(F)p); break;
294: case O_GFMMAT:
295: PRINTGFMMAT(vl,(GFMMAT)p); break;
1.5 noro 296: case O_BYTEARRAY:
297: PRINTBYTEARRAY(vl,(BYTEARRAY)p); break;
1.13 noro 298: case O_QUOTE:
299: PRINTQUOTE(vl,(QUOTE)p); break;
1.26 ! noro 300: case O_SYMBOL:
! 301: PRINTSYMBOL((Symbol)p); break;
1.1 noro 302: default:
303: break;
304: }
305: }
306:
307: void PRINTN(n)
308: N n;
309: {
310: register int i,*ptr;
311: N tn;
312:
313: if ( !n ) {
314: PUTS("0");
315: return;
316: }
1.2 noro 317: if ( hex_output ) {
318: ptr = BD(n);
319: TAIL PRINTF(OUT,"0x%x",ptr[PL(n)-1]);
320: if ( hex_output < 0 )
321: for ( i = PL(n) - 2; i >= 0; i-- ) {
322: TAIL PRINTF(OUT,"|%08x",ptr[i]);
323: }
324: else
325: for ( i = PL(n) - 2; i >= 0; i-- ) {
326: TAIL PRINTF(OUT,"%08x",ptr[i]);
327: }
328: } else {
329: ntobn(DBASE,n,&tn);
330: ptr = BD(tn);
331: TAIL PRINTF(OUT,"%d",ptr[PL(tn) - 1]);
332: for ( i = PL(tn) - 2; i >= 0; i-- ) {
333: TAIL PRINTF(OUT,DFORMAT,ptr[i]);
334: }
1.1 noro 335: }
336: }
337:
1.15 noro 338: #if defined(FPRINT)
339: #if defined(ITVDEBUG)
340: void printbin(double z)
341: {
342: int i, j, mask;
343: union {
344: double x;
345: char c[8];
346: } a;
347:
348: a.x = z;
349: for(i=7;i>=0;i--) {
350: mask = 0x80;
351: for(j=0;j<8;j++) {
352: if (a.c[i] & mask) fprintf(stderr,"1");
353: else fprintf(stderr,"0");
354: mask >>= 1;
355: }
356: }
357: fprintf(stderr,"\n");
358: }
359: #endif
360: #endif
361:
362: #if defined(FPRINT)
363: #if 0
364: int printmode = PRINTF_E;
365: #else
366: int printmode = PRINTF_G;
367: #endif
368: #else
369: extern int printmode;
370: #endif
1.9 saito 371:
1.1 noro 372: void PRINTNUM(q)
373: Num q;
374: {
1.10 noro 375: char real_format[20];
376:
1.1 noro 377: if ( !q ) {
378: PUTS("0");
379: return;
380: }
381: switch ( NID(q) ) {
382: case N_Q:
383: if ( SGN((Q)q) == -1 )
384: PUTS("-");
385: PRINTN(NM((Q)q));
386: if ( !INT((Q)q) ) {
387: PUTS("/"); PRINTN(DN((Q)q));
388: }
389: break;
390: case N_R:
1.9 saito 391: switch (printmode) {
392: case PRINTF_E:
393: #if defined(INTERVAL)
394: case MID_PRINTF_E:
395: #endif
1.14 noro 396: TAIL PRINTF(OUT,"%.16e",BDY((Real)q));
1.9 saito 397: break;
398: case PRINTF_G:
399: #if defined(INTERVAL)
400: case MID_PRINTF_G:
401: #endif
402: default:
1.26 ! noro 403: if ( real_binary ) {
! 404: unsigned int *m;
! 405: unsigned int u,l,mask;
! 406: int i,expo;
! 407:
! 408: m = (unsigned int *)&BDY((Real)q);
! 409: #if defined(__i386__) || defined(MIPSEL) || defined(VISUAL) || defined(__alpha) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__x86_64)
! 410: u = m[1]; l = m[0];
! 411: #else
! 412: u = m[0]; l = m[1];
! 413: #endif
! 414: if (u&0x80000000) {
! 415: TAIL PRINTF(OUT,"-");
! 416: }
! 417: u &= 0x7fffffff;
! 418: expo = ((int)(u>>20));
! 419: u &= 0xfffff;
! 420: if ( expo == 2047 ) {
! 421: if ( u || l ) {
! 422: TAIL PRINTF(OUT,"NaN");
! 423: } else {
! 424: TAIL PRINTF(OUT,"Inf");
! 425: }
! 426: } else if ( expo == 0 ) {
! 427: if ( u || l ) {
! 428: TAIL PRINTF(OUT,"0b0.");
! 429: for ( i = 0, mask = 0x80000; i < 20;
! 430: i++, mask >>= 1) {
! 431: TAIL
! 432: if ( u&mask )
! 433: PRINTF(OUT,"1");
! 434: else
! 435: PRINTF(OUT,"0");
! 436: }
! 437: for ( i = 0, mask = 0x80000000; i < 32;
! 438: i++, mask >>= 1) {
! 439: TAIL
! 440: if ( l&mask )
! 441: PRINTF(OUT,"1");
! 442: else
! 443: PRINTF(OUT,"0");
! 444: }
! 445: TAIL PRINTF(OUT,"*2^%d",-1022);
! 446: } else {
! 447: TAIL PRINTF(OUT,"0");
! 448: }
! 449: } else {
! 450: expo -= 1023;
! 451: TAIL PRINTF(OUT,"0b1.");
! 452: for ( i = 0, mask = 0x80000; i < 20;
! 453: i++, mask >>= 1) {
! 454: TAIL
! 455: if ( u&mask )
! 456: PRINTF(OUT,"1");
! 457: else
! 458: PRINTF(OUT,"0");
! 459: }
! 460: for ( i = 0, mask = 0x80000000; i < 32;
! 461: i++, mask >>= 1) {
! 462: TAIL
! 463: if ( l&mask )
! 464: PRINTF(OUT,"1");
! 465: else
! 466: PRINTF(OUT,"0");
! 467: }
! 468: if ( expo ) {
! 469: TAIL PRINTF(OUT,"*2^%d",expo);
! 470: }
! 471: }
! 472: } else if ( real_digit ) {
1.14 noro 473: sprintf(real_format,
474: double_output?"%%.%df":"%%.%dg",real_digit);
475: TAIL PRINTF(OUT,real_format,BDY((Real)q));
476: } else {
477: TAIL PRINTF(OUT,double_output?"%f":"%g",BDY((Real)q));
478: }
479: break;
1.9 saito 480: }
1.1 noro 481: break;
482: case N_A:
483: PUTS("("); PRINTR(ALG,(R)BDY((Alg)q)); PUTS(")");
484: break;
1.21 ohara 485: #if defined(PARI)
1.1 noro 486: case N_B:
487: PRINTBF((BF)q); break;
1.9 saito 488: #endif
489: #if defined(INTERVAL)
490: case N_IP:
1.18 kondoh 491: case N_IntervalBigFloat:
1.23 saito 492: switch ( outputstyle ) {
493: case 1:
494: PUTS("intval(");
495: PRINTNUM(INF((Itv)q));
496: PUTS(",");
497: PRINTNUM(SUP((Itv)q));
498: PUTS(")");
499: break;
1.24 saito 500: case 0:
1.23 saito 501: default:
502: PUTS("[");
503: PRINTNUM(INF((Itv)q));
504: PUTS(",");
505: PRINTNUM(SUP((Itv)q));
506: PUTS("]");
507: break;
1.22 saito 508: }
1.9 saito 509: break;
1.18 kondoh 510: case N_IntervalDouble:
1.9 saito 511: switch (printmode) {
512: case PRINTF_E:
1.23 saito 513: switch ( outputstyle ) {
514: case 1:
515: TAIL PRINTF(OUT, "intval(%.16e,%.16e)",
516: INF((IntervalDouble)q),SUP((IntervalDouble)q));
517: break;
1.24 saito 518: case 0:
1.23 saito 519: default:
520: TAIL PRINTF(OUT, "[%.16e,%.16e]",
521: INF((IntervalDouble)q),SUP((IntervalDouble)q));
522: break;
1.22 saito 523: }
1.9 saito 524: #if defined(ITVDEBUG)
1.18 kondoh 525: printbin(INF((IntervalDouble)q));
526: printbin(SUP((IntervalDouble)q));
1.9 saito 527: #endif
528: break;
529: case MID_PRINTF_G:
1.23 saito 530: switch ( outputstyle ) {
531: case 1:
532: TAIL PRINTF(OUT, "intvalm(%g,%g)",
533: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
534: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
535: break;
1.24 saito 536: case 0:
1.23 saito 537: default:
538: TAIL PRINTF(OUT, "<%g,%g>",
539: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
540: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
541: break;
1.22 saito 542: }
1.9 saito 543: break;
544: case MID_PRINTF_E:
1.23 saito 545: switch ( outputstyle ) {
546: case 1:
547: TAIL PRINTF(OUT, "intvalm(%.16e,%.16e)",
548: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
549: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
550: break;
1.24 saito 551: case 0:
1.23 saito 552: default:
553: TAIL PRINTF(OUT, "<%.16e,%.16e>",
554: (SUP((IntervalDouble)q)+INF((IntervalDouble)q))*0.5,
555: (SUP((IntervalDouble)q)-INF((IntervalDouble)q))*0.5);
556: break;
1.22 saito 557: }
1.9 saito 558: break;
559: case PRINTF_G:
560: default:
1.23 saito 561: switch ( outputstyle ) {
562: case 1:
563: TAIL PRINTF(OUT, "intval(%g,%g)",
564: INF((IntervalDouble)q),SUP((IntervalDouble)q));
565: break;
1.24 saito 566: case 0:
1.23 saito 567: default:
568: TAIL PRINTF(OUT, "[%g,%g]",
569: INF((IntervalDouble)q),SUP((IntervalDouble)q));
570: break;
1.22 saito 571: }
1.9 saito 572: break;
573: }
574: break;
1.1 noro 575: #endif
576: case N_C:
577: PRINTCPLX((C)q); break;
578: case N_M:
1.2 noro 579: TAIL PRINTF(OUT,"%d",CONT((MQ)q)); break;
580: case N_LM:
581: PRINTN(((LM)q)->body); break;
582: case N_GF2N:
583: if ( hex_output )
584: PRINTN((N)(((GF2N)q)->body));
585: else
586: PRINTUP2(((GF2N)q)->body);
587: break;
588: case N_GFPN:
589: PRINTUP((UP)(((GFPN)q)->body));
1.1 noro 590: break;
1.11 noro 591: case N_GFS:
1.14 noro 592: TAIL PRINTF(OUT,"@_%d",CONT((GFS)q));
593: break;
1.16 noro 594: case N_GFSN:
595: PRINTUM(BDY((GFSN)q));
596: break;
1.1 noro 597: }
598: }
599:
600: void PRINTCPLX(a)
601: C a;
602: {
603: PUTS("(");
604: if ( a->r )
605: PRINTNUM(a->r);
606: if ( a->i ) {
1.14 noro 607: #if defined(INTERVAL)
608: if ( a->r && ((compnum(0,a->i,0) > 0)
1.18 kondoh 609: || NID(a->i) == N_IP || NID(a->i) == N_IntervalDouble
610: || NID(a->i) == N_IntervalQuad || NID(a->i) == N_IntervalBigFloat) )
1.14 noro 611: #else
1.1 noro 612: if ( a->r && (compnum(0,a->i,0) > 0) )
1.14 noro 613: #endif
1.1 noro 614: PUTS("+");
615: PRINTNUM(a->i); PUTS("*@i");
616: }
617: PUTS(")");
618: }
619:
620: void PRINTP(vl,p)
621: VL vl;
622: P p;
623: {
624: V v;
625: DCP dc;
626:
627: if ( !p )
628: PUTS("0");
629: else if ( NUM(p) )
630: PRINTNUM((Num)p);
631: else
632: for ( dc = DC(p), v = VR(p); dc; dc = NEXT(dc) ) {
633: if ( !DEG(dc) )
634: PRINTP(vl,COEF(dc));
635: else {
636: if ( NUM(COEF(dc)) && UNIQ((Q)COEF(dc)) ) {
637: ;
638: } else if ( NUM(COEF(dc)) && MUNIQ((Q)COEF(dc)) )
639: PUTS("-");
640: else if ( NUM(COEF(dc)) || !NEXT(DC(COEF(dc)))) {
641: PRINTP(vl,COEF(dc)); PUTS("*");
642: } else {
643: PUTS("("); PRINTP(vl,COEF(dc)); PUTS(")*");
644: }
645: PRINTV(vl,v);
646: if ( cmpq(DEG(dc),ONE) ) {
1.2 noro 647: PRINTHAT;
1.1 noro 648: if ( INT(DEG(dc)) && SGN(DEG(dc))>0 )
649: PRINTNUM((Num)DEG(dc));
650: else {
651: PUTS("("); PRINTNUM((Num)DEG(dc)); PUTS(")");
652: }
653: }
654: }
655: if ( NEXT(dc) ) {
656: P t;
657:
658: t = COEF(NEXT(dc));
659: if (!DEG(NEXT(dc))) {
660: if ( NUM(t) ) {
661: if ( !mmono(t) )
662: PUTS("+");
663: } else {
664: if (!mmono(COEF(DC(t))))
665: PUTS("+");
666: }
667: } else {
668: if ( !mmono(t) )
669: PUTS("+");
670: }
671: }
672: }
673: }
674:
1.2 noro 675: int hideargs;
676:
1.1 noro 677: void PRINTV(vl,v)
678: VL vl;
679: V v;
680: {
681: PF pf;
682: PFAD ad;
683: int i;
684:
685: if ( NAME(v) )
686: PUTS(NAME(v));
687: else if ( (vid)v->attr == V_PF ) {
688: pf = ((PFINS)v->priv)->pf; ad = ((PFINS)v->priv)->ad;
689: if ( !strcmp(NAME(pf),"pow") ) {
1.19 noro 690: PUTS("(("); PRINTR(vl,(R)ad[0].arg); PUTS(")"); PRINTHAT; PUTS("(");
691: PRINTR(vl,(R)ad[1].arg); PUTS("))");
1.1 noro 692: } else if ( !pf->argc ) {
693: TAIL PRINTF(OUT,"%s",NAME(pf));
694: } else {
1.2 noro 695: if ( hideargs ) {
696: for ( i = 0; i < pf->argc; i++ )
697: if ( ad[i].d )
698: break;
699: if ( i < pf->argc ) {
700: TAIL PRINTF(OUT,"%s{%d",NAME(pf),ad[0].d);
701: for ( i = 1; i < pf->argc; i++ ) {
702: TAIL PRINTF(OUT,",%d",ad[i].d);
703: }
704: PUTS("}");
705: } else {
706: TAIL PRINTF(OUT,"%s",NAME(pf));
707: }
708: } else {
709: for ( i = 0; i < pf->argc; i++ )
710: if ( ad[i].d )
711: break;
712: if ( i < pf->argc ) {
713: TAIL PRINTF(OUT,"%s{%d",NAME(pf),ad[0].d);
714: for ( i = 1; i < pf->argc; i++ ) {
715: TAIL PRINTF(OUT,",%d",ad[i].d);
716: }
717: PUTS("}(");
718: } else {
719: TAIL PRINTF(OUT,"%s(",NAME(pf));
720: }
721: PRINTR(vl,(R)ad[0].arg);
1.1 noro 722: for ( i = 1; i < pf->argc; i++ ) {
1.2 noro 723: PUTS(","); PRINTR(vl,(R)ad[i].arg);
1.1 noro 724: }
1.2 noro 725: PUTS(")");
1.1 noro 726: }
727: }
728: }
729: }
730:
731: void PRINTR(vl,a)
732: VL vl;
733: R a;
734: {
735: if ( !a )
736: PUTS("0");
737: else
738: switch (OID(a)) {
739: case O_N: case O_P:
740: PRINTP(vl,(P)a); break;
741: default:
742: PUTS("("); PRINTP(vl,NM((R)a)); PUTS(")/("); PRINTP(vl,DN((R)a)); PUTS(")");
743: break;
744: }
745: }
746:
747: void PRINTVECT(vl,vect)
748: VL vl;
749: VECT vect;
750: {
751: int i;
752: pointer *ptr;
753:
1.23 saito 754: switch ( outputstyle ) {
755: case 1:
756: PUTS("vect(");
757: for ( i = 0, ptr = BDY(vect); i < vect->len; i++ ) {
1.24 saito 758: if ( i != 0 ) PUTS(",");
1.23 saito 759: PRINTEXPR(vl,ptr[i]);
760: }
761: PUTS(")");
762: break;
1.24 saito 763: case 0:
1.23 saito 764: default:
765: PUTS("[ ");
766: for ( i = 0, ptr = BDY(vect); i < vect->len; i++ ) {
767: PRINTEXPR(vl,ptr[i]); PUTS(" ");
768: }
769: PUTS("]");
770: break;
1.1 noro 771: }
772: }
773:
774: void PRINTMAT(vl,mat)
775: VL vl;
776: MAT mat;
777: {
778: int i,j,r,c;
779: pointer *ptr;
780:
1.23 saito 781: switch ( outputstyle ) {
782: case 1:
783: PUTS("mat(\n");
784: for ( i = 0, r = mat->row, c = mat->col; i < r; i++ ) {
785: if ( i != 0 ) PUTS(",\n");
786: PUTS("[ ");
787: for ( j = 0, ptr = BDY(mat)[i]; j < c; j++ ) {
1.24 saito 788: if ( j != 0 ) PUTS(",");
1.23 saito 789: PRINTEXPR(vl,ptr[j]);
790: }
1.24 saito 791: PUTS(" ]");
1.22 saito 792: }
1.23 saito 793: PUTS(")");
794: break;
1.24 saito 795: case 0:
1.23 saito 796: default:
797: for ( i = 0, r = mat->row, c = mat->col; i < r; i++ ) {
798: PUTS("[ ");
799: for ( j = 0, ptr = BDY(mat)[i]; j < c; j++ ) {
800: PRINTEXPR(vl,ptr[j]); PUTS(" ");
801: }
802: PUTS("]");
803: if ( i < r - 1 )
804: PUTS("\n");
1.22 saito 805: }
1.23 saito 806: break;
1.1 noro 807: }
808: }
809:
810: void PRINTLIST(vl,list)
811: VL vl;
812: LIST list;
813: {
814: NODE tnode;
815:
816: PUTS("[");
817: for ( tnode = (NODE)list->body; tnode; tnode = NEXT(tnode) ) {
818: PRINTEXPR(vl,tnode->body);
819: if ( NEXT(tnode) )
820: PUTS(",");
821: }
822: PUTS("]");
823: }
824:
825: void PRINTSTR(str)
826: STRING str;
827: {
828: char *p;
829:
830: for ( p = BDY(str); *p; p++ )
831: if ( *p == '"' )
832: PUTS("\"");
833: else {
834: TAIL PRINTF(OUT,"%c",*p);
835: }
836: }
837:
838: void PRINTCOMP(vl,c)
839: VL vl;
840: COMP c;
841: {
842: int n,i;
843:
844: n = getcompsize((int)c->type);
845: PUTS("{");
846: for ( i = 0; i < n; i++ ) {
847: PRINTEXPR(vl,(pointer)c->member[i]);
848: if ( i < n-1 )
849: PUTS(",");
850: }
851: PUTS("}");
852: }
853:
854: void PRINTDP(vl,d)
855: VL vl;
856: DP d;
857: {
858: int n,i;
859: MP m;
860: DL dl;
861:
862: for ( n = d->nv, m = BDY(d); m; m = NEXT(m) ) {
863: PUTS("("); PRINTEXPR(vl,(pointer)m->c); PUTS(")*<<");
864: for ( i = 0, dl = m->dl; i < n-1; i++ ) {
865: TAIL PRINTF(OUT,"%d,",dl->d[i]);
866: }
867: TAIL PRINTF(OUT,"%d",dl->d[i]);
868: PUTS(">>");
869: if ( NEXT(m) )
870: PUTS("+");
1.2 noro 871: }
872: }
873:
874: void PRINTUI(vl,u)
875: VL vl;
876: USINT u;
877: {
878: TAIL PRINTF(OUT,"%u",BDY(u));
879: }
880:
881: void PRINTGF2MAT(vl,mat)
882: VL vl;
883: GF2MAT mat;
884: {
885: int row,col,w,i,j,k,m;
886: unsigned int t;
887: unsigned int **b;
888:
889: row = mat->row;
890: col = mat->col;
891: w = (col+BSH-1)/BSH;
892: b = mat->body;
893: for ( i = 0; i < row; i++ ) {
894: for ( j = 0, m = 0; j < w; j++ ) {
895: t = b[i][j];
896: for ( k = 0; m < col && k < BSH; k++, m++ )
897: if ( t & (1<<k) )
898: PUTS("1");
899: else
900: PUTS("0");
901: }
902: PUTS("\n");
903: }
904: }
905:
906: void PRINTGFMMAT(vl,mat)
907: VL vl;
908: GFMMAT mat;
909: {
910: int row,col,i,j;
911: unsigned int **b;
912:
913: row = mat->row;
914: col = mat->col;
915: b = mat->body;
916: for ( i = 0; i < row; i++ ) {
917: PUTS("[");
918: for ( j = 0; j < col; j++ ) {
919: TAIL PRINTF(OUT,"%8d",b[i][j]);
920: }
921: PUTS("]\n");
922: }
1.5 noro 923: }
924:
925: void PRINTBYTEARRAY(vl,array)
926: VL vl;
927: BYTEARRAY array;
928: {
929: int len,i;
930: unsigned char *b;
931:
932: len = array->len;
1.8 noro 933: b = array->body;
1.5 noro 934: PUTS("|");
935: for ( i = 0; i < len-1; i++ ) {
1.8 noro 936: TAIL PRINTF(OUT,"%02x ",(unsigned int)b[i]);
1.5 noro 937: }
1.8 noro 938: TAIL PRINTF(OUT,"%02x",(unsigned int)b[i]);
1.5 noro 939: PUTS("|");
1.13 noro 940: }
941:
942: void PRINTQUOTE(vl,quote)
943: VL vl;
944: QUOTE quote;
945: {
1.15 noro 946: LIST list;
947:
948: if ( print_quote ) {
949: fnodetotree(BDY(quote),&list);
950: PRINTEXPR(vl,(Obj)list);
951: } else {
952: PUTS("<...quoted...>");
953: }
1.2 noro 954: }
955:
956: void PRINTERR(vl,e)
957: VL vl;
958: ERR e;
959: {
960: PUTS("error("); PRINTEXPR(vl,e->body); PUTS(")");
961: }
962:
963: void PRINTUP2(p)
964: UP2 p;
965: {
966: int d,i;
967:
968: if ( !p ) {
969: TAIL PRINTF(OUT,"0");
970: } else {
971: d = degup2(p);
972: TAIL PRINTF(OUT,"(");
973: if ( !d ) {
974: TAIL PRINTF(OUT,"1");
975: } else if ( d == 1 ) {
976: TAIL PRINTF(OUT,"@");
977: } else {
978: PUTS("@"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
979: }
980: for ( i = d-1; i >= 0; i-- ) {
981: if ( p->b[i/BSH] & (1<<(i%BSH)) )
982: if ( !i ) {
983: TAIL PRINTF(OUT,"+1");
984: } else if ( i == 1 ) {
985: TAIL PRINTF(OUT,"+@");
986: } else {
987: PUTS("+@"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
988: }
989: }
990: TAIL PRINTF(OUT,")");
991: }
992: }
993:
994: void PRINTLF(vl,f)
995: VL vl;
996: F f;
997: {
998: switch ( FOP(f) ) {
999: case AL_TRUE:
1000: TAIL PRINTF(OUT,"@true");
1001: break;
1002: case AL_FALSE:
1003: TAIL PRINTF(OUT,"@false");
1004: break;
1005:
1006: case AL_OR: case AL_AND:
1007: PRINTFOP(vl,f); break;
1008: case AL_NOT: case AL_IMPL: case AL_REPL: case AL_EQUIV:
1009: PRINTEOP(vl,f); break;
1010:
1011: case AL_EQUAL: case AL_NEQ: case AL_LESSP:
1012: case AL_GREATERP: case AL_LEQ: case AL_GEQ:
1013: PRINTLOP(vl,f); break;
1014:
1015: case AL_EX: case AL_ALL:
1016: PRINTQOP(vl,f); break;
1017: default:
1018: break;
1019: }
1020: }
1021:
1.17 noro 1022: void PRINTFOP(vl,f)
1.2 noro 1023: VL vl;
1024: F f;
1025: {
1026: char *op;
1027: NODE n;
1028:
1029: op = FOP(f)==AL_OR?" @|| ":" @&& ";
1030: n = FJARG(f);
1031: PUTS("("); PRINTEXPR(vl,BDY(n)); PUTS(")");
1032: for ( n = NEXT(n); n; n = NEXT(n) ) {
1033: PUTS(op); PUTS("("); PRINTEXPR(vl,BDY(n)); PUTS(")");
1034: }
1035: }
1036:
1.17 noro 1037: void PRINTEOP(vl,f)
1.2 noro 1038: VL vl;
1039: F f;
1040: {
1041: oFOP op;
1042: char *sop;
1043:
1044: if ( (op = FOP(f)) == AL_NOT ) {
1045: PUTS("(@! "); PRINTEXPR(vl,(Obj)FARG(f)); PUTS(")"); return;
1046: }
1047: switch ( op ) {
1048: case AL_IMPL:
1049: sop = " @impl "; break;
1050: case AL_REPL:
1051: sop = " @repl "; break;
1052: case AL_EQUIV:
1053: sop = " @equiv "; break;
1054: default:
1055: break;
1056: }
1057: PUTS("(");
1058: PRINTEXPR(vl,(Obj)FLHS(f));
1059: PUTS(sop);
1060: PRINTEXPR(vl,(Obj)FRHS(f));
1061: PUTS(")");
1062: }
1063:
1.17 noro 1064: void PRINTLOP(vl,f)
1.2 noro 1065: VL vl;
1066: F f;
1067: {
1068: char *op;
1069:
1070: switch ( FOP(f) ) {
1071: case AL_EQUAL:
1072: op = " @== "; break;
1073: case AL_NEQ:
1074: op = " @!= "; break;
1075: case AL_LESSP:
1076: op = " @< "; break;
1077: case AL_GREATERP:
1078: op = " @> "; break;
1079: case AL_LEQ:
1080: op = " @<= "; break;
1081: case AL_GEQ:
1082: op = " @>= "; break;
1083: default:
1084: error("PRINTLOP : invalid operator");
1085: break;
1086: }
1087: PRINTEXPR(vl,(Obj)FPL(f)); PUTS(op); PUTS("0");
1088: }
1089:
1.17 noro 1090: void PRINTQOP(vl,f)
1.2 noro 1091: VL vl;
1092: F f;
1093: {
1094: char *op;
1095:
1096: op = FOP(f)==AL_EX?"ex":"all";
1097: TAIL PRINTF(OUT,"%s(%s,",op,NAME(FQVR(f)));
1098: PRINTEXPR(vl,(Obj)FQMAT(f)); PUTS(")");
1099: }
1100:
1.17 noro 1101: void PRINTUP(n)
1.2 noro 1102: UP n;
1103: {
1104: int i,d;
1105:
1106: if ( !n )
1107: PUTS("0");
1108: else if ( !n->d )
1109: PRINTNUM(n->c[0]);
1110: else {
1111: d = n->d;
1112: PUTS("(");
1113: if ( !d ) {
1114: PRINTNUM(n->c[d]);
1115: } else if ( d == 1 ) {
1116: PRINTNUM(n->c[d]);
1117: PUTS("*@p");
1118: } else {
1119: PRINTNUM(n->c[d]);
1120: PUTS("*@p"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
1121: }
1122: for ( i = d-1; i >= 0; i-- ) {
1123: if ( n->c[i] ) {
1124: PUTS("+("); PRINTNUM(n->c[i]); PUTS(")");
1125: if ( i >= 2 ) {
1126: PUTS("*@p"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
1127: } else if ( i == 1 )
1128: PUTS("*@p");
1129: }
1130: }
1131: PUTS(")");
1.16 noro 1132: }
1133: }
1134:
1.17 noro 1135: void PRINTUM(n)
1.16 noro 1136: UM n;
1137: {
1138: int i,d;
1139:
1140: if ( !n )
1141: PUTS("0");
1142: else if ( !n->d )
1143: PRINTSF(n->c[0]);
1144: else {
1145: d = n->d;
1146: PUTS("(");
1147: if ( !d ) {
1148: PRINTSF(n->c[d]);
1149: } else if ( d == 1 ) {
1150: PRINTSF(n->c[d]);
1151: PUTS("*@s");
1152: } else {
1153: PRINTSF(n->c[d]);
1154: PUTS("*@s"); PRINTHAT; TAIL PRINTF(OUT,"%d",d);
1155: }
1156: for ( i = d-1; i >= 0; i-- ) {
1157: if ( n->c[i] ) {
1158: PUTS("+("); PRINTSF(n->c[i]); PUTS(")");
1159: if ( i >= 2 ) {
1160: PUTS("*@s"); PRINTHAT; TAIL PRINTF(OUT,"%d",i);
1161: } else if ( i == 1 )
1162: PUTS("*@s");
1163: }
1164: }
1165: PUTS(")");
1166: }
1167: }
1168:
1.17 noro 1169: void PRINTSF(i)
1.16 noro 1170: unsigned int i;
1171: {
1172: if ( !i ) {
1173: PUTS("0");
1174: } else {
1175: TAIL PRINTF(OUT,"@_%d",IFTOF(i));
1.1 noro 1176: }
1.26 ! noro 1177: }
! 1178:
! 1179: void PRINTSYMBOL(Symbol p)
! 1180: {
! 1181: PUTS(p->name);
1.1 noro 1182: }