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