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