1 /****************************************************************
2 Copyright 1990 by AT&T Bell Laboratories and Bellcore.
4 Permission to use, copy, modify, and distribute this software
5 and its documentation for any purpose and without fee is hereby
6 granted, provided that the above copyright notice appear in all
7 copies and that both that the copyright notice and this
8 permission notice and warranty disclaimer appear in supporting
9 documentation, and that the names of AT&T Bell Laboratories or
10 Bellcore or any of their entities not be used in advertising or
11 publicity pertaining to distribution of the software without
12 specific, written prior permission.
14 AT&T and Bellcore disclaim all warranties with regard to this
15 software, including all implied warranties of merchantability
16 and fitness. In no event shall AT&T or Bellcore be liable for
17 any special, indirect or consequential damages or any damages
18 whatsoever resulting from loss of use, data or profits, whether
19 in an action of contract, negligence or other tortious action,
20 arising out of or in connection with the use or performance of
22 ****************************************************************/
32 struct Intrpacked bits;
37 char intrgroup /* :3 */;
38 char intrstuff /* result type or number of generics */;
41 char dblintrno; /* for -r8 */
44 /* List of all intrinsic functions. */
46 LOCAL struct Intrblock
49 struct Intrbits intrval;
52 "int", { INTRCONV, TYLONG },
53 "real", { INTRCONV, TYREAL, 1 },
54 /* 1 ==> real(TYDCOMPLEX) yields TYDREAL */
55 "dble", { INTRCONV, TYDREAL },
56 "cmplx", { INTRCONV, TYCOMPLEX },
57 "dcmplx", { INTRCONV, TYDCOMPLEX, 0, 1 },
58 "ifix", { INTRCONV, TYLONG },
59 "idint", { INTRCONV, TYLONG },
60 "float", { INTRCONV, TYREAL },
61 "dfloat", { INTRCONV, TYDREAL },
62 "sngl", { INTRCONV, TYREAL },
63 "ichar", { INTRCONV, TYLONG },
64 "iachar", { INTRCONV, TYLONG },
65 "char", { INTRCONV, TYCHAR },
66 "achar", { INTRCONV, TYCHAR },
68 /* any MAX or MIN can be used with any types; the compiler will cast them
69 correctly. So rules against bad syntax in these expressions are not
72 "max", { INTRMAX, TYUNKNOWN },
73 "max0", { INTRMAX, TYLONG },
74 "amax0", { INTRMAX, TYREAL },
75 "max1", { INTRMAX, TYLONG },
76 "amax1", { INTRMAX, TYREAL },
77 "dmax1", { INTRMAX, TYDREAL },
79 "and", { INTRBOOL, TYUNKNOWN, OPBITAND },
80 "or", { INTRBOOL, TYUNKNOWN, OPBITOR },
81 "xor", { INTRBOOL, TYUNKNOWN, OPBITXOR },
82 "not", { INTRBOOL, TYUNKNOWN, OPBITNOT },
83 "lshift", { INTRBOOL, TYUNKNOWN, OPLSHIFT },
84 "rshift", { INTRBOOL, TYUNKNOWN, OPRSHIFT },
86 "min", { INTRMIN, TYUNKNOWN },
87 "min0", { INTRMIN, TYLONG },
88 "amin0", { INTRMIN, TYREAL },
89 "min1", { INTRMIN, TYLONG },
90 "amin1", { INTRMIN, TYREAL },
91 "dmin1", { INTRMIN, TYDREAL },
93 "aint", { INTRGEN, 2, 0 },
94 "dint", { INTRSPEC, TYDREAL, 1 },
96 "anint", { INTRGEN, 2, 2 },
97 "dnint", { INTRSPEC, TYDREAL, 3 },
99 "nint", { INTRGEN, 4, 4 },
100 "idnint", { INTRGEN, 2, 6 },
102 "abs", { INTRGEN, 6, 8 },
103 "iabs", { INTRGEN, 2, 9 },
104 "dabs", { INTRSPEC, TYDREAL, 11 },
105 "cabs", { INTRSPEC, TYREAL, 12, 0, 13 },
106 "zabs", { INTRSPEC, TYDREAL, 13, 1 },
108 "mod", { INTRGEN, 4, 14 },
109 "amod", { INTRSPEC, TYREAL, 16, 0, 17 },
110 "dmod", { INTRSPEC, TYDREAL, 17 },
112 "sign", { INTRGEN, 4, 18 },
113 "isign", { INTRGEN, 2, 19 },
114 "dsign", { INTRSPEC, TYDREAL, 21 },
116 "dim", { INTRGEN, 4, 22 },
117 "idim", { INTRGEN, 2, 23 },
118 "ddim", { INTRSPEC, TYDREAL, 25 },
120 "dprod", { INTRSPEC, TYDREAL, 26 },
122 "len", { INTRSPEC, TYLONG, 27 },
123 "index", { INTRSPEC, TYLONG, 29 },
125 "imag", { INTRGEN, 2, 31 },
126 "aimag", { INTRSPEC, TYREAL, 31, 0, 32 },
127 "dimag", { INTRSPEC, TYDREAL, 32 },
129 "conjg", { INTRGEN, 2, 33 },
130 "dconjg", { INTRSPEC, TYDCOMPLEX, 34, 1 },
132 "sqrt", { INTRGEN, 4, 35 },
133 "dsqrt", { INTRSPEC, TYDREAL, 36 },
134 "csqrt", { INTRSPEC, TYCOMPLEX, 37, 0, 38 },
135 "zsqrt", { INTRSPEC, TYDCOMPLEX, 38, 1 },
137 "exp", { INTRGEN, 4, 39 },
138 "dexp", { INTRSPEC, TYDREAL, 40 },
139 "cexp", { INTRSPEC, TYCOMPLEX, 41, 0, 42 },
140 "zexp", { INTRSPEC, TYDCOMPLEX, 42, 1 },
142 "log", { INTRGEN, 4, 43 },
143 "alog", { INTRSPEC, TYREAL, 43, 0, 44 },
144 "dlog", { INTRSPEC, TYDREAL, 44 },
145 "clog", { INTRSPEC, TYCOMPLEX, 45, 0, 46 },
146 "zlog", { INTRSPEC, TYDCOMPLEX, 46, 1 },
148 "log10", { INTRGEN, 2, 47 },
149 "alog10", { INTRSPEC, TYREAL, 47, 0, 48 },
150 "dlog10", { INTRSPEC, TYDREAL, 48 },
152 "sin", { INTRGEN, 4, 49 },
153 "dsin", { INTRSPEC, TYDREAL, 50 },
154 "csin", { INTRSPEC, TYCOMPLEX, 51, 0, 52 },
155 "zsin", { INTRSPEC, TYDCOMPLEX, 52, 1 },
157 "cos", { INTRGEN, 4, 53 },
158 "dcos", { INTRSPEC, TYDREAL, 54 },
159 "ccos", { INTRSPEC, TYCOMPLEX, 55, 0, 56 },
160 "zcos", { INTRSPEC, TYDCOMPLEX, 56, 1 },
162 "tan", { INTRGEN, 2, 57 },
163 "dtan", { INTRSPEC, TYDREAL, 58 },
165 "asin", { INTRGEN, 2, 59 },
166 "dasin", { INTRSPEC, TYDREAL, 60 },
168 "acos", { INTRGEN, 2, 61 },
169 "dacos", { INTRSPEC, TYDREAL, 62 },
171 "atan", { INTRGEN, 2, 63 },
172 "datan", { INTRSPEC, TYDREAL, 64 },
174 "atan2", { INTRGEN, 2, 65 },
175 "datan2", { INTRSPEC, TYDREAL, 66 },
177 "sinh", { INTRGEN, 2, 67 },
178 "dsinh", { INTRSPEC, TYDREAL, 68 },
180 "cosh", { INTRGEN, 2, 69 },
181 "dcosh", { INTRSPEC, TYDREAL, 70 },
183 "tanh", { INTRGEN, 2, 71 },
184 "dtanh", { INTRSPEC, TYDREAL, 72 },
186 "lge", { INTRSPEC, TYLOGICAL, 73},
187 "lgt", { INTRSPEC, TYLOGICAL, 75},
188 "lle", { INTRSPEC, TYLOGICAL, 77},
189 "llt", { INTRSPEC, TYLOGICAL, 79},
192 "epbase", { INTRCNST, 4, 0 },
193 "epprec", { INTRCNST, 4, 4 },
194 "epemin", { INTRCNST, 2, 8 },
195 "epemax", { INTRCNST, 2, 10 },
196 "eptiny", { INTRCNST, 2, 12 },
197 "ephuge", { INTRCNST, 4, 14 },
198 "epmrsp", { INTRCNST, 2, 18 },
201 "fpexpn", { INTRGEN, 4, 81 },
202 "fpabsp", { INTRGEN, 2, 85 },
203 "fprrsp", { INTRGEN, 2, 87 },
204 "fpfrac", { INTRGEN, 2, 89 },
205 "fpmake", { INTRGEN, 2, 91 },
206 "fpscal", { INTRGEN, 2, 93 },
211 LOCAL struct Specblock
213 char atype; /* Argument type; every arg must have
215 char rtype; /* Result type */
216 char nargs; /* Number of arguments */
217 char spxname[8]; /* Name of the function in Fortran */
218 char othername; /* index into callbyvalue table */
221 { TYREAL,TYREAL,1,"r_int" },
222 { TYDREAL,TYDREAL,1,"d_int" },
224 { TYREAL,TYREAL,1,"r_nint" },
225 { TYDREAL,TYDREAL,1,"d_nint" },
227 { TYREAL,TYSHORT,1,"h_nint" },
228 { TYREAL,TYLONG,1,"i_nint" },
230 { TYDREAL,TYSHORT,1,"h_dnnt" },
231 { TYDREAL,TYLONG,1,"i_dnnt" },
233 { TYREAL,TYREAL,1,"r_abs" },
234 { TYSHORT,TYSHORT,1,"h_abs" },
235 { TYLONG,TYLONG,1,"i_abs" },
236 { TYDREAL,TYDREAL,1,"d_abs" },
237 { TYCOMPLEX,TYREAL,1,"c_abs" },
238 { TYDCOMPLEX,TYDREAL,1,"z_abs" },
240 { TYSHORT,TYSHORT,2,"h_mod" },
241 { TYLONG,TYLONG,2,"i_mod" },
242 { TYREAL,TYREAL,2,"r_mod" },
243 { TYDREAL,TYDREAL,2,"d_mod" },
245 { TYREAL,TYREAL,2,"r_sign" },
246 { TYSHORT,TYSHORT,2,"h_sign" },
247 { TYLONG,TYLONG,2,"i_sign" },
248 { TYDREAL,TYDREAL,2,"d_sign" },
250 { TYREAL,TYREAL,2,"r_dim" },
251 { TYSHORT,TYSHORT,2,"h_dim" },
252 { TYLONG,TYLONG,2,"i_dim" },
253 { TYDREAL,TYDREAL,2,"d_dim" },
255 { TYREAL,TYDREAL,2,"d_prod" },
257 { TYCHAR,TYSHORT,1,"h_len" },
258 { TYCHAR,TYLONG,1,"i_len" },
260 { TYCHAR,TYSHORT,2,"h_indx" },
261 { TYCHAR,TYLONG,2,"i_indx" },
263 { TYCOMPLEX,TYREAL,1,"r_imag" },
264 { TYDCOMPLEX,TYDREAL,1,"d_imag" },
265 { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
266 { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
268 { TYREAL,TYREAL,1,"r_sqrt", 1 },
269 { TYDREAL,TYDREAL,1,"d_sqrt", 1 },
270 { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
271 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
273 { TYREAL,TYREAL,1,"r_exp", 2 },
274 { TYDREAL,TYDREAL,1,"d_exp", 2 },
275 { TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
276 { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
278 { TYREAL,TYREAL,1,"r_log", 3 },
279 { TYDREAL,TYDREAL,1,"d_log", 3 },
280 { TYCOMPLEX,TYCOMPLEX,1,"c_log" },
281 { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
283 { TYREAL,TYREAL,1,"r_lg10" },
284 { TYDREAL,TYDREAL,1,"d_lg10" },
286 { TYREAL,TYREAL,1,"r_sin", 4 },
287 { TYDREAL,TYDREAL,1,"d_sin", 4 },
288 { TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
289 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
291 { TYREAL,TYREAL,1,"r_cos", 5 },
292 { TYDREAL,TYDREAL,1,"d_cos", 5 },
293 { TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
294 { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
296 { TYREAL,TYREAL,1,"r_tan", 6 },
297 { TYDREAL,TYDREAL,1,"d_tan", 6 },
299 { TYREAL,TYREAL,1,"r_asin", 7 },
300 { TYDREAL,TYDREAL,1,"d_asin", 7 },
302 { TYREAL,TYREAL,1,"r_acos", 8 },
303 { TYDREAL,TYDREAL,1,"d_acos", 8 },
305 { TYREAL,TYREAL,1,"r_atan", 9 },
306 { TYDREAL,TYDREAL,1,"d_atan", 9 },
308 { TYREAL,TYREAL,2,"r_atn2", 10 },
309 { TYDREAL,TYDREAL,2,"d_atn2", 10 },
311 { TYREAL,TYREAL,1,"r_sinh", 11 },
312 { TYDREAL,TYDREAL,1,"d_sinh", 11 },
314 { TYREAL,TYREAL,1,"r_cosh", 12 },
315 { TYDREAL,TYDREAL,1,"d_cosh", 12 },
317 { TYREAL,TYREAL,1,"r_tanh", 13 },
318 { TYDREAL,TYDREAL,1,"d_tanh", 13 },
320 { TYCHAR,TYLOGICAL,2,"hl_ge" },
321 { TYCHAR,TYLOGICAL,2,"l_ge" },
323 { TYCHAR,TYLOGICAL,2,"hl_gt" },
324 { TYCHAR,TYLOGICAL,2,"l_gt" },
326 { TYCHAR,TYLOGICAL,2,"hl_le" },
327 { TYCHAR,TYLOGICAL,2,"l_le" },
329 { TYCHAR,TYLOGICAL,2,"hl_lt" },
330 { TYCHAR,TYLOGICAL,2,"l_lt" },
332 { TYREAL,TYSHORT,1,"hr_expn" },
333 { TYREAL,TYLONG,1,"ir_expn" },
334 { TYDREAL,TYSHORT,1,"hd_expn" },
335 { TYDREAL,TYLONG,1,"id_expn" },
337 { TYREAL,TYREAL,1,"r_absp" },
338 { TYDREAL,TYDREAL,1,"d_absp" },
340 { TYREAL,TYDREAL,1,"r_rrsp" },
341 { TYDREAL,TYDREAL,1,"d_rrsp" },
343 { TYREAL,TYREAL,1,"r_frac" },
344 { TYDREAL,TYDREAL,1,"d_frac" },
346 { TYREAL,TYREAL,2,"r_make" },
347 { TYDREAL,TYDREAL,2,"d_make" },
349 { TYREAL,TYREAL,2,"r_scal" },
350 { TYDREAL,TYDREAL,2,"d_scal" },
355 LOCAL struct Incstblock
362 { TYSHORT, TYLONG, 0 },
363 { TYLONG, TYLONG, 1 },
364 { TYREAL, TYLONG, 2 },
365 { TYDREAL, TYLONG, 3 },
367 { TYSHORT, TYLONG, 4 },
368 { TYLONG, TYLONG, 5 },
369 { TYREAL, TYLONG, 6 },
370 { TYDREAL, TYLONG, 7 },
372 { TYREAL, TYLONG, 8 },
373 { TYDREAL, TYLONG, 9 },
375 { TYREAL, TYLONG, 10 },
376 { TYDREAL, TYLONG, 11 },
378 { TYREAL, TYREAL, 0 },
379 { TYDREAL, TYDREAL, 1 },
381 { TYSHORT, TYLONG, 12 },
382 { TYLONG, TYLONG, 13 },
383 { TYREAL, TYREAL, 2 },
384 { TYDREAL, TYDREAL, 3 },
386 { TYREAL, TYREAL, 4 },
387 { TYDREAL, TYDREAL, 5 }
391 char *callbyvalue[ ] =
409 r8fix() /* adjust tables for -r8 */
411 register struct Intrblock *I;
412 register struct Specblock *S;
414 for(I = intrtab; I->intrfname[0]; I++)
415 if (I->intrval.intrgroup != INTRGEN)
416 switch(I->intrval.intrstuff) {
418 I->intrval.intrstuff = TYDREAL;
419 I->intrval.intrno = I->intrval.dblintrno;
422 I->intrval.intrstuff = TYDCOMPLEX;
423 I->intrval.intrno = I->intrval.dblintrno;
424 I->intrval.dblcmplx = 1;
427 for(S = spectab; S->atype; S++)
430 S->atype = TYDCOMPLEX;
431 if (S->rtype == TYREAL)
433 else if (S->rtype == TYCOMPLEX)
434 S->rtype = TYDCOMPLEX;
435 switch(S->spxname[0]) {
451 if (S->spxname[0] != 'r')
454 case TYDREAL: /* d_prod */
458 if (!strcmp(S->spxname, "hr_expn"))
460 else if (!strcmp(S->spxname, "h_nint"))
461 strcpy(S->spxname, "h_dnnt");
462 else Fatal("r8fix bug");
466 if (!strcmp(S->spxname, "ir_expn"))
468 else if (!strcmp(S->spxname, "i_nint"))
469 strcpy(S->spxname, "i_dnnt");
470 else Fatal("r8fix bug");
479 expptr intrcall(np, argsp, nargs)
481 struct Listblock *argsp;
486 register struct Specblock *sp;
487 register struct Chain *cp;
488 expptr Inline(), mkcxcon(), mkrealcon();
492 int f1field, f2field, f3field;
494 packed.ijunk = np->vardesc.varno;
495 f1field = packed.bits.f1;
496 f2field = packed.bits.f2;
497 f3field = packed.bits.f3;
502 for(cp = argsp->listp ; cp ; cp = cp->nextp)
504 ep = (expptr)cp->datap;
505 if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
506 cp->datap = (char *) mkconv(tyint, ep);
507 mtype = maxtype(mtype, ep->headblock.vtype);
514 if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
520 q = mkexpr(OPBITNOT, (expptr)argsp->listp->datap, ENULL);
526 q = mkexpr(op, (expptr)argsp->listp->datap,
527 (expptr)argsp->listp->nextp->datap);
529 frchain( &(argsp->listp) );
530 free( (charptr) argsp);
535 if(rettype == TYLONG)
537 if( ISCOMPLEX(rettype) && nargs==2)
540 qr = (expptr) argsp->listp->datap;
541 qi = (expptr) argsp->listp->nextp->datap;
542 if(ISCONST(qr) && ISCONST(qi))
544 else q = mkexpr(OPCONV,mkconv(rettype-2,qr),
545 mkconv(rettype-2,qi));
547 else if(nargs == 1) {
548 if (f3field && ((Exprp)argsp->listp->datap)->vtype
551 q = mkconv(rettype, (expptr)argsp->listp->datap);
555 q->headblock.vtype = rettype;
556 frchain(&(argsp->listp));
557 free( (charptr) argsp);
564 /* Machine-dependent f77 stuff that f2c omits:
569 radix for single precision
570 radix for double precision
571 precision for short int
572 precision for long int
573 precision for single precision
574 precision for double precision
575 emin for single precision
576 emin for double precision
577 emax for single precision
578 emax for double prcision
583 tiny for single precision
584 tiny for double precision
585 huge for single precision
586 huge for double precision
587 mrsp (epsilon) for single precision
588 mrsp (epsilon) for double precision
590 { register struct Incstblock *cstp;
591 extern ftnint intcon[14];
592 extern double realcon[6];
594 cstp = consttab + f3field;
595 for(i=0 ; i<f2field ; ++i)
596 if(cstp->atype == mtype)
606 return(mkintcon(intcon[cstp->constno]));
610 return(mkrealcon(cstp->rtype,
611 realcon[cstp->constno]) );
614 Fatal("impossible intrinsic constant");
620 sp = spectab + f3field;
622 if(sp->atype == mtype)
624 else err66("generic function");
626 for(i=0; i<f2field ; ++i)
627 if(sp->atype == mtype)
631 warn1 ("bad argument type to intrinsic %s", np->fvarname);
633 /* Made this a warning rather than an error so things like "log (5) ==>
634 log (5.0)" can be accommodated. When none of these cases matches, the
635 argument is cast up to the first type in the spectab list; this first
636 type is assumed to be the "smallest" type, e.g. REAL before DREAL
637 before COMPLEX, before DCOMPLEX */
639 sp = spectab + f3field;
644 sp = spectab + f3field;
646 if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL))
647 && (sp+1)->atype==sp->atype)
650 if(nargs != sp->nargs)
652 if(mtype != sp->atype)
655 /* NOTE!! I moved fixargs (YES) into the ELSE branch so that constants in
656 the inline expression wouldn't get put into the constant table */
659 cast_args (mtype, argsp -> listp);
661 if(q = Inline(sp-spectab, mtype, argsp->listp))
663 frchain( &(argsp->listp) );
664 free( (charptr) argsp);
668 /* C library routines that return double... */
669 /* sp->rtype might be TYREAL */
670 ap = builtin(sp->rtype,
671 callbyvalue[sp->othername], 1);
673 mkexpr(OPCCALL, (expptr)ap, (expptr)argsp) );
676 ap = builtin(sp->rtype, sp->spxname, 0);
678 mkexpr(OPCALL, (expptr)ap, (expptr)argsp) );
687 if( ! ONEOF(mtype, MSKINT|MSKREAL) )
689 argsp->vtype = mtype;
690 q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), (expptr)argsp, ENULL);
692 q->headblock.vtype = mtype;
694 if(rettype == TYLONG)
696 else if(rettype == TYUNKNOWN)
698 return( mkconv(rettype, q) );
701 fatali("intrcall: bad intrgroup %d", f1field);
704 errstr("bad number of arguments to intrinsic %s", np->fvarname);
708 errstr("bad argument type to intrinsic %s", np->fvarname);
720 register struct Intrblock *p;
722 for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
724 if( !strcmp(s, p->intrfname) )
726 packed.bits.f1 = p->intrval.intrgroup;
727 packed.bits.f2 = p->intrval.intrstuff;
728 packed.bits.f3 = p->intrval.intrno;
729 packed.bits.f4 = p->intrval.dblcmplx;
730 return(packed.ijunk);
745 register struct Specblock *sp;
748 if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
749 fatalstr("intraddr: %s is not intrinsic", np->fvarname);
750 packed.ijunk = np->vardesc.varno;
751 f3field = packed.bits.f3;
753 switch(packed.bits.f1)
756 /* imag, log, and log10 arent specific functions */
757 if(f3field==31 || f3field==43 || f3field==47)
761 sp = spectab + f3field;
762 if(tyint==TYLONG && sp->rtype==TYSHORT)
764 q = builtin(sp->rtype, sp->spxname,
765 sp->othername ? 1 : 0);
774 errstr("cannot pass %s as actual", np->fvarname);
775 return((Addrp)errnode());
777 fatali("intraddr: impossible f1=%d\n", (int) packed.bits.f1);
778 /* NOT REACHED */ return 0;
783 void cast_args (maxtype, args)
787 for (; args; args = args -> nextp) {
788 expptr e = (expptr) args->datap;
789 if (e -> headblock.vtype != maxtype)
790 if (e -> tag == TCONST)
791 args->datap = (char *) mkconv(maxtype, e);
793 Addrp temp = Mktemp(maxtype, ENULL);
795 puteq(cpexpr((expptr)temp), e);
796 args->datap = (char *)temp;
803 expptr Inline(fno, type, args)
808 register expptr q, t, t1;
812 case 8: /* real abs */
813 case 9: /* short int abs */
814 case 10: /* long int abs */
815 case 11: /* double precision abs */
816 if( addressable(q = (expptr) args->datap) )
822 t = (expptr) Mktemp(type,ENULL);
823 t1 = mkexpr(type == TYREAL && forcedouble ? OPDABS : OPABS,
826 t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
831 q = mkexpr(OPSTAR, mkconv(TYDREAL,(expptr)args->datap),
832 (expptr)args->nextp->datap);
835 case 27: /* len of character string */
836 q = (expptr) cpexpr(((tagptr)args->datap)->headblock.vleng);
837 frexpr((expptr)args->datap);
840 case 14: /* half-integer mod */
842 return mkexpr(OPMOD, (expptr) args->datap,
843 (expptr) args->nextp->datap);