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