![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to intr.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / f77|
Return to intr.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / f77 |
1.1 root 1: #include "defs"
2:
3: extern ftnint intcon[14];
4: extern double realcon[6];
5:
6: union
7: {
8: int ijunk;
9: struct Intrpacked bits;
10: } packed;
11:
12: struct Intrbits
13: {
14: int intrgroup /* :3 */;
15: int intrstuff /* result type or number of generics */;
16: int intrno /* :7 */;
17: };
18:
19: LOCAL struct Intrblock
20: {
21: char intrfname[VL];
22: struct Intrbits intrval;
23: } intrtab[ ] =
24: {
25: "int", { INTRCONV, TYLONG },
26: "real", { INTRCONV, TYREAL },
27: "dble", { INTRCONV, TYDREAL },
28: "cmplx", { INTRCONV, TYCOMPLEX },
29: "dcmplx", { INTRCONV, TYDCOMPLEX },
30: "ifix", { INTRCONV, TYLONG },
31: "idint", { INTRCONV, TYLONG },
32: "float", { INTRCONV, TYREAL },
33: "dfloat", { INTRCONV, TYDREAL },
34: "sngl", { INTRCONV, TYREAL },
35: "ichar", { INTRCONV, TYLONG },
36: "char", { INTRCONV, TYCHAR },
37:
38: "max", { INTRMAX, TYUNKNOWN },
39: "max0", { INTRMAX, TYLONG },
40: "amax0", { INTRMAX, TYREAL },
41: "max1", { INTRMAX, TYLONG },
42: "amax1", { INTRMAX, TYREAL },
43: "dmax1", { INTRMAX, TYDREAL },
44:
45: "and", { INTRBOOL, TYUNKNOWN, OPBITAND },
46: "or", { INTRBOOL, TYUNKNOWN, OPBITOR },
47: "xor", { INTRBOOL, TYUNKNOWN, OPBITXOR },
48: "not", { INTRBOOL, TYUNKNOWN, OPBITNOT },
49: "lshift", { INTRBOOL, TYUNKNOWN, OPLSHIFT },
50: "rshift", { INTRBOOL, TYUNKNOWN, OPRSHIFT },
51:
52: "min", { INTRMIN, TYUNKNOWN },
53: "min0", { INTRMIN, TYLONG },
54: "amin0", { INTRMIN, TYREAL },
55: "min1", { INTRMIN, TYLONG },
56: "amin1", { INTRMIN, TYREAL },
57: "dmin1", { INTRMIN, TYDREAL },
58:
59: "aint", { INTRGEN, 2, 0 },
60: "dint", { INTRSPEC, TYDREAL, 1 },
61:
62: "anint", { INTRGEN, 2, 2 },
63: "dnint", { INTRSPEC, TYDREAL, 3 },
64:
65: "nint", { INTRGEN, 4, 4 },
66: "idnint", { INTRGEN, 2, 6 },
67:
68: "abs", { INTRGEN, 6, 8 },
69: "iabs", { INTRGEN, 2, 9 },
70: "dabs", { INTRSPEC, TYDREAL, 11 },
71: "cabs", { INTRSPEC, TYREAL, 12 },
72: "zabs", { INTRSPEC, TYDREAL, 13 },
73:
74: "mod", { INTRGEN, 4, 14 },
75: "amod", { INTRSPEC, TYREAL, 16 },
76: "dmod", { INTRSPEC, TYDREAL, 17 },
77:
78: "sign", { INTRGEN, 4, 18 },
79: "isign", { INTRGEN, 2, 19 },
80: "dsign", { INTRSPEC, TYDREAL, 21 },
81:
82: "dim", { INTRGEN, 4, 22 },
83: "idim", { INTRGEN, 2, 23 },
84: "ddim", { INTRSPEC, TYDREAL, 25 },
85:
86: "dprod", { INTRSPEC, TYDREAL, 26 },
87:
88: "len", { INTRSPEC, TYLONG, 27 },
89: "index", { INTRSPEC, TYLONG, 29 },
90:
91: "imag", { INTRGEN, 2, 31 },
92: "aimag", { INTRSPEC, TYREAL, 31 },
93: "dimag", { INTRSPEC, TYDREAL, 32 },
94:
95: "conjg", { INTRGEN, 2, 33 },
96: "dconjg", { INTRSPEC, TYDCOMPLEX, 34 },
97:
98: "sqrt", { INTRGEN, 4, 35 },
99: "dsqrt", { INTRSPEC, TYDREAL, 36 },
100: "csqrt", { INTRSPEC, TYCOMPLEX, 37 },
101: "zsqrt", { INTRSPEC, TYDCOMPLEX, 38 },
102:
103: "exp", { INTRGEN, 4, 39 },
104: "dexp", { INTRSPEC, TYDREAL, 40 },
105: "cexp", { INTRSPEC, TYCOMPLEX, 41 },
106: "zexp", { INTRSPEC, TYDCOMPLEX, 42 },
107:
108: "log", { INTRGEN, 4, 43 },
109: "alog", { INTRSPEC, TYREAL, 43 },
110: "dlog", { INTRSPEC, TYDREAL, 44 },
111: "clog", { INTRSPEC, TYCOMPLEX, 45 },
112: "zlog", { INTRSPEC, TYDCOMPLEX, 46 },
113:
114: "log10", { INTRGEN, 2, 47 },
115: "alog10", { INTRSPEC, TYREAL, 47 },
116: "dlog10", { INTRSPEC, TYDREAL, 48 },
117:
118: "sin", { INTRGEN, 4, 49 },
119: "dsin", { INTRSPEC, TYDREAL, 50 },
120: "csin", { INTRSPEC, TYCOMPLEX, 51 },
121: "zsin", { INTRSPEC, TYDCOMPLEX, 52 },
122:
123: "cos", { INTRGEN, 4, 53 },
124: "dcos", { INTRSPEC, TYDREAL, 54 },
125: "ccos", { INTRSPEC, TYCOMPLEX, 55 },
126: "zcos", { INTRSPEC, TYDCOMPLEX, 56 },
127:
128: "tan", { INTRGEN, 2, 57 },
129: "dtan", { INTRSPEC, TYDREAL, 58 },
130:
131: "asin", { INTRGEN, 2, 59 },
132: "dasin", { INTRSPEC, TYDREAL, 60 },
133:
134: "acos", { INTRGEN, 2, 61 },
135: "dacos", { INTRSPEC, TYDREAL, 62 },
136:
137: "atan", { INTRGEN, 2, 63 },
138: "datan", { INTRSPEC, TYDREAL, 64 },
139:
140: "atan2", { INTRGEN, 2, 65 },
141: "datan2", { INTRSPEC, TYDREAL, 66 },
142:
143: "sinh", { INTRGEN, 2, 67 },
144: "dsinh", { INTRSPEC, TYDREAL, 68 },
145:
146: "cosh", { INTRGEN, 2, 69 },
147: "dcosh", { INTRSPEC, TYDREAL, 70 },
148:
149: "tanh", { INTRGEN, 2, 71 },
150: "dtanh", { INTRSPEC, TYDREAL, 72 },
151:
152: "lge", { INTRSPEC, TYLOGICAL, 73},
153: "lgt", { INTRSPEC, TYLOGICAL, 75},
154: "lle", { INTRSPEC, TYLOGICAL, 77},
155: "llt", { INTRSPEC, TYLOGICAL, 79},
156:
157: "epbase", { INTRCNST, 4, 0 },
158: "epprec", { INTRCNST, 4, 4 },
159: "epemin", { INTRCNST, 2, 8 },
160: "epemax", { INTRCNST, 2, 10 },
161: "eptiny", { INTRCNST, 2, 12 },
162: "ephuge", { INTRCNST, 4, 14 },
163: "epmrsp", { INTRCNST, 2, 18 },
164:
165: "fpexpn", { INTRGEN, 4, 81 },
166: "fpabsp", { INTRGEN, 2, 85 },
167: "fprrsp", { INTRGEN, 2, 87 },
168: "fpfrac", { INTRGEN, 2, 89 },
169: "fpmake", { INTRGEN, 2, 91 },
170: "fpscal", { INTRGEN, 2, 93 },
171:
172: "" };
173:
174:
175: LOCAL struct Specblock
176: {
177: char atype;
178: char rtype;
179: char nargs;
180: char spxname[XL];
181: char othername; /* index into callbyvalue table */
182: } spectab[ ] =
183: {
184: { TYREAL,TYREAL,1,"r_int" },
185: { TYDREAL,TYDREAL,1,"d_int" },
186:
187: { TYREAL,TYREAL,1,"r_nint" },
188: { TYDREAL,TYDREAL,1,"d_nint" },
189:
190: { TYREAL,TYSHORT,1,"h_nint" },
191: { TYREAL,TYLONG,1,"i_nint" },
192:
193: { TYDREAL,TYSHORT,1,"h_dnnt" },
194: { TYDREAL,TYLONG,1,"i_dnnt" },
195:
196: { TYREAL,TYREAL,1,"r_abs" },
197: { TYSHORT,TYSHORT,1,"h_abs" },
198: { TYLONG,TYLONG,1,"i_abs" },
199: { TYDREAL,TYDREAL,1,"d_abs" },
200: { TYCOMPLEX,TYREAL,1,"c_abs" },
201: { TYDCOMPLEX,TYDREAL,1,"z_abs" },
202:
203: { TYSHORT,TYSHORT,2,"h_mod" },
204: { TYLONG,TYLONG,2,"i_mod" },
205: { TYREAL,TYREAL,2,"r_mod" },
206: { TYDREAL,TYDREAL,2,"d_mod" },
207:
208: { TYREAL,TYREAL,2,"r_sign" },
209: { TYSHORT,TYSHORT,2,"h_sign" },
210: { TYLONG,TYLONG,2,"i_sign" },
211: { TYDREAL,TYDREAL,2,"d_sign" },
212:
213: { TYREAL,TYREAL,2,"r_dim" },
214: { TYSHORT,TYSHORT,2,"h_dim" },
215: { TYLONG,TYLONG,2,"i_dim" },
216: { TYDREAL,TYDREAL,2,"d_dim" },
217:
218: { TYREAL,TYDREAL,2,"d_prod" },
219:
220: { TYCHAR,TYSHORT,1,"h_len" },
221: { TYCHAR,TYLONG,1,"i_len" },
222:
223: { TYCHAR,TYSHORT,2,"h_indx" },
224: { TYCHAR,TYLONG,2,"i_indx" },
225:
226: { TYCOMPLEX,TYREAL,1,"r_imag" },
227: { TYDCOMPLEX,TYDREAL,1,"d_imag" },
228: { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
229: { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
230:
231: { TYREAL,TYREAL,1,"r_sqrt", 1 },
232: { TYDREAL,TYDREAL,1,"d_sqrt", 1 },
233: { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
234: { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
235:
236: { TYREAL,TYREAL,1,"r_exp", 2 },
237: { TYDREAL,TYDREAL,1,"d_exp", 2 },
238: { TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
239: { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
240:
241: { TYREAL,TYREAL,1,"r_log", 3 },
242: { TYDREAL,TYDREAL,1,"d_log", 3 },
243: { TYCOMPLEX,TYCOMPLEX,1,"c_log" },
244: { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
245:
246: { TYREAL,TYREAL,1,"r_lg10" },
247: { TYDREAL,TYDREAL,1,"d_lg10" },
248:
249: { TYREAL,TYREAL,1,"r_sin", 4 },
250: { TYDREAL,TYDREAL,1,"d_sin", 4 },
251: { TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
252: { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
253:
254: { TYREAL,TYREAL,1,"r_cos", 5 },
255: { TYDREAL,TYDREAL,1,"d_cos", 5 },
256: { TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
257: { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
258:
259: { TYREAL,TYREAL,1,"r_tan", 6 },
260: { TYDREAL,TYDREAL,1,"d_tan", 6 },
261:
262: { TYREAL,TYREAL,1,"r_asin", 7 },
263: { TYDREAL,TYDREAL,1,"d_asin", 7 },
264:
265: { TYREAL,TYREAL,1,"r_acos", 8 },
266: { TYDREAL,TYDREAL,1,"d_acos", 8 },
267:
268: { TYREAL,TYREAL,1,"r_atan", 9 },
269: { TYDREAL,TYDREAL,1,"d_atan", 9 },
270:
271: { TYREAL,TYREAL,2,"r_atn2", 10 },
272: { TYDREAL,TYDREAL,2,"d_atn2", 10 },
273:
274: { TYREAL,TYREAL,1,"r_sinh", 11 },
275: { TYDREAL,TYDREAL,1,"d_sinh", 11 },
276:
277: { TYREAL,TYREAL,1,"r_cosh", 12 },
278: { TYDREAL,TYDREAL,1,"d_cosh", 12 },
279:
280: { TYREAL,TYREAL,1,"r_tanh", 13 },
281: { TYDREAL,TYDREAL,1,"d_tanh", 13 },
282:
283: { TYCHAR,TYLOGICAL,2,"hl_ge" },
284: { TYCHAR,TYLOGICAL,2,"l_ge" },
285:
286: { TYCHAR,TYLOGICAL,2,"hl_gt" },
287: { TYCHAR,TYLOGICAL,2,"l_gt" },
288:
289: { TYCHAR,TYLOGICAL,2,"hl_le" },
290: { TYCHAR,TYLOGICAL,2,"l_le" },
291:
292: { TYCHAR,TYLOGICAL,2,"hl_lt" },
293: { TYCHAR,TYLOGICAL,2,"l_lt" },
294:
295: { TYREAL,TYSHORT,1,"hr_expn" },
296: { TYREAL,TYLONG,1,"ir_expn" },
297: { TYDREAL,TYSHORT,1,"hd_expn" },
298: { TYDREAL,TYLONG,1,"id_expn" },
299:
300: { TYREAL,TYREAL,1,"r_absp" },
301: { TYDREAL,TYDREAL,1,"d_absp" },
302:
303: { TYREAL,TYDREAL,1,"r_rrsp" },
304: { TYDREAL,TYDREAL,1,"d_rrsp" },
305:
306: { TYREAL,TYREAL,1,"r_frac" },
307: { TYDREAL,TYDREAL,1,"d_frac" },
308:
309: { TYREAL,TYREAL,2,"r_make" },
310: { TYDREAL,TYDREAL,2,"d_make" },
311:
312: { TYREAL,TYREAL,2,"r_scal" },
313: { TYDREAL,TYDREAL,2,"d_scal" }
314: } ;
315:
316: LOCAL struct Incstblock
317: {
318: char atype;
319: char rtype;
320: char constno;
321: } consttab[ ] =
322: {
323: { TYSHORT, TYLONG, 0 },
324: { TYLONG, TYLONG, 1 },
325: { TYREAL, TYLONG, 2 },
326: { TYDREAL, TYLONG, 3 },
327:
328: { TYSHORT, TYLONG, 4 },
329: { TYLONG, TYLONG, 5 },
330: { TYREAL, TYLONG, 6 },
331: { TYDREAL, TYLONG, 7 },
332:
333: { TYREAL, TYLONG, 8 },
334: { TYDREAL, TYLONG, 9 },
335:
336: { TYREAL, TYLONG, 10 },
337: { TYDREAL, TYLONG, 11 },
338:
339: { TYREAL, TYREAL, 0 },
340: { TYDREAL, TYDREAL, 1 },
341:
342: { TYSHORT, TYLONG, 12 },
343: { TYLONG, TYLONG, 13 },
344: { TYREAL, TYREAL, 2 },
345: { TYDREAL, TYDREAL, 3 },
346:
347: { TYREAL, TYREAL, 4 },
348: { TYDREAL, TYDREAL, 5 }
349: };
350:
351: /* For each machine, two arrays must be initialized.
352: intcon contains
353: radix for short int
354: radix for long int
355: radix for single precision
356: radix for double precision
357: precision for short int
358: precision for long int
359: precision for single precision
360: precision for double precision
361: emin for single precision
362: emin for double precision
363: emax for single precision
364: emax for double prcision
365: largest short int
366: largest long int
367:
368: realcon contains
369: tiny for single precision
370: tiny for double precision
371: huge for single precision
372: huge for double precision
373: mrsp (epsilon) for single precision
374: mrsp (epsilon) for double precision
375:
376: the realcons should probably be filled in in binary if TARGET==HERE
377: */
378:
379: char callbyvalue[ ][XL] =
380: {
381: "sqrt",
382: "exp",
383: "log",
384: "sin",
385: "cos",
386: "tan",
387: "asin",
388: "acos",
389: "atan",
390: "atan2",
391: "sinh",
392: "cosh",
393: "tanh"
394: };
395:
396: struct Exprblock *intrcall(np, argsp, nargs)
397: struct Nameblock *np;
398: struct Listblock *argsp;
399: int nargs;
400: {
401: int i, rettype;
402: struct Addrblock *ap;
403: register struct Specblock *sp;
404: struct Exprblock *q, *inline();
405: register struct Chain *cp;
406: struct Constblock *mkcxcon(), *mkrealcon();
407: register struct Incstblock *cstp;
408: expptr ep;
409: int mtype;
410: int op;
411: int f1field, f2field, f3field;
412:
413: packed.ijunk = np->vardesc.varno;
414: f1field = packed.bits.f1;
415: f2field = packed.bits.f2;
416: f3field = packed.bits.f3;
417: if(nargs == 0)
418: goto badnargs;
419:
420: mtype = 0;
421: for(cp = argsp->listp ; cp ; cp = cp->nextp)
422: {
423: /* TEMPORARY */ ep = cp->datap;
424: /* TEMPORARY */ if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
425: /* TEMPORARY */ cp->datap = mkconv(tyint, ep);
426: mtype = maxtype(mtype, ep->headblock.vtype);
427: }
428:
429: switch(f1field)
430: {
431: case INTRBOOL:
432: op = f3field;
433: if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
434: goto badtype;
435: if(op == OPBITNOT)
436: {
437: if(nargs != 1)
438: goto badnargs;
439: q = mkexpr(OPBITNOT, argsp->listp->datap, NULL);
440: }
441: else
442: {
443: if(nargs != 2)
444: goto badnargs;
445: q = mkexpr(op, argsp->listp->datap,
446: argsp->listp->nextp->datap);
447: }
448: frchain( &(argsp->listp) );
449: free(argsp);
450: return(q);
451:
452: case INTRCONV:
453: rettype = f2field;
454: if(rettype == TYLONG)
455: rettype = tyint;
456: if( ISCOMPLEX(rettype) && nargs==2)
457: {
458: expptr qr, qi;
459: qr = argsp->listp->datap;
460: qi = argsp->listp->nextp->datap;
461: if(ISCONST(qr) && ISCONST(qi))
462: q = mkcxcon(qr,qi);
463: else q = mkexpr(OPCONV,mkconv(rettype-2,qr),
464: mkconv(rettype-2,qi));
465: }
466: else if(nargs == 1)
467: q = mkconv(rettype, argsp->listp->datap);
468: else goto badnargs;
469:
470: q->vtype = rettype;
471: frchain(&(argsp->listp));
472: free(argsp);
473: return(q);
474:
475:
476: case INTRCNST:
477: cstp = consttab + f3field;
478: for(i=0 ; i<f2field ; ++i)
479: if(cstp->atype == mtype)
480: goto foundconst;
481: else
482: ++cstp;
483: goto badtype;
484:
485: foundconst:
486: switch(cstp->rtype)
487: {
488: case TYLONG:
489: return( mkintcon(intcon[cstp->constno]) );
490:
491: case TYREAL:
492: case TYDREAL:
493: return( mkrealcon(cstp->rtype,
494: realcon[cstp->constno]) );
495:
496: default:
497: fatal("impossible intrinsic constant");
498: }
499:
500: case INTRGEN:
501: sp = spectab + f3field;
502: if(no66flag)
503: if(sp->atype == mtype)
504: goto specfunct;
505: else err66("generic function");
506:
507: for(i=0; i<f2field ; ++i)
508: if(sp->atype == mtype)
509: goto specfunct;
510: else
511: ++sp;
512: goto badtype;
513:
514: case INTRSPEC:
515: sp = spectab + f3field;
516: specfunct:
517: if(tyint==TYLONG && sp->rtype==TYSHORT
518: && (sp+1)->atype==sp->atype)
519: ++sp;
520:
521: if(nargs != sp->nargs)
522: goto badnargs;
523: if(mtype != sp->atype)
524: goto badtype;
525: fixargs(YES, argsp);
526: if(q = inline(sp-spectab, mtype, argsp->listp))
527: {
528: frchain( &(argsp->listp) );
529: free(argsp);
530: }
531: else if(sp->othername)
532: {
533: ap = builtin(sp->rtype,
534: varstr(XL, callbyvalue[sp->othername-1]) );
535: q = fixexpr( mkexpr(OPCCALL, ap, argsp) );
536: }
537: else
538: {
539: ap = builtin(sp->rtype, varstr(XL, sp->spxname) );
540: q = fixexpr( mkexpr(OPCALL, ap, argsp) );
541: }
542: return(q);
543:
544: case INTRMIN:
545: case INTRMAX:
546: if(nargs < 2)
547: goto badnargs;
548: if( ! ONEOF(mtype, MSKINT|MSKREAL) )
549: goto badtype;
550: argsp->vtype = mtype;
551: q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), argsp, NULL);
552:
553: q->vtype = mtype;
554: rettype = f2field;
555: if(rettype == TYLONG)
556: rettype = tyint;
557: else if(rettype == TYUNKNOWN)
558: rettype = mtype;
559: return( mkconv(rettype, q) );
560:
561: default:
562: fatali("intrcall: bad intrgroup %d", f1field);
563: }
564: badnargs:
565: errstr("bad number of arguments to intrinsic %s",
566: varstr(VL,np->varname) );
567: goto bad;
568:
569: badtype:
570: errstr("bad argument type to intrinsic %s", varstr(VL, np->varname) );
571:
572: bad:
573: return( errnode() );
574: }
575:
576:
577:
578:
579: intrfunct(s)
580: char s[VL];
581: {
582: register struct Intrblock *p;
583: char nm[VL];
584: register int i;
585:
586: for(i = 0 ; i<VL ; ++s)
587: nm[i++] = (*s==' ' ? '\0' : *s);
588:
589: for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
590: {
591: if( eqn(VL, nm, p->intrfname) )
592: {
593: packed.bits.f1 = p->intrval.intrgroup;
594: packed.bits.f2 = p->intrval.intrstuff;
595: packed.bits.f3 = p->intrval.intrno;
596: return(packed.ijunk);
597: }
598: }
599:
600: return(0);
601: }
602:
603:
604:
605:
606:
607: struct Addrblock *intraddr(np)
608: struct Nameblock *np;
609: {
610: struct Addrblock *q;
611: register struct Specblock *sp;
612: int f3field;
613:
614: if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
615: fatalstr("intraddr: %s is not intrinsic", varstr(VL,np->varname));
616: packed.ijunk = np->vardesc.varno;
617: f3field = packed.bits.f3;
618:
619: switch(packed.bits.f1)
620: {
621: case INTRGEN:
622: /* imag, log, and log10 arent specific functions */
623: if(f3field==31 || f3field==43 || f3field==47)
624: goto bad;
625:
626: case INTRSPEC:
627: sp = spectab + f3field;
628: if(tyint==TYLONG && sp->rtype==TYSHORT)
629: ++sp;
630: q = builtin(sp->rtype, varstr(XL,sp->spxname) );
631: return(q);
632:
633: case INTRCONV:
634: case INTRMIN:
635: case INTRMAX:
636: case INTRBOOL:
637: case INTRCNST:
638: bad:
639: errstr("cannot pass %s as actual",
640: varstr(VL,np->varname));
641: return( errnode() );
642: }
643: fatali("intraddr: impossible f1=%d\n", packed.bits.f1);
644: /* NOTREACHED */
645: }
646:
647:
648:
649:
650:
651: struct Exprblock *inline(fno, type, args)
652: int fno;
653: int type;
654: struct Chain *args;
655: {
656: register struct Exprblock *q, *t, *t1;
657:
658: switch(fno)
659: {
660: case 8: /* real abs */
661: case 9: /* short int abs */
662: case 10: /* long int abs */
663: case 11: /* double precision abs */
664: if( addressable(q = args->datap) )
665: {
666: t = q;
667: q = NULL;
668: }
669: else
670: t = mktemp(type);
671: t1 = mkexpr(OPQUEST, mkexpr(OPLE, mkconv(type,ICON(0)), cpexpr(t)),
672: mkexpr(OPCOLON, cpexpr(t),
673: mkexpr(OPNEG, cpexpr(t), NULL) ));
674: if(q)
675: t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
676: frexpr(t);
677: return(t1);
678:
679: case 26: /* dprod */
680: q = mkexpr(OPSTAR, mkconv(TYDREAL,args->datap), args->nextp->datap);
681: return(q);
682:
683: case 27: /* len of character string */
684: q = cpexpr(args->datap->vleng);
685: frexpr(args->datap);
686: return(q);
687:
688: case 14: /* half-integer mod */
689: case 15: /* mod */
690: return( mkexpr(OPMOD, args->datap, args->nextp->datap) );
691: }
692: return(NULL);
693: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.