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 *
intrcall(np,argsp,nargs)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
intrfunct(s)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 *
intraddr(np)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 *
finline(int fno,int type,chainp args)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