Annotation of OpenXM_contrib2/asir2018/builtin/itvnum.c, Revision 1.3
1.1 noro 1: /*
1.3 ! kondoh 2: * $OpenXM: OpenXM_contrib2/asir2018/builtin/itvnum.c,v 1.2 2018/09/28 08:20:27 noro Exp $
1.1 noro 3: */
4:
5: #include "ca.h"
6: #include "parse.h"
7: #include "version.h"
8: #if !defined(ANDROID)
9: #include "../plot/ifplot.h"
10: #endif
11:
1.3 ! kondoh 12: // in engine/bf.c
! 13: Num tobf(Num,int);
! 14:
1.1 noro 15: #if defined(INTERVAL)
16: static void Pitv(NODE, Obj *);
17: static void Pitvd(NODE, Obj *);
18: static void Pitvbf(NODE, Obj *);
19: static void Pinf(NODE, Obj *);
20: static void Psup(NODE, Obj *);
21: static void Pmid(NODE, Obj *);
22: static void Pabsitv(NODE, Obj *);
23: static void Pdisjitv(NODE, Obj *);
24: static void Pinitv(NODE, Obj *);
25: static void Pcup(NODE, Obj *);
26: static void Pcap(NODE, Obj *);
27: static void Pwidth(NODE, Obj *);
28: static void Pdistance(NODE, Obj *);
1.3 ! kondoh 29: static void Pitvversion(NODE, Q *);
! 30: static void PzeroRewriteMode(NODE, Obj *);
! 31: static void PzeroRewriteCountClear(NODE, Obj *);
! 32: static void PzeroRewriteCount(NODE, Obj *);
! 33: //void miditvp(Itv,Num *);
! 34: //void absitvp(Itv,Num *);
! 35: //int initvd(Num,IntervalDouble);
! 36: //int initvp(Num,Itv);
! 37: //int itvinitvp(Itv,Itv);
1.1 noro 38: #endif
39: static void Pprintmode(NODE, Obj *);
40:
41: /* plot time check func */
42: static void ccalc(double **, struct canvas *, int);
43: static void Pifcheck(NODE, Obj *);
44:
45: #if defined(__osf__) && 0
46: int end;
47: #endif
48:
49: struct ftab interval_tab[] = {
50: {"printmode",Pprintmode,1},
51: #if defined(INTERVAL)
52: {"itvd",Pitvd,-2},
53: {"intvald",Pitvd,-2},
54: {"itv",Pitv,-2},
55: {"intval",Pitv,-2},
56: {"itvbf",Pitvbf,-2},
57: {"intvalbf",Pitvbf,-2},
58: {"inf",Pinf,1},
59: {"sup",Psup,1},
60: {"absintval",Pabsitv,1},
61: {"disintval",Pdisjitv,2},
62: {"inintval",Pinitv,2},
63: {"cup",Pcup,2},
64: {"cap",Pcap,2},
65: {"mid",Pmid,1},
66: {"width",Pwidth,1},
67: {"diam",Pwidth,1},
68: {"distance",Pdistance,2},
1.3 ! kondoh 69: {"iversion",Pitvversion,-1},
! 70: {"intvalversion",Pitvversion,-1},
! 71: {"zerorewritemode",PzeroRewriteMode,-1},
! 72: {"zeroRewriteMode",PzeroRewriteMode,-1},
! 73: {"zeroRewriteCountClear",PzeroRewriteCountClear,-1},
! 74: {"zeroRewriteCount",PzeroRewriteCount,-1},
1.1 noro 75: /* plot time check */
76: {"ifcheck",Pifcheck,-7},
77: #endif
78: {0,0,0},
79: };
80:
1.3 ! kondoh 81: extern int mpfr_roundmode;
! 82:
1.1 noro 83: #if defined(INTERVAL)
84:
85: /* plot time check */
86: static void
87: Pifcheck(NODE arg, Obj *rp)
88: {
89: Q m2,p2,s_id;
90: NODE defrange;
91: LIST xrange,yrange,range[2],list,geom;
92: VL vl,vl0;
93: V v[2],av[2];
94: int ri,i,j,sign;
95: P poly;
96: P var;
97: NODE n,n0;
98: Obj t;
99:
100: struct canvas *can;
101: MAT m;
102: pointer **mb;
103: double **tabe, *px, *px1, *px2;
104: Q one;
105: int width, height, ix, iy;
106: int id;
107:
1.3 ! kondoh 108: STOQ(-2,m2); STOQ(2,p2);
! 109: STOQ(1,one);
1.1 noro 110: MKNODE(n,p2,0); MKNODE(defrange,m2,n);
111: poly = 0; vl = 0; geom = 0; ri = 0;
112: v[0] = v[1] = 0;
113: for ( ; arg; arg = NEXT(arg) ){
114: switch ( OID(BDY(arg)) ) {
115: case O_P:
116: poly = (P)BDY(arg);
117: get_vars_recursive((Obj)poly,&vl);
118: for(vl0=vl,i=0;vl0;vl0=NEXT(vl0)){
119: if(vl0->v->attr==(pointer)V_IND){
120: if(i>=2){
121: error("ifplot : invalid argument");
122: } else {
123: v[i++]=vl0->v;
124: }
125: }
126: }
127: break;
128: case O_LIST:
129: list = (LIST)BDY(arg);
130: if ( OID(BDY(BDY(list))) == O_P )
131: if ( ri > 1 )
132: error("ifplot : invalid argument");
133: else
134: range[ri++] = list;
135: else
136: geom = list;
137: break;
138: default:
139: error("ifplot : invalid argument"); break;
140: }
141: }
142: if ( !poly ) error("ifplot : invalid argument");
143: switch ( ri ) {
144: case 0:
145: if ( !v[1] ) error("ifplot : please specify all variables");
146: MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
147: MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
148: break;
149: case 1:
150: if ( !v[1] ) error("ifplot : please specify all variables");
151: av[0] = VR((P)BDY(BDY(range[0])));
152: if ( v[0] == av[0] ) {
153: xrange = range[0];
154: MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
155: } else if ( v[1] == av[0] ) {
156: MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
157: yrange = range[0];
158: } else
159: error("ifplot : invalid argument");
160: break;
161: case 2:
162: av[0] = VR((P)BDY(BDY(range[0])));
163: av[1] = VR((P)BDY(BDY(range[1])));
164: if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||
165: ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {
166: xrange = range[0]; yrange = range[1];
167: } else error("ifplot : invalid argument");
168: break;
169: default:
170: error("ifplot : cannot happen"); break;
171: }
172: can = canvas[id = search_canvas()];
173: if ( !geom ) {
174: width = 300;
175: height = 300;
176: can->width = 300;
177: can->height = 300;
178: } else {
1.3 ! kondoh 179: can->width = QTOS((Q)BDY(BDY(geom)));
! 180: can->height = QTOS((Q)BDY(NEXT(BDY(geom))));
1.1 noro 181: width = can->width;
182: height = can->height;
183: }
184: if ( xrange ) {
185: n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);
186: can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);
187: can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax);
188: }
189: if ( yrange ) {
190: n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);
191: can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);
192: can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax);
193: }
194: can->wname = "ifcheck";
195: can->formula = poly;
196: tabe = (double **)ALLOCA((width+1)*sizeof(double *));
197: for ( i = 0; i <= width; i++ )
198: tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));
199: for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;
200: ccalc(tabe,can,0);
201: MKMAT(m,width,height);
202: mb = BDY(m);
203: for( ix=0; ix<width; ix++ ){
204: for( iy=0; iy<height; iy++){
205: if ( tabe[ix][iy] >= 0 ){
206: if ( (tabe[ix+1][iy] <= 0) ||
207: (tabe[ix][iy+1] <= 0 ) ||
208: (tabe[ix+1][iy+1] <= 0 ) ) mb[ix][iy] = (Obj)one;
209: } else {
210: if ( (tabe[ix+1][iy] >= 0 ) ||
211: ( tabe[ix][iy+1] >= 0 ) ||
212: ( tabe[ix+1][iy+1] >= 0 )) mb[ix][iy] = (Obj)one;
213: }
214: }
215: }
216: *rp = (Obj)m;
217: }
218:
219: void ccalc(double **tab,struct canvas *can,int nox)
220: {
221: double x,y,xmin,ymin,xstep,ystep;
222: int ix,iy;
223: Real r,rx,ry;
224: Obj fr,g;
225: int w,h;
226: V vx,vy;
227: Obj t,s;
228:
229: MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);
230: vx = can->vx;
231: vy = can->vy;
232: w = can->width; h = can->height;
233: xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;
234: ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;
235: MKReal(1.0,rx); MKReal(1.0,ry);
236: for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {
237: BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);
238: devalr(CO,t,&g);
239: for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {
240: BDY(ry) = y;
241: substr(CO,0,g,vy,y?(Obj)ry:0,&t);
242: devalr(CO,t,&s);
243: tab[ix][iy] = ToReal(s);
244: }
245: }
246: }
247: /* end plot time check */
248:
249: static void
1.3 ! kondoh 250: Pitvversion(NODE arg, Q *rp)
1.1 noro 251: {
1.3 ! kondoh 252: STOQ(INT_ASIR_VERSION, *rp);
1.1 noro 253: }
254:
255: extern int bigfloat;
256:
257: static void
258: Pitv(NODE arg, Obj *rp)
259: {
260: Num a, i, s;
261: Itv c;
262: double inf, sup;
263:
264: #if 1
265: if ( bigfloat )
266: Pitvbf(arg, rp);
267: else
268: Pitvd(arg,rp);
269: #else
270: asir_assert(ARG0(arg),O_N,"itv");
271: if ( argc(arg) > 1 ) {
272: asir_assert(ARG1(arg),O_N,"itv");
273: istoitv((Num)ARG0(arg),(Num)ARG1(arg),&c);
274: } else {
275: a = (Num)ARG0(arg);
276: if ( ! a ) {
277: *rp = 0;
278: return;
279: }
280: else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
281: *rp = (Obj)a;
282: return;
283: }
284: else if ( NID(a) == N_IntervalDouble ) {
285: inf = INF((IntervalDouble)a);
286: sup = SUP((IntervalDouble)a);
287: double2bf(inf, (BF *)&i);
288: double2bf(sup, (BF *)&s);
289: istoitv(i,s,&c);
290: }
291: else istoitv(a,a,&c);
292: }
293: if ( NID( c ) == N_IntervalBigFloat )
294: addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
295: else *rp = (Obj)c;
296: #endif
297: }
298:
299: static void
300: Pitvbf(NODE arg, Obj *rp)
301: {
302: Num a, i, s;
1.3 ! kondoh 303: IntervalBigFloat c;
! 304: Num ii,ss;
! 305: Real di, ds;
1.1 noro 306: double inf, sup;
1.3 ! kondoh 307: int current_roundmode;
1.1 noro 308:
309: asir_assert(ARG0(arg),O_N,"intvalbf");
310: a = (Num)ARG0(arg);
311: if ( argc(arg) > 1 ) {
312: asir_assert(ARG1(arg),O_N,"intvalbf");
1.3 ! kondoh 313:
1.1 noro 314: i = (Num)ARG0(arg);
315: s = (Num)ARG1(arg);
1.3 ! kondoh 316: current_roundmode = mpfr_roundmode;
! 317: mpfr_roundmode = MPFR_RNDD;
! 318: ii = tobf(i, DEFAULTPREC);
! 319: mpfr_roundmode = MPFR_RNDU;
! 320: ss = tobf(s, DEFAULTPREC);
! 321: istoitv(ii,ss,(Itv *)&c);
! 322: // MKIntervalBigFloat((BF)ii,(BF)ss,c);
! 323: // ToBf(s, &ss);
! 324: mpfr_roundmode = current_roundmode;
1.1 noro 325: } else {
326: if ( ! a ) {
327: *rp = 0;
328: return;
329: }
330: else if ( NID(a) == N_IP ) {
331: itvtois((Itv)a, &i, &s);
1.3 ! kondoh 332: current_roundmode = mpfr_roundmode;
! 333: mpfr_roundmode = MPFR_RNDD;
! 334: ii = tobf(i, DEFAULTPREC);
! 335: mpfr_roundmode = MPFR_RNDU;
! 336: ss = tobf(s, DEFAULTPREC);
! 337: istoitv(ii,ss,(Itv *)&c);
! 338: // MKIntervalBigFloat((BF)ii,(BF)ss,c);
! 339: mpfr_roundmode = current_roundmode;
1.1 noro 340: }
341: else if ( NID(a) == N_IntervalBigFloat) {
342: *rp = (Obj)a;
343: return;
344: }
345: else if ( NID(a) == N_IntervalDouble ) {
346: inf = INF((IntervalDouble)a);
347: sup = SUP((IntervalDouble)a);
1.3 ! kondoh 348: current_roundmode = mpfr_roundmode;
! 349: //double2bf(inf, (BF *)&i);
! 350: //double2bf(sup, (BF *)&s);
! 351: mpfr_roundmode = MPFR_RNDD;
! 352: MKReal(inf,di);
! 353: ii = tobf((Num)di, DEFAULTPREC);
! 354: mpfr_roundmode = MPFR_RNDU;
! 355: MKReal(sup,ds);
! 356: ss = tobf((Num)ds, DEFAULTPREC);
! 357: istoitv(ii,ss,(Itv *)&c);
! 358: // MKIntervalBigFloat((BF)ii,(BF)ss,c);
! 359: mpfr_roundmode = current_roundmode;
1.1 noro 360: }
361: else {
1.3 ! kondoh 362: current_roundmode = mpfr_roundmode;
! 363: mpfr_roundmode = MPFR_RNDD;
! 364: ii = tobf(a, DEFAULTPREC);
! 365: mpfr_roundmode = MPFR_RNDU;
! 366: ss = tobf(a, DEFAULTPREC);
! 367: //ToBf(a, (BF *)&i);
! 368: istoitv(ii,ss,(Itv *)&c);
! 369: // MKIntervalBigFloat((BF)ii,(BF)ss,c);
! 370: mpfr_roundmode = current_roundmode;
1.1 noro 371: }
372: }
1.3 ! kondoh 373: // if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )
! 374: // addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
! 375: // else *rp = (Obj)c;
! 376: *rp = (Obj)c;
1.1 noro 377: }
378:
379: static void
380: Pitvd(NODE arg, Obj *rp)
381: {
382: double inf, sup;
383: Num a, a0, a1, t;
384: Itv ia;
385: IntervalDouble d;
386:
387: asir_assert(ARG0(arg),O_N,"intvald");
388: a0 = (Num)ARG0(arg);
389: if ( argc(arg) > 1 ) {
390: asir_assert(ARG1(arg),O_N,"intvald");
391: a1 = (Num)ARG1(arg);
392: } else {
393: if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
394: inf = INF((IntervalDouble)a0);
395: sup = SUP((IntervalDouble)a0);
396: MKIntervalDouble(inf,sup,d);
397: *rp = (Obj)d;
398: return;
399: }
400: a1 = (Num)ARG0(arg);
401: }
402: if ( compnum(0,a0,a1) > 0 ) {
403: t = a0; a0 = a1; a1 = t;
404: }
405: inf = ToRealDown(a0);
406: sup = ToRealUp(a1);
407: MKIntervalDouble(inf,sup,d);
408: *rp = (Obj)d;
409: }
410:
411: static void
412: Pinf(NODE arg, Obj *rp)
413: {
414: Num a, i, s;
415: Real r;
416: double d;
417:
418: a = (Num)ARG0(arg);
419: if ( ! a ) {
420: *rp = 0;
421: } else if ( OID(a) == O_N ) {
422: switch ( NID(a) ) {
423: case N_IntervalDouble:
424: d = INF((IntervalDouble)a);
425: MKReal(d, r);
426: *rp = (Obj)r;
427: break;
428: case N_IP:
429: case N_IntervalBigFloat:
430: case N_IntervalQuad:
431: itvtois((Itv)ARG0(arg),&i,&s);
432: *rp = (Obj)i;
433: break;
434: default:
435: *rp = (Obj)a;
436: break;
437: }
438: } else {
439: *rp = (Obj)a;
440: }
441: }
442:
443: static void
444: Psup(NODE arg, Obj *rp)
445: {
446: Num a, i, s;
447: Real r;
448: double d;
449:
450: a = (Num)ARG0(arg);
451: if ( ! a ) {
452: *rp = 0;
453: } else if ( OID(a) == O_N ) {
454: switch ( NID(a) ) {
455: case N_IntervalDouble:
456: d = SUP((IntervalDouble)a);
457: MKReal(d, r);
458: *rp = (Obj)r;
459: break;
460: case N_IP:
461: case N_IntervalBigFloat:
462: case N_IntervalQuad:
463: itvtois((Itv)ARG0(arg),&i,&s);
464: *rp = (Obj)s;
465: break;
466: default:
467: *rp = (Obj)a;
468: break;
469: }
470: } else {
471: *rp = (Obj)a;
472: }
473: }
474:
475: static void
476: Pmid(NODE arg, Obj *rp)
477: {
478: Num a, s;
479: Real r;
480: double d;
481:
482: a = (Num)ARG0(arg);
483: if ( ! a ) {
484: *rp = 0;
485: } else switch (OID(a)) {
486: case O_N:
487: if ( NID(a) == N_IntervalDouble ) {
488: d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;
489: MKReal(d, r);
490: *rp = (Obj)r;
491: } else if ( NID(a) == N_IntervalQuad ) {
492: error("mid: not supported operation");
493: *rp = 0;
494: } else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {
495: miditvp((Itv)ARG0(arg),&s);
496: *rp = (Obj)s;
497: } else {
498: *rp = (Obj)a;
499: }
500: break;
501: #if 0
502: case O_P:
503: case O_R:
504: case O_LIST:
505: case O_VECT:
506: case O_MAT:
507: #endif
508: default:
509: *rp = (Obj)a;
510: break;
511: }
512: }
513:
514: static void
515: Pcup(NODE arg, Obj *rp)
516: {
517: Itv s;
518: Num a, b;
519:
520: asir_assert(ARG0(arg),O_N,"cup");
521: asir_assert(ARG1(arg),O_N,"cup");
522: a = (Num)ARG0(arg);
523: b = (Num)ARG1(arg);
524: if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
525: cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
526: } else {
527: cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
528: *rp = (Obj)s;
529: }
530: }
531:
532: static void
533: Pcap(NODE arg, Obj *rp)
534: {
535: Itv s;
536: Num a, b;
537:
538: asir_assert(ARG0(arg),O_N,"cap");
539: asir_assert(ARG1(arg),O_N,"cap");
540: a = (Num)ARG0(arg);
541: b = (Num)ARG1(arg);
542: if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
543: capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
544: } else {
545: capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
546: *rp = (Obj)s;
547: }
548: }
549:
550: static void
551: Pwidth(arg,rp)
552: NODE arg;
553: Obj *rp;
554: {
555: Num s;
556: Num a;
557:
558: asir_assert(ARG0(arg),O_N,"width");
559: a = (Num)ARG0(arg);
560: if ( ! a ) {
561: *rp = 0;
562: } else if ( NID(a) == N_IntervalDouble ) {
563: widthitvd((IntervalDouble)a, (Num *)rp);
564: } else {
565: widthitvp((Itv)ARG0(arg),&s);
566: *rp = (Obj)s;
567: }
568: }
569:
570: static void
571: Pabsitv(arg,rp)
572: NODE arg;
573: Obj *rp;
574: {
575: Num s;
576: Num a, b;
577:
578: asir_assert(ARG0(arg),O_N,"absitv");
579: a = (Num)ARG0(arg);
580: if ( ! a ) {
581: *rp = 0;
582: } else if ( NID(a) == N_IntervalDouble ) {
583: absitvd((IntervalDouble)a, (Num *)rp);
584: } else {
585: absitvp((Itv)ARG0(arg),&s);
586: *rp = (Obj)s;
587: }
588: }
589:
590: static void
591: Pdistance(arg,rp)
592: NODE arg;
593: Obj *rp;
594: {
595: Num s;
596: Num a, b;
597:
598: asir_assert(ARG0(arg),O_N,"distance");
599: asir_assert(ARG1(arg),O_N,"distance");
600: a = (Num)ARG0(arg);
601: b = (Num)ARG1(arg);
602: if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
603: distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);
604: } else {
605: distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
606: *rp = (Obj)s;
607: }
608: }
609:
610: static void
611: Pinitv(arg,rp)
612: NODE arg;
613: Obj *rp;
614: {
615: int s;
616: Q q;
617:
618: asir_assert(ARG0(arg),O_N,"intval");
619: asir_assert(ARG1(arg),O_N,"intval");
620: if ( ! ARG1(arg) ) {
621: if ( ! ARG0(arg) ) s = 1;
622: else s = 0;
623: }
624: else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
625: s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));
626:
627: } else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {
628: if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
629: else if ( NID(ARG0(arg)) == N_IP ) {
630: s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));
631: } else {
632: s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
633: }
634: } else {
635: s = ! compnum(0,(Num)ARG0(arg),(Num)ARG1(arg));
636: }
1.3 ! kondoh 637: STOQ(s,q);
1.1 noro 638: *rp = (Obj)q;
639: }
640:
641: static void
642: Pdisjitv(arg,rp)
643: NODE arg;
644: Obj *rp;
645: {
646: Itv s;
647:
648: asir_assert(ARG0(arg),O_N,"disjitv");
649: asir_assert(ARG1(arg),O_N,"disjitv");
650: error("disjitv: not implemented yet");
651: if ( ! s ) *rp = 0;
652: else *rp = (Obj)ONE;
653: }
654:
1.3 ! kondoh 655: static void
! 656: PzeroRewriteMode(NODE arg, Obj *rp)
! 657: {
! 658: Q a, r;
! 659:
! 660: STOQ(zerorewrite,r);
! 661: *rp = (Obj)r;
! 662:
! 663: if (arg) {
! 664: a = (Q)ARG0(arg);
! 665: if(!a) {
! 666: zerorewrite = 0;
! 667: } else if ( (NUM(a)&&INT(a)) ){
! 668: zerorewrite = 1;
! 669: }
! 670: }
! 671: }
! 672:
! 673: static void
! 674: PzeroRewriteCountClear(NODE arg, Obj *rp)
! 675: {
! 676: Q a, r;
! 677:
! 678: STOQ(zerorewriteCount,r);
! 679: *rp = (Obj)r;
! 680:
! 681: if (arg) {
! 682: a = (Q)ARG0(arg);
! 683: if(a &&(NUM(a)&&INT(a))){
! 684: zerorewriteCount = 0;
! 685: }
! 686: }
! 687: }
! 688:
! 689: static void
! 690: PzeroRewriteCount(NODE arg, Obj *rp)
! 691: {
! 692: Q r;
! 693:
! 694: STOQ(zerorewriteCount,r);
! 695: *rp = (Obj)r;
! 696: }
! 697:
! 698:
1.1 noro 699: #endif
700: extern int printmode;
701:
702: static void pprintmode( void )
703: {
704: switch (printmode) {
705: #if defined(INTERVAL)
706: case MID_PRINTF_E:
707: fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
708: #endif
709: case PRINTF_E:
710: fprintf(stderr,"Printf's double printing mode is \"%%.16e\".\n");
711: break;
712: #if defined(INTERVAL)
713: case MID_PRINTF_G:
714: fprintf(stderr,"Interval printing mode is a mitpoint type.\n");
715: #endif
716: default:
717: case PRINTF_G:
718: fprintf(stderr,"Printf's double printing mode is \"%%g\".\n");
719: break;
720: }
721: }
722:
723: static void
724: Pprintmode(NODE arg, Obj *rp)
725: {
726: int l;
1.3 ! kondoh 727: Q a, r;
1.1 noro 728:
1.3 ! kondoh 729: a = (Q)ARG0(arg);
1.1 noro 730: if(!a||(NUM(a)&&INT(a))){
1.3 ! kondoh 731: l=QTOS(a);
1.1 noro 732: if ( l < 0 ) l = 0;
733: #if defined(INTERVAL)
734: else if ( l > MID_PRINTF_E ) l = 0;
735: #else
736: else if ( l > PRINTF_E ) l = 0;
737: #endif
1.3 ! kondoh 738: STOQ(printmode,r);
1.1 noro 739: *rp = (Obj)r;
740: printmode = l;
741: pprintmode();
742: } else {
743: *rp = 0;
744: }
745: }
746:
747:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to itvnum.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2018 / builtin