1 /* $Id: intr.c,v 1.1.1.1 2008/08/24 05:33:07 gmcgarry Exp $ */ 2 /* 3 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved. 4 * 5 * Redistribution and use in source and binary forms, with or without 6 * modification, are permitted provided that the following conditions 7 * are met: 8 * 9 * Redistributions of source code and documentation must retain the above 10 * copyright notice, this list of conditions and the following disclaimer. 11 * Redistributions in binary form must reproduce the above copyright 12 * notice, this list of conditions and the following disclaimer in the 13 * documentation and/or other materials provided with the distribution. 14 * All advertising materials mentioning features or use of this software 15 * must display the following acknowledgement: 16 * This product includes software developed or owned by Caldera 17 * International, Inc. 18 * Neither the name of Caldera International, Inc. nor the names of other 19 * contributors may be used to endorse or promote products derived from 20 * this software without specific prior written permission. 21 * 22 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA 23 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR 24 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 25 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 26 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE 27 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 28 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 29 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 30 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT, 31 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 32 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 * POSSIBILITY OF SUCH DAMAGE. 34 */ 35 36 #include "defines.h" 37 #include "defs.h" 38 39 40 static struct bigblock *finline(int, int, chainp); 41 42 union 43 { 44 int ijunk; 45 struct intrpacked bits; 46 } packed; 47 48 struct intrbits 49 { 50 int intrgroup /* :3 */; 51 int intrstuff /* result type or number of generics */; 52 int intrno /* :7 */; 53 }; 54 55 LOCAL struct intrblock 56 { 57 char intrfname[VL]; 58 struct intrbits intrval; 59 } intrtab[ ] = 60 { 61 { "int", { INTRCONV, TYLONG }, }, 62 { "real", { INTRCONV, TYREAL }, }, 63 { "dble", { INTRCONV, TYDREAL }, }, 64 { "cmplx", { INTRCONV, TYCOMPLEX }, }, 65 { "dcmplx", { INTRCONV, TYDCOMPLEX }, }, 66 { "ifix", { INTRCONV, TYLONG }, }, 67 { "idint", { INTRCONV, TYLONG }, }, 68 { "float", { INTRCONV, TYREAL }, }, 69 { "dfloat", { INTRCONV, TYDREAL }, }, 70 { "sngl", { INTRCONV, TYREAL }, }, 71 { "ichar", { INTRCONV, TYLONG }, }, 72 { "char", { INTRCONV, TYCHAR }, }, 73 74 { "max", { INTRMAX, TYUNKNOWN }, }, 75 { "max0", { INTRMAX, TYLONG }, }, 76 { "amax0", { INTRMAX, TYREAL }, }, 77 { "max1", { INTRMAX, TYLONG }, }, 78 { "amax1", { INTRMAX, TYREAL }, }, 79 { "dmax1", { INTRMAX, TYDREAL }, }, 80 81 { "and", { INTRBOOL, TYUNKNOWN, OPBITAND }, }, 82 { "or", { INTRBOOL, TYUNKNOWN, OPBITOR }, }, 83 { "xor", { INTRBOOL, TYUNKNOWN, OPBITXOR }, }, 84 { "not", { INTRBOOL, TYUNKNOWN, OPBITNOT }, }, 85 { "lshift", { INTRBOOL, TYUNKNOWN, OPLSHIFT }, }, 86 { "rshift", { INTRBOOL, TYUNKNOWN, OPRSHIFT }, }, 87 88 { "min", { INTRMIN, TYUNKNOWN }, }, 89 { "min0", { INTRMIN, TYLONG }, }, 90 { "amin0", { INTRMIN, TYREAL }, }, 91 { "min1", { INTRMIN, TYLONG }, }, 92 { "amin1", { INTRMIN, TYREAL }, }, 93 { "dmin1", { INTRMIN, TYDREAL }, }, 94 95 { "aint", { INTRGEN, 2, 0 }, }, 96 { "dint", { INTRSPEC, TYDREAL, 1 }, }, 97 98 { "anint", { INTRGEN, 2, 2 }, }, 99 { "dnint", { INTRSPEC, TYDREAL, 3 }, }, 100 101 { "nint", { INTRGEN, 4, 4 }, }, 102 { "idnint", { INTRGEN, 2, 6 }, }, 103 104 { "abs", { INTRGEN, 6, 8 }, }, 105 { "iabs", { INTRGEN, 2, 9 }, }, 106 { "dabs", { INTRSPEC, TYDREAL, 11 }, }, 107 { "cabs", { INTRSPEC, TYREAL, 12 }, }, 108 { "zabs", { INTRSPEC, TYDREAL, 13 }, }, 109 110 { "mod", { INTRGEN, 4, 14 }, }, 111 { "amod", { INTRSPEC, TYREAL, 16 }, }, 112 { "dmod", { INTRSPEC, TYDREAL, 17 }, }, 113 114 { "sign", { INTRGEN, 4, 18 }, }, 115 { "isign", { INTRGEN, 2, 19 }, }, 116 { "dsign", { INTRSPEC, TYDREAL, 21 }, }, 117 118 { "dim", { INTRGEN, 4, 22 }, }, 119 { "idim", { INTRGEN, 2, 23 }, }, 120 { "ddim", { INTRSPEC, TYDREAL, 25 }, }, 121 122 { "dprod", { INTRSPEC, TYDREAL, 26 }, }, 123 124 { "len", { INTRSPEC, TYLONG, 27 }, }, 125 { "index", { INTRSPEC, TYLONG, 29 }, }, 126 127 { "imag", { INTRGEN, 2, 31 }, }, 128 { "aimag", { INTRSPEC, TYREAL, 31 }, }, 129 { "dimag", { INTRSPEC, TYDREAL, 32 }, }, 130 131 { "conjg", { INTRGEN, 2, 33 }, }, 132 { "dconjg", { INTRSPEC, TYDCOMPLEX, 34 }, }, 133 134 { "sqrt", { INTRGEN, 4, 35 }, }, 135 { "dsqrt", { INTRSPEC, TYDREAL, 36 }, }, 136 { "csqrt", { INTRSPEC, TYCOMPLEX, 37 }, }, 137 { "zsqrt", { INTRSPEC, TYDCOMPLEX, 38 }, }, 138 139 { "exp", { INTRGEN, 4, 39 }, }, 140 { "dexp", { INTRSPEC, TYDREAL, 40 }, }, 141 { "cexp", { INTRSPEC, TYCOMPLEX, 41 }, }, 142 { "zexp", { INTRSPEC, TYDCOMPLEX, 42 }, }, 143 144 { "log", { INTRGEN, 4, 43 }, }, 145 { "alog", { INTRSPEC, TYREAL, 43 }, }, 146 { "dlog", { INTRSPEC, TYDREAL, 44 }, }, 147 { "clog", { INTRSPEC, TYCOMPLEX, 45 }, }, 148 { "zlog", { INTRSPEC, TYDCOMPLEX, 46 }, }, 149 150 { "log10", { INTRGEN, 2, 47 }, }, 151 { "alog10", { INTRSPEC, TYREAL, 47 }, }, 152 { "dlog10", { INTRSPEC, TYDREAL, 48 }, }, 153 154 { "sin", { INTRGEN, 4, 49 }, }, 155 { "dsin", { INTRSPEC, TYDREAL, 50 }, }, 156 { "csin", { INTRSPEC, TYCOMPLEX, 51 }, }, 157 { "zsin", { INTRSPEC, TYDCOMPLEX, 52 }, }, 158 159 { "cos", { INTRGEN, 4, 53 }, }, 160 { "dcos", { INTRSPEC, TYDREAL, 54 }, }, 161 { "ccos", { INTRSPEC, TYCOMPLEX, 55 }, }, 162 { "zcos", { INTRSPEC, TYDCOMPLEX, 56 }, }, 163 164 { "tan", { INTRGEN, 2, 57 }, }, 165 { "dtan", { INTRSPEC, TYDREAL, 58 }, }, 166 167 { "asin", { INTRGEN, 2, 59 }, }, 168 { "dasin", { INTRSPEC, TYDREAL, 60 }, }, 169 170 { "acos", { INTRGEN, 2, 61 }, }, 171 { "dacos", { INTRSPEC, TYDREAL, 62 }, }, 172 173 { "atan", { INTRGEN, 2, 63 }, }, 174 { "datan", { INTRSPEC, TYDREAL, 64 }, }, 175 176 { "atan2", { INTRGEN, 2, 65 }, }, 177 { "datan2", { INTRSPEC, TYDREAL, 66 }, }, 178 179 { "sinh", { INTRGEN, 2, 67 }, }, 180 { "dsinh", { INTRSPEC, TYDREAL, 68 }, }, 181 182 { "cosh", { INTRGEN, 2, 69 }, }, 183 { "dcosh", { INTRSPEC, TYDREAL, 70 }, }, 184 185 { "tanh", { INTRGEN, 2, 71 }, }, 186 { "dtanh", { INTRSPEC, TYDREAL, 72 }, }, 187 188 { "lge", { INTRSPEC, TYLOGICAL, 73}, }, 189 { "lgt", { INTRSPEC, TYLOGICAL, 75}, }, 190 { "lle", { INTRSPEC, TYLOGICAL, 77}, }, 191 { "llt", { INTRSPEC, TYLOGICAL, 79}, }, 192 193 { "" }, }; 194 195 196 LOCAL struct specblock 197 { 198 char atype; 199 char rtype; 200 char nargs; 201 char spxname[XL]; 202 char othername; /* index into callbyvalue table */ 203 } spectab[ ] = 204 { 205 { TYREAL,TYREAL,1,"r_int" }, 206 { TYDREAL,TYDREAL,1,"d_int" }, 207 208 { TYREAL,TYREAL,1,"r_nint" }, 209 { TYDREAL,TYDREAL,1,"d_nint" }, 210 211 { TYREAL,TYSHORT,1,"h_nint" }, 212 { TYREAL,TYLONG,1,"i_nint" }, 213 214 { TYDREAL,TYSHORT,1,"h_dnnt" }, 215 { TYDREAL,TYLONG,1,"i_dnnt" }, 216 217 { TYREAL,TYREAL,1,"r_abs" }, 218 { TYSHORT,TYSHORT,1,"h_abs" }, 219 { TYLONG,TYLONG,1,"i_abs" }, 220 { TYDREAL,TYDREAL,1,"d_abs" }, 221 { TYCOMPLEX,TYREAL,1,"c_abs" }, 222 { TYDCOMPLEX,TYDREAL,1,"z_abs" }, 223 224 { TYSHORT,TYSHORT,2,"h_mod" }, 225 { TYLONG,TYLONG,2,"i_mod" }, 226 { TYREAL,TYREAL,2,"r_mod" }, 227 { TYDREAL,TYDREAL,2,"d_mod" }, 228 229 { TYREAL,TYREAL,2,"r_sign" }, 230 { TYSHORT,TYSHORT,2,"h_sign" }, 231 { TYLONG,TYLONG,2,"i_sign" }, 232 { TYDREAL,TYDREAL,2,"d_sign" }, 233 234 { TYREAL,TYREAL,2,"r_dim" }, 235 { TYSHORT,TYSHORT,2,"h_dim" }, 236 { TYLONG,TYLONG,2,"i_dim" }, 237 { TYDREAL,TYDREAL,2,"d_dim" }, 238 239 { TYREAL,TYDREAL,2,"d_prod" }, 240 241 { TYCHAR,TYSHORT,1,"h_len" }, 242 { TYCHAR,TYLONG,1,"i_len" }, 243 244 { TYCHAR,TYSHORT,2,"h_indx" }, 245 { TYCHAR,TYLONG,2,"i_indx" }, 246 247 { TYCOMPLEX,TYREAL,1,"r_imag" }, 248 { TYDCOMPLEX,TYDREAL,1,"d_imag" }, 249 { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" }, 250 { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" }, 251 252 { TYREAL,TYREAL,1,"r_sqrt", 1 }, 253 { TYDREAL,TYDREAL,1,"d_sqrt", 1 }, 254 { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" }, 255 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" }, 256 257 { TYREAL,TYREAL,1,"r_exp", 2 }, 258 { TYDREAL,TYDREAL,1,"d_exp", 2 }, 259 { TYCOMPLEX,TYCOMPLEX,1,"c_exp" }, 260 { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" }, 261 262 { TYREAL,TYREAL,1,"r_log", 3 }, 263 { TYDREAL,TYDREAL,1,"d_log", 3 }, 264 { TYCOMPLEX,TYCOMPLEX,1,"c_log" }, 265 { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" }, 266 267 { TYREAL,TYREAL,1,"r_lg10" }, 268 { TYDREAL,TYDREAL,1,"d_lg10" }, 269 270 { TYREAL,TYREAL,1,"r_sin", 4 }, 271 { TYDREAL,TYDREAL,1,"d_sin", 4 }, 272 { TYCOMPLEX,TYCOMPLEX,1,"c_sin" }, 273 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" }, 274 275 { TYREAL,TYREAL,1,"r_cos", 5 }, 276 { TYDREAL,TYDREAL,1,"d_cos", 5 }, 277 { TYCOMPLEX,TYCOMPLEX,1,"c_cos" }, 278 { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" }, 279 280 { TYREAL,TYREAL,1,"r_tan", 6 }, 281 { TYDREAL,TYDREAL,1,"d_tan", 6 }, 282 283 { TYREAL,TYREAL,1,"r_asin", 7 }, 284 { TYDREAL,TYDREAL,1,"d_asin", 7 }, 285 286 { TYREAL,TYREAL,1,"r_acos", 8 }, 287 { TYDREAL,TYDREAL,1,"d_acos", 8 }, 288 289 { TYREAL,TYREAL,1,"r_atan", 9 }, 290 { TYDREAL,TYDREAL,1,"d_atan", 9 }, 291 292 { TYREAL,TYREAL,2,"r_atn2", 10 }, 293 { TYDREAL,TYDREAL,2,"d_atn2", 10 }, 294 295 { TYREAL,TYREAL,1,"r_sinh", 11 }, 296 { TYDREAL,TYDREAL,1,"d_sinh", 11 }, 297 298 { TYREAL,TYREAL,1,"r_cosh", 12 }, 299 { TYDREAL,TYDREAL,1,"d_cosh", 12 }, 300 301 { TYREAL,TYREAL,1,"r_tanh", 13 }, 302 { TYDREAL,TYDREAL,1,"d_tanh", 13 }, 303 304 { TYCHAR,TYLOGICAL,2,"hl_ge" }, 305 { TYCHAR,TYLOGICAL,2,"l_ge" }, 306 307 { TYCHAR,TYLOGICAL,2,"hl_gt" }, 308 { TYCHAR,TYLOGICAL,2,"l_gt" }, 309 310 { TYCHAR,TYLOGICAL,2,"hl_le" }, 311 { TYCHAR,TYLOGICAL,2,"l_le" }, 312 313 { TYCHAR,TYLOGICAL,2,"hl_lt" }, 314 { TYCHAR,TYLOGICAL,2,"l_lt" } 315 } ; 316 317 318 319 320 321 322 char callbyvalue[ ][XL] = 323 { 324 "sqrt", 325 "exp", 326 "log", 327 "sin", 328 "cos", 329 "tan", 330 "asin", 331 "acos", 332 "atan", 333 "atan2", 334 "sinh", 335 "cosh", 336 "tanh" 337 }; 338 339 struct bigblock * 340 intrcall(np, argsp, nargs) 341 struct bigblock *np; 342 struct bigblock *argsp; 343 int nargs; 344 { 345 int i, rettype; 346 struct bigblock *ap; 347 register struct specblock *sp; 348 struct bigblock *q; 349 register chainp cp; 350 bigptr ep; 351 int mtype; 352 int op; 353 354 packed.ijunk = np->b_name.vardesc.varno; 355 if(nargs == 0) 356 goto badnargs; 357 358 mtype = 0; 359 for(cp = argsp->b_list.listp ; cp ; cp = cp->chain.nextp) 360 { 361 /* TEMPORARY */ ep = cp->chain.datap; 362 /* TEMPORARY */ if( ISCONST(ep) && ep->vtype==TYSHORT ) 363 /* TEMPORARY */ cp->chain.datap = mkconv(tyint, ep); 364 mtype = maxtype(mtype, ep->vtype); 365 } 366 367 switch(packed.bits.f1) 368 { 369 case INTRBOOL: 370 op = packed.bits.f3; 371 if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) ) 372 goto badtype; 373 if(op == OPBITNOT) 374 { 375 if(nargs != 1) 376 goto badnargs; 377 q = mkexpr(OPBITNOT, argsp->b_list.listp->chain.datap, NULL); 378 } 379 else 380 { 381 if(nargs != 2) 382 goto badnargs; 383 q = mkexpr(op, argsp->b_list.listp->chain.datap, 384 argsp->b_list.listp->chain.nextp->chain.datap); 385 } 386 frchain( &(argsp->b_list.listp) ); 387 ckfree(argsp); 388 return(q); 389 390 case INTRCONV: 391 rettype = packed.bits.f2; 392 if(rettype == TYLONG) 393 rettype = tyint; 394 if( ISCOMPLEX(rettype) && nargs==2) 395 { 396 bigptr qr, qi; 397 qr = argsp->b_list.listp->chain.datap; 398 qi = argsp->b_list.listp->chain.nextp->chain.datap; 399 if(ISCONST(qr) && ISCONST(qi)) 400 q = mkcxcon(qr,qi); 401 else q = mkexpr(OPCONV,mkconv(rettype-2,qr), 402 mkconv(rettype-2,qi)); 403 } 404 else if(nargs == 1) 405 q = mkconv(rettype, argsp->b_list.listp->chain.datap); 406 else goto badnargs; 407 408 q->vtype = rettype; 409 frchain(&(argsp->b_list.listp)); 410 ckfree(argsp); 411 return(q); 412 413 414 case INTRGEN: 415 sp = spectab + packed.bits.f3; 416 for(i=0; i<packed.bits.f2 ; ++i) 417 if(sp->atype == mtype) { 418 if (tyint == TYLONG && 419 sp->rtype == TYSHORT && 420 sp[1].atype == mtype) 421 sp++; /* use long int */ 422 goto specfunct; 423 } else 424 ++sp; 425 goto badtype; 426 427 case INTRSPEC: 428 sp = spectab + packed.bits.f3; 429 if(tyint==TYLONG && sp->rtype==TYSHORT) 430 ++sp; 431 432 specfunct: 433 if(nargs != sp->nargs) 434 goto badnargs; 435 if(mtype != sp->atype) 436 goto badtype; 437 fixargs(YES, argsp); 438 if((q = finline(sp-spectab, mtype, argsp->b_list.listp))) 439 { 440 frchain( &(argsp->b_list.listp) ); 441 ckfree(argsp); 442 } 443 else if(sp->othername) 444 { 445 ap = builtin(sp->rtype, 446 varstr(XL, callbyvalue[sp->othername-1]) ); 447 q = fixexpr( mkexpr(OPCCALL, ap, argsp) ); 448 } 449 else 450 { 451 ap = builtin(sp->rtype, varstr(XL, sp->spxname) ); 452 q = fixexpr( mkexpr(OPCALL, ap, argsp) ); 453 } 454 return(q); 455 456 case INTRMIN: 457 case INTRMAX: 458 if(nargs < 2) 459 goto badnargs; 460 if( ! ONEOF(mtype, MSKINT|MSKREAL) ) 461 goto badtype; 462 argsp->vtype = mtype; 463 q = mkexpr( (packed.bits.f1==INTRMIN ? OPMIN : OPMAX), argsp, NULL); 464 465 q->vtype = mtype; 466 rettype = packed.bits.f2; 467 if(rettype == TYLONG) 468 rettype = tyint; 469 else if(rettype == TYUNKNOWN) 470 rettype = mtype; 471 return( mkconv(rettype, q) ); 472 473 default: 474 fatal1("intrcall: bad intrgroup %d", packed.bits.f1); 475 } 476 badnargs: 477 err1("bad number of arguments to intrinsic %s", 478 varstr(VL,np->b_name.varname) ); 479 goto bad; 480 481 badtype: 482 err1("bad argument type to intrinsic %s", varstr(VL, np->b_name.varname) ); 483 484 bad: 485 return( errnode() ); 486 } 487 488 489 490 int 491 intrfunct(s) 492 char s[VL]; 493 { 494 register struct intrblock *p; 495 char nm[VL]; 496 register int i; 497 498 for(i = 0 ; i<VL ; ++s) 499 nm[i++] = (*s==' ' ? '\0' : *s); 500 501 for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p) 502 { 503 if( eqn(VL, nm, p->intrfname) ) 504 { 505 packed.bits.f1 = p->intrval.intrgroup; 506 packed.bits.f2 = p->intrval.intrstuff; 507 packed.bits.f3 = p->intrval.intrno; 508 return(packed.ijunk); 509 } 510 } 511 512 return(0); 513 } 514 515 516 517 518 519 struct bigblock * 520 intraddr(np) 521 struct bigblock *np; 522 { 523 struct bigblock *q; 524 struct specblock *sp; 525 526 if(np->vclass!=CLPROC || np->b_name.vprocclass!=PINTRINSIC) 527 fatal1("intraddr: %s is not intrinsic", varstr(VL,np->b_name.varname)); 528 packed.ijunk = np->b_name.vardesc.varno; 529 530 switch(packed.bits.f1) 531 { 532 case INTRGEN: 533 /* imag, log, and log10 arent specific functions */ 534 if(packed.bits.f3==31 || packed.bits.f3==43 || packed.bits.f3==47) 535 goto bad; 536 537 case INTRSPEC: 538 sp = spectab + packed.bits.f3; 539 if(tyint==TYLONG && sp->rtype==TYSHORT) 540 ++sp; 541 q = builtin(sp->rtype, varstr(XL,sp->spxname) ); 542 return(q); 543 544 case INTRCONV: 545 case INTRMIN: 546 case INTRMAX: 547 case INTRBOOL: 548 bad: 549 err1("cannot pass %s as actual", 550 varstr(VL,np->b_name.varname)); 551 return( errnode() ); 552 } 553 fatal1("intraddr: impossible f1=%d\n", packed.bits.f1); 554 /* NOTREACHED */ 555 return 0; /* XXX gcc */ 556 } 557 558 559 560 561 /* 562 * Try to inline simple function calls. 563 */ 564 struct bigblock * 565 finline(int fno, int type, chainp args) 566 { 567 register struct bigblock *q, *t; 568 struct bigblock *x1; 569 int l1; 570 571 switch(fno) { 572 case 8: /* real abs */ 573 case 9: /* short int abs */ 574 case 10: /* long int abs */ 575 case 11: /* double precision abs */ 576 t = fmktemp(type, NULL); 577 putexpr(mkexpr(OPASSIGN, cpexpr(t), args->chain.datap)); 578 /* value now in t */ 579 580 /* if greater, jump to return */ 581 x1 = mkexpr(OPLE, cpexpr(t), mkconv(type,MKICON(0))); 582 l1 = newlabel(); 583 putif(x1, l1); 584 585 /* negate */ 586 putexpr(mkexpr(OPASSIGN, cpexpr(t), 587 mkexpr(OPNEG, cpexpr(t), NULL))); 588 putlabel(l1); 589 return(t); 590 591 case 26: /* dprod */ 592 q = mkexpr(OPSTAR, args->chain.datap, args->chain.nextp->chain.datap); 593 q->vtype = TYDREAL; 594 return(q); 595 596 case 27: /* len of character string */ 597 q = cpexpr(args->chain.datap->vleng); 598 frexpr(args->chain.datap); 599 return(q); 600 601 case 14: /* half-integer mod */ 602 case 15: /* mod */ 603 return( mkexpr(OPMOD, args->chain.datap, args->chain.nextp->chain.datap) ); 604 } 605 return(NULL); 606 } 607