source: mainline/uspace/app/pcc/f77/fcom/intr.c@ 9727b92

lfn serial ticket/834-toolchain-update topic/msim-upgrade topic/simplify-dev-export
Last change on this file since 9727b92 was a7de7182, checked in by Jiří Zárevúcky <zarevucky.jiri@…>, 14 years ago

Added pcc source tree (contents of pcc-1.0.0.tgz)
  • Property mode set to 100644
File size: 14.6 KB
RevLine 
[a7de7182]1/* $Id: intr.c,v 1.13 2008/05/11 15:28:03 ragge 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
40static struct bigblock *finline(int, int, chainp);
41
42union
43 {
44 int ijunk;
45 struct intrpacked bits;
46 } packed;
47
48struct intrbits
49 {
50 int intrgroup /* :3 */;
51 int intrstuff /* result type or number of generics */;
52 int intrno /* :7 */;
53 };
54
55LOCAL 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
197LOCAL 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
323char 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
341struct bigblock *
342intrcall(np, argsp, nargs)
343struct bigblock *np;
344struct bigblock *argsp;
345int nargs;
346{
347int i, rettype;
348struct bigblock *ap;
349register struct specblock *sp;
350struct bigblock *q;
351register chainp cp;
352bigptr ep;
353int mtype;
354int op;
355
356packed.ijunk = np->b_name.vardesc.varno;
357if(nargs == 0)
358 goto badnargs;
359
360mtype = 0;
361for(cp = argsp->b_list.listp ; cp ; cp = cp->chain.nextp)
362 {
363/* TEMPORARY */ ep = cp->chain.datap;
364/* TEMPORARY */ if( ISCONST(ep) && ep->vtype==TYSHORT )
365/* TEMPORARY */ cp->chain.datap = mkconv(tyint, ep);
366 mtype = maxtype(mtype, ep->vtype);
367 }
368
369switch(packed.bits.f1)
370 {
371 case INTRBOOL:
372 op = packed.bits.f3;
373 if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
374 goto badtype;
375 if(op == OPBITNOT)
376 {
377 if(nargs != 1)
378 goto badnargs;
379 q = mkexpr(OPBITNOT, argsp->b_list.listp->chain.datap, NULL);
380 }
381 else
382 {
383 if(nargs != 2)
384 goto badnargs;
385 q = mkexpr(op, argsp->b_list.listp->chain.datap,
386 argsp->b_list.listp->chain.nextp->chain.datap);
387 }
388 frchain( &(argsp->b_list.listp) );
389 ckfree(argsp);
390 return(q);
391
392 case INTRCONV:
393 rettype = packed.bits.f2;
394 if(rettype == TYLONG)
395 rettype = tyint;
396 if( ISCOMPLEX(rettype) && nargs==2)
397 {
398 bigptr qr, qi;
399 qr = argsp->b_list.listp->chain.datap;
400 qi = argsp->b_list.listp->chain.nextp->chain.datap;
401 if(ISCONST(qr) && ISCONST(qi))
402 q = mkcxcon(qr,qi);
403 else q = mkexpr(OPCONV,mkconv(rettype-2,qr),
404 mkconv(rettype-2,qi));
405 }
406 else if(nargs == 1)
407 q = mkconv(rettype, argsp->b_list.listp->chain.datap);
408 else goto badnargs;
409
410 q->vtype = rettype;
411 frchain(&(argsp->b_list.listp));
412 ckfree(argsp);
413 return(q);
414
415
416 case INTRGEN:
417 sp = spectab + packed.bits.f3;
418 for(i=0; i<packed.bits.f2 ; ++i)
419 if(sp->atype == mtype) {
420 if (tyint == TYLONG &&
421 sp->rtype == TYSHORT &&
422 sp[1].atype == mtype)
423 sp++; /* use long int */
424 goto specfunct;
425 } else
426 ++sp;
427 goto badtype;
428
429 case INTRSPEC:
430 sp = spectab + packed.bits.f3;
431 if(tyint==TYLONG && sp->rtype==TYSHORT)
432 ++sp;
433
434 specfunct:
435 if(nargs != sp->nargs)
436 goto badnargs;
437 if(mtype != sp->atype)
438 goto badtype;
439 fixargs(YES, argsp);
440 if((q = finline(sp-spectab, mtype, argsp->b_list.listp)))
441 {
442 frchain( &(argsp->b_list.listp) );
443 ckfree(argsp);
444 }
445 else if(sp->othername)
446 {
447 ap = builtin(sp->rtype,
448 varstr(XL, callbyvalue[sp->othername-1]) );
449 q = fixexpr( mkexpr(OPCCALL, ap, argsp) );
450 }
451 else
452 {
453 ap = builtin(sp->rtype, varstr(XL, sp->spxname) );
454 q = fixexpr( mkexpr(OPCALL, ap, argsp) );
455 }
456 return(q);
457
458 case INTRMIN:
459 case INTRMAX:
460 if(nargs < 2)
461 goto badnargs;
462 if( ! ONEOF(mtype, MSKINT|MSKREAL) )
463 goto badtype;
464 argsp->vtype = mtype;
465 q = mkexpr( (packed.bits.f1==INTRMIN ? OPMIN : OPMAX), argsp, NULL);
466
467 q->vtype = mtype;
468 rettype = packed.bits.f2;
469 if(rettype == TYLONG)
470 rettype = tyint;
471 else if(rettype == TYUNKNOWN)
472 rettype = mtype;
473 return( mkconv(rettype, q) );
474
475 default:
476 fatal1("intrcall: bad intrgroup %d", packed.bits.f1);
477 }
478badnargs:
479 err1("bad number of arguments to intrinsic %s",
480 varstr(VL,np->b_name.varname) );
481 goto bad;
482
483badtype:
484 err1("bad argument type to intrinsic %s", varstr(VL, np->b_name.varname) );
485
486bad:
487 return( errnode() );
488}
489
490
491
492int
493intrfunct(s)
494char s[VL];
495{
496register struct intrblock *p;
497char nm[VL];
498register int i;
499
500for(i = 0 ; i<VL ; ++s)
501 nm[i++] = (*s==' ' ? '\0' : *s);
502
503for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
504 {
505 if( eqn(VL, nm, p->intrfname) )
506 {
507 packed.bits.f1 = p->intrval.intrgroup;
508 packed.bits.f2 = p->intrval.intrstuff;
509 packed.bits.f3 = p->intrval.intrno;
510 return(packed.ijunk);
511 }
512 }
513
514return(0);
515}
516
517
518
519
520
521struct bigblock *
522intraddr(np)
523struct bigblock *np;
524{
525struct bigblock *q;
526struct specblock *sp;
527
528if(np->vclass!=CLPROC || np->b_name.vprocclass!=PINTRINSIC)
529 fatal1("intraddr: %s is not intrinsic", varstr(VL,np->b_name.varname));
530packed.ijunk = np->b_name.vardesc.varno;
531
532switch(packed.bits.f1)
533 {
534 case INTRGEN:
535 /* imag, log, and log10 arent specific functions */
536 if(packed.bits.f3==31 || packed.bits.f3==43 || packed.bits.f3==47)
537 goto bad;
538
539 case INTRSPEC:
540 sp = spectab + packed.bits.f3;
541 if(tyint==TYLONG && sp->rtype==TYSHORT)
542 ++sp;
543 q = builtin(sp->rtype, varstr(XL,sp->spxname) );
544 return(q);
545
546 case INTRCONV:
547 case INTRMIN:
548 case INTRMAX:
549 case INTRBOOL:
550 bad:
551 err1("cannot pass %s as actual",
552 varstr(VL,np->b_name.varname));
553 return( errnode() );
554 }
555fatal1("intraddr: impossible f1=%d\n", packed.bits.f1);
556/* NOTREACHED */
557return 0; /* XXX gcc */
558}
559
560
561
562
563/*
564 * Try to inline simple function calls.
565 */
566struct bigblock *
567finline(int fno, int type, chainp args)
568{
569 register struct bigblock *q, *t;
570 struct bigblock *x1;
571 int l1;
572
573 switch(fno) {
574 case 8: /* real abs */
575 case 9: /* short int abs */
576 case 10: /* long int abs */
577 case 11: /* double precision abs */
578 t = fmktemp(type, NULL);
579 putexpr(mkexpr(OPASSIGN, cpexpr(t), args->chain.datap));
580 /* value now in t */
581
582 /* if greater, jump to return */
583 x1 = mkexpr(OPLE, cpexpr(t), mkconv(type,MKICON(0)));
584 l1 = newlabel();
585 putif(x1, l1);
586
587 /* negate */
588 putexpr(mkexpr(OPASSIGN, cpexpr(t),
589 mkexpr(OPNEG, cpexpr(t), NULL)));
590 putlabel(l1);
591 return(t);
592
593 case 26: /* dprod */
594 q = mkexpr(OPSTAR, args->chain.datap, args->chain.nextp->chain.datap);
595 q->vtype = TYDREAL;
596 return(q);
597
598 case 27: /* len of character string */
599 q = cpexpr(args->chain.datap->vleng);
600 frexpr(args->chain.datap);
601 return(q);
602
603 case 14: /* half-integer mod */
604 case 15: /* mod */
605 return( mkexpr(OPMOD, args->chain.datap, args->chain.nextp->chain.datap) );
606 }
607return(NULL);
608}
Note: See TracBrowser for help on using the repository browser.