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