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