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