projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 4_2 development
[unix-history] / usr / src / usr.bin / f77 / src / f77pass1 / intr.c
CommitLineData
92233d52
C		 1#include "defs.h"
2
3extern ftnint intcon[14];
4extern double realcon[6];
5
6union
7 {
8 int ijunk;
9 struct Intrpacked bits;
10 } packed;
11
12struct Intrbits
13 {
14 int intrgroup /* :3 */;
15 int intrstuff /* result type or number of generics */;
16 int intrno /* :7 */;
17 };
18
19LOCAL struct Intrblock
20 {
21 char intrfname[VL];
22 struct Intrbits intrval;
23 } intrtab[ ] =
24{
25"int", { INTRCONV, TYLONG },
26"real", { INTRCONV, TYREAL },
27"dble", { INTRCONV, TYDREAL },
28"dreal", { INTRCONV, TYDREAL },
29"cmplx", { INTRCONV, TYCOMPLEX },
30"dcmplx", { INTRCONV, TYDCOMPLEX },
31"ifix", { INTRCONV, TYLONG },
32"idint", { INTRCONV, TYLONG },
33"float", { INTRCONV, TYREAL },
34"dfloat", { INTRCONV, TYDREAL },
35"sngl", { INTRCONV, TYREAL },
36"ichar", { INTRCONV, TYLONG },
37"iachar", { INTRCONV, TYLONG },
38"char", { INTRCONV, TYCHAR },
39"achar", { INTRCONV, TYCHAR },
40
41"max", { INTRMAX, TYUNKNOWN },
42"max0", { INTRMAX, TYLONG },
43"amax0", { INTRMAX, TYREAL },
44"max1", { INTRMAX, TYLONG },
45"amax1", { INTRMAX, TYREAL },
46"dmax1", { INTRMAX, TYDREAL },
47
48"and", { INTRBOOL, TYUNKNOWN, OPBITAND },
49"or", { INTRBOOL, TYUNKNOWN, OPBITOR },
50"xor", { INTRBOOL, TYUNKNOWN, OPBITXOR },
51"not", { INTRBOOL, TYUNKNOWN, OPBITNOT },
52"lshift", { INTRBOOL, TYUNKNOWN, OPLSHIFT },
53"rshift", { INTRBOOL, TYUNKNOWN, OPRSHIFT },
54
55"min", { INTRMIN, TYUNKNOWN },
56"min0", { INTRMIN, TYLONG },
57"amin0", { INTRMIN, TYREAL },
58"min1", { INTRMIN, TYLONG },
59"amin1", { INTRMIN, TYREAL },
60"dmin1", { INTRMIN, TYDREAL },
61
62"aint", { INTRGEN, 2, 0 },
63"dint", { INTRSPEC, TYDREAL, 1 },
64
65"anint", { INTRGEN, 2, 2 },
66"dnint", { INTRSPEC, TYDREAL, 3 },
67
68"nint", { INTRGEN, 4, 4 },
69"idnint", { INTRGEN, 2, 6 },
70
71"abs", { INTRGEN, 6, 8 },
72"iabs", { INTRGEN, 2, 9 },
73"dabs", { INTRSPEC, TYDREAL, 11 },
74"cabs", { INTRSPEC, TYREAL, 12 },
75"zabs", { INTRSPEC, TYDREAL, 13 },
76"cdabs", { INTRSPEC, TYDREAL, 13 },
77
78"mod", { INTRGEN, 4, 14 },
79"amod", { INTRSPEC, TYREAL, 16 },
80"dmod", { INTRSPEC, TYDREAL, 17 },
81
82"sign", { INTRGEN, 4, 18 },
83"isign", { INTRGEN, 2, 19 },
84"dsign", { INTRSPEC, TYDREAL, 21 },
85
86"dim", { INTRGEN, 4, 22 },
87"idim", { INTRGEN, 2, 23 },
88"ddim", { INTRSPEC, TYDREAL, 25 },
89
90"dprod", { INTRSPEC, TYDREAL, 26 },
91
92"len", { INTRSPEC, TYLONG, 27 },
93"index", { INTRSPEC, TYLONG, 29 },
94
95"imag", { INTRGEN, 2, 31 },
96"aimag", { INTRSPEC, TYREAL, 31 },
97"dimag", { INTRSPEC, TYDREAL, 32 },
98
99"conjg", { INTRGEN, 2, 33 },
100"dconjg", { INTRSPEC, TYDCOMPLEX, 34 },
101
102"sqrt", { INTRGEN, 4, 35 },
103"dsqrt", { INTRSPEC, TYDREAL, 36 },
104"csqrt", { INTRSPEC, TYCOMPLEX, 37 },
105"zsqrt", { INTRSPEC, TYDCOMPLEX, 38 },
106"cdsqrt", { INTRSPEC, TYDCOMPLEX, 38 },
107
108"exp", { INTRGEN, 4, 39 },
109"dexp", { INTRSPEC, TYDREAL, 40 },
110"cexp", { INTRSPEC, TYCOMPLEX, 41 },
111"zexp", { INTRSPEC, TYDCOMPLEX, 42 },
112"cdexp", { INTRSPEC, TYDCOMPLEX, 42 },
113
114"log", { INTRGEN, 4, 43 },
115"alog", { INTRSPEC, TYREAL, 43 },
116"dlog", { INTRSPEC, TYDREAL, 44 },
117"clog", { INTRSPEC, TYCOMPLEX, 45 },
118"zlog", { INTRSPEC, TYDCOMPLEX, 46 },
119"cdlog", { INTRSPEC, TYDCOMPLEX, 46 },
120
121"log10", { INTRGEN, 2, 47 },
122"alog10", { INTRSPEC, TYREAL, 47 },
123"dlog10", { INTRSPEC, TYDREAL, 48 },
124
125"sin", { INTRGEN, 4, 49 },
126"dsin", { INTRSPEC, TYDREAL, 50 },
127"csin", { INTRSPEC, TYCOMPLEX, 51 },
128"zsin", { INTRSPEC, TYDCOMPLEX, 52 },
129"cdsin", { INTRSPEC, TYDCOMPLEX, 52 },
130
131"cos", { INTRGEN, 4, 53 },
132"dcos", { INTRSPEC, TYDREAL, 54 },
133"ccos", { INTRSPEC, TYCOMPLEX, 55 },
134"zcos", { INTRSPEC, TYDCOMPLEX, 56 },
135"cdcos", { INTRSPEC, TYDCOMPLEX, 56 },
136
137"tan", { INTRGEN, 2, 57 },
138"dtan", { INTRSPEC, TYDREAL, 58 },
139
140"asin", { INTRGEN, 2, 59 },
141"dasin", { INTRSPEC, TYDREAL, 60 },
142
143"acos", { INTRGEN, 2, 61 },
144"dacos", { INTRSPEC, TYDREAL, 62 },
145
146"atan", { INTRGEN, 2, 63 },
147"datan", { INTRSPEC, TYDREAL, 64 },
148
149"atan2", { INTRGEN, 2, 65 },
150"datan2", { INTRSPEC, TYDREAL, 66 },
151
152"sinh", { INTRGEN, 2, 67 },
153"dsinh", { INTRSPEC, TYDREAL, 68 },
154
155"cosh", { INTRGEN, 2, 69 },
156"dcosh", { INTRSPEC, TYDREAL, 70 },
157
158"tanh", { INTRGEN, 2, 71 },
159"dtanh", { INTRSPEC, TYDREAL, 72 },
160
161"lge", { INTRSPEC, TYLOGICAL, 73},
162"lgt", { INTRSPEC, TYLOGICAL, 75},
163"lle", { INTRSPEC, TYLOGICAL, 77},
164"llt", { INTRSPEC, TYLOGICAL, 79},
165
166"epbase", { INTRCNST, 4, 0 },
167"epprec", { INTRCNST, 4, 4 },
168"epemin", { INTRCNST, 2, 8 },
169"epemax", { INTRCNST, 2, 10 },
170"eptiny", { INTRCNST, 2, 12 },
171"ephuge", { INTRCNST, 4, 14 },
172"epmrsp", { INTRCNST, 2, 18 },
173
174"fpexpn", { INTRGEN, 4, 81 },
175"fpabsp", { INTRGEN, 2, 85 },
176"fprrsp", { INTRGEN, 2, 87 },
177"fpfrac", { INTRGEN, 2, 89 },
178"fpmake", { INTRGEN, 2, 91 },
179"fpscal", { INTRGEN, 2, 93 },
180
181"" };
182\f
183
184LOCAL struct Specblock
185 {
186 char atype;
187 char rtype;
188 char nargs;
189 char spxname[XL];
190 char othername; /* index into callbyvalue table */
191 } spectab[ ] =
192{
193 { TYREAL,TYREAL,1,"r_int" },
194 { TYDREAL,TYDREAL,1,"d_int" },
195
196 { TYREAL,TYREAL,1,"r_nint" },
197 { TYDREAL,TYDREAL,1,"d_nint" },
198
199 { TYREAL,TYSHORT,1,"h_nint" },
200 { TYREAL,TYLONG,1,"i_nint" },
201
202 { TYDREAL,TYSHORT,1,"h_dnnt" },
203 { TYDREAL,TYLONG,1,"i_dnnt" },
204
205 { TYREAL,TYREAL,1,"r_abs" },
206 { TYSHORT,TYSHORT,1,"h_abs" },
207 { TYLONG,TYLONG,1,"i_abs" },
208 { TYDREAL,TYDREAL,1,"d_abs" },
209 { TYCOMPLEX,TYREAL,1,"c_abs" },
210 { TYDCOMPLEX,TYDREAL,1,"z_abs" },
211
212 { TYSHORT,TYSHORT,2,"h_mod" },
213 { TYLONG,TYLONG,2,"i_mod" },
214 { TYREAL,TYREAL,2,"r_mod" },
215 { TYDREAL,TYDREAL,2,"d_mod" },
216
217 { TYREAL,TYREAL,2,"r_sign" },
218 { TYSHORT,TYSHORT,2,"h_sign" },
219 { TYLONG,TYLONG,2,"i_sign" },
220 { TYDREAL,TYDREAL,2,"d_sign" },
221
222 { TYREAL,TYREAL,2,"r_dim" },
223 { TYSHORT,TYSHORT,2,"h_dim" },
224 { TYLONG,TYLONG,2,"i_dim" },
225 { TYDREAL,TYDREAL,2,"d_dim" },
226
227 { TYREAL,TYDREAL,2,"d_prod" },
228
229 { TYCHAR,TYSHORT,1,"h_len" },
230 { TYCHAR,TYLONG,1,"i_len" },
231
232 { TYCHAR,TYSHORT,2,"h_indx" },
233 { TYCHAR,TYLONG,2,"i_indx" },
234
235 { TYCOMPLEX,TYREAL,1,"r_imag" },
236 { TYDCOMPLEX,TYDREAL,1,"d_imag" },
237 { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
238 { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
239
240 { TYREAL,TYREAL,1,"r_sqrt", 1 },
241 { TYDREAL,TYDREAL,1,"d_sqrt", 1 },
242 { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
243 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
244
245 { TYREAL,TYREAL,1,"r_exp", 2 },
246 { TYDREAL,TYDREAL,1,"d_exp", 2 },
247 { TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
248 { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
249
250 { TYREAL,TYREAL,1,"r_log", 3 },
251 { TYDREAL,TYDREAL,1,"d_log", 3 },
252 { TYCOMPLEX,TYCOMPLEX,1,"c_log" },
253 { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
254
255 { TYREAL,TYREAL,1,"r_lg10" },
256 { TYDREAL,TYDREAL,1,"d_lg10" },
257
258 { TYREAL,TYREAL,1,"r_sin", 4 },
259 { TYDREAL,TYDREAL,1,"d_sin", 4 },
260 { TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
261 { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
262
263 { TYREAL,TYREAL,1,"r_cos", 5 },
264 { TYDREAL,TYDREAL,1,"d_cos", 5 },
265 { TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
266 { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
267
268 { TYREAL,TYREAL,1,"r_tan", 6 },
269 { TYDREAL,TYDREAL,1,"d_tan", 6 },
270
271 { TYREAL,TYREAL,1,"r_asin", 7 },
272 { TYDREAL,TYDREAL,1,"d_asin", 7 },
273
274 { TYREAL,TYREAL,1,"r_acos", 8 },
275 { TYDREAL,TYDREAL,1,"d_acos", 8 },
276
277 { TYREAL,TYREAL,1,"r_atan", 9 },
278 { TYDREAL,TYDREAL,1,"d_atan", 9 },
279
280 { TYREAL,TYREAL,2,"r_atn2", 10 },
281 { TYDREAL,TYDREAL,2,"d_atn2", 10 },
282
283 { TYREAL,TYREAL,1,"r_sinh", 11 },
284 { TYDREAL,TYDREAL,1,"d_sinh", 11 },
285
286 { TYREAL,TYREAL,1,"r_cosh", 12 },
287 { TYDREAL,TYDREAL,1,"d_cosh", 12 },
288
289 { TYREAL,TYREAL,1,"r_tanh", 13 },
290 { TYDREAL,TYDREAL,1,"d_tanh", 13 },
291
292 { TYCHAR,TYLOGICAL,2,"hl_ge" },
293 { TYCHAR,TYLOGICAL,2,"l_ge" },
294
295 { TYCHAR,TYLOGICAL,2,"hl_gt" },
296 { TYCHAR,TYLOGICAL,2,"l_gt" },
297
298 { TYCHAR,TYLOGICAL,2,"hl_le" },
299 { TYCHAR,TYLOGICAL,2,"l_le" },
300
301 { TYCHAR,TYLOGICAL,2,"hl_lt" },
302 { TYCHAR,TYLOGICAL,2,"l_lt" },
303
304 { TYREAL,TYSHORT,1,"hr_expn" },
305 { TYREAL,TYLONG,1,"ir_expn" },
306 { TYDREAL,TYSHORT,1,"hd_expn" },
307 { TYDREAL,TYLONG,1,"id_expn" },
308
309 { TYREAL,TYREAL,1,"r_absp" },
310 { TYDREAL,TYDREAL,1,"d_absp" },
311
312 { TYREAL,TYDREAL,1,"r_rrsp" },
313 { TYDREAL,TYDREAL,1,"d_rrsp" },
314
315 { TYREAL,TYREAL,1,"r_frac" },
316 { TYDREAL,TYDREAL,1,"d_frac" },
317
318 { TYREAL,TYREAL,2,"r_make" },
319 { TYDREAL,TYDREAL,2,"d_make" },
320
321 { TYREAL,TYREAL,2,"r_scal" },
322 { TYDREAL,TYDREAL,2,"d_scal" }
323} ;
324\f
325LOCAL struct Incstblock
326 {
327 char atype;
328 char rtype;
329 char constno;
330 } consttab[ ] =
331{
332 { TYSHORT, TYLONG, 0 },
333 { TYLONG, TYLONG, 1 },
334 { TYREAL, TYLONG, 2 },
335 { TYDREAL, TYLONG, 3 },
336
337 { TYSHORT, TYLONG, 4 },
338 { TYLONG, TYLONG, 5 },
339 { TYREAL, TYLONG, 6 },
340 { TYDREAL, TYLONG, 7 },
341
342 { TYREAL, TYLONG, 8 },
343 { TYDREAL, TYLONG, 9 },
344
345 { TYREAL, TYLONG, 10 },
346 { TYDREAL, TYLONG, 11 },
347
348 { TYREAL, TYREAL, 0 },
349 { TYDREAL, TYDREAL, 1 },
350
351 { TYSHORT, TYLONG, 12 },
352 { TYLONG, TYLONG, 13 },
353 { TYREAL, TYREAL, 2 },
354 { TYDREAL, TYDREAL, 3 },
355
356 { TYREAL, TYREAL, 4 },
357 { TYDREAL, TYDREAL, 5 }
358};
359
360/* For each machine, two arrays must be initialized.
361intcon contains
362 radix for short int
363 radix for long int
364 radix for single precision
365 radix for double precision
366 precision for short int
367 precision for long int
368 precision for single precision
369 precision for double precision
370 emin for single precision
371 emin for double precision
372 emax for single precision
373 emax for double prcision
374 largest short int
375 largest long int
376
377realcon contains
378 tiny for single precision
379 tiny for double precision
380 huge for single precision
381 huge for double precision
382 mrsp (epsilon) for single precision
383 mrsp (epsilon) for double precision
384
385the realcons should probably be filled in in binary if TARGET==HERE
386*/
387\f
388char callbyvalue[ ][XL] =
389 {
390 "sqrt",
391 "exp",
392 "log",
393 "sin",
394 "cos",
395 "tan",
396 "asin",
397 "acos",
398 "atan",
399 "atan2",
400 "sinh",
401 "cosh",
402 "tanh"
403 };
404\f
405expptr intrcall(np, argsp, nargs)
406Namep np;
407struct Listblock *argsp;
408int nargs;
409{
410int i, rettype;
411Addrp ap;
412register struct Specblock *sp;
413register struct Chain *cp;
414expptr inline(), mkcxcon(), mkrealcon();
415register struct Incstblock *cstp;
416expptr q, ep;
417int mtype;
418int op;
419int f1field, f2field, f3field;
420
421packed.ijunk = np->vardesc.varno;
422f1field = packed.bits.f1;
423f2field = packed.bits.f2;
424f3field = packed.bits.f3;
425if(nargs == 0)
426 goto badnargs;
427
428mtype = 0;
429for(cp = argsp->listp ; cp ; cp = cp->nextp)
430 {
431/* TEMPORARY */ ep = (expptr) (cp->datap);
432/* TEMPORARY */ if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
433/* TEMPORARY */ cp->datap = (tagptr) mkconv(tyint, ep);
434 mtype = maxtype(mtype, ep->headblock.vtype);
435 }
436
437switch(f1field)
438 {
439 case INTRBOOL:
440 op = f3field;
441 if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
442 goto badtype;
443 if(op == OPBITNOT)
444 {
445 if(nargs != 1)
446 goto badnargs;
447 q = mkexpr(OPBITNOT, argsp->listp->datap, ENULL);
448 }
449 else
450 {
451 if(nargs != 2)
452 goto badnargs;
453 q = mkexpr(op, argsp->listp->datap,
454 argsp->listp->nextp->datap);
455 }
456 frchain( &(argsp->listp) );
457 free( (charptr) argsp);
458 return(q);
459
460 case INTRCONV:
461 if (nargs == 1)
462 {
463 if(argsp->listp->datap->headblock.vtype == TYERROR)
464 {
465 free( (charptr) argsp->listp->datap);
466 frchain( &(argsp->listp) );
467 free( (charptr) argsp);
468 return( errnode() );
469 }
470 }
471 else if (nargs == 2)
472 {
473 if(argsp->listp->nextp->datap->headblock.vtype ==
474 TYERROR ||
475 argsp->listp->datap->headblock.vtype == TYERROR)
476 {
477 free( (charptr) argsp->listp->nextp->datap);
478 free( (charptr) argsp->listp->datap);
479 frchain( &(argsp->listp) );
480 free( (charptr) argsp);
481 return( errnode() );
482 }
483 }
484 rettype = f2field;
485 if(rettype == TYLONG)
486 rettype = tyint;
487 if( ISCOMPLEX(rettype) && nargs==2)
488 {
489 expptr qr, qi;
490 qr = (expptr) (argsp->listp->datap);
491 qi = (expptr) (argsp->listp->nextp->datap);
492 if(ISCONST(qr) && ISCONST(qi))
493 q = mkcxcon(qr,qi);
494 else q = mkexpr(OPCONV,mkconv(rettype-2,qr),
495 mkconv(rettype-2,qi));
496 }
497 else if(nargs == 1)
498 q = mkconv(rettype, argsp->listp->datap);
499 else goto badnargs;
500
501 q->headblock.vtype = rettype;
502 frchain(&(argsp->listp));
503 free( (charptr) argsp);
504 return(q);
505
506
507 case INTRCNST:
508 cstp = consttab + f3field;
509 for(i=0 ; i<f2field ; ++i)
510 if(cstp->atype == mtype)
511 goto foundconst;
512 else
513 ++cstp;
514 goto badtype;
515
516 foundconst:
517 switch(cstp->rtype)
518 {
519 case TYLONG:
520 return(mkintcon(intcon[cstp->constno]));
521
522 case TYREAL:
523 case TYDREAL:
524 return(mkrealcon(cstp->rtype,
525 realcon[cstp->constno]) );
526
527 default:
528 fatal("impossible intrinsic constant");
529 }
530
531 case INTRGEN:
532 sp = spectab + f3field;
533 if(no66flag)
534 if(sp->atype == mtype)
535 goto specfunct;
536 else err66("generic function");
537
538 for(i=0; i<f2field ; ++i)
539 if(sp->atype == mtype)
540 goto specfunct;
541 else
542 ++sp;
543 goto badtype;
544
545 case INTRSPEC:
546 sp = spectab + f3field;
547 specfunct:
548 if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL))
549 && (sp+1)->atype==sp->atype)
550 ++sp;
551
552 if(nargs != sp->nargs)
553 goto badnargs;
554 if(mtype != sp->atype)
555 goto badtype;
556 fixargs(YES, argsp);
557 if(q = inline(sp-spectab, mtype, argsp->listp))
558 {
559 frchain( &(argsp->listp) );
560 free( (charptr) argsp);
561 }
562 else if(sp->othername)
563 {
564 ap = builtin(sp->rtype,
565 varstr(XL, callbyvalue[sp->othername-1]) );
566 q = fixexpr( mkexpr(OPCCALL, ap, argsp) );
567 }
568 else
569 {
570 ap = builtin(sp->rtype, varstr(XL, sp->spxname) );
571 q = fixexpr( mkexpr(OPCALL, ap, argsp) );
572 }
573 return(q);
574
575 case INTRMIN:
576 case INTRMAX:
577 if(nargs < 2)
578 goto badnargs;
579 if( ! ONEOF(mtype, MSKINT|MSKREAL) )
580 goto badtype;
581 argsp->vtype = mtype;
582 q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), argsp, ENULL);
583
584 q->headblock.vtype = mtype;
585 rettype = f2field;
586 if(rettype == TYLONG)
587 rettype = tyint;
588 else if(rettype == TYUNKNOWN)
589 rettype = mtype;
590 return( mkconv(rettype, q) );
591
592 default:
593 fatali("intrcall: bad intrgroup %d", f1field);
594 }
595badnargs:
596 errstr("bad number of arguments to intrinsic %s",
597 varstr(VL,np->varname) );
598 goto bad;
599
600badtype:
601 errstr("bad argument type to intrinsic %s", varstr(VL, np->varname) );
602
603bad:
604 return( errnode() );
605}
606
607
608
609
610intrfunct(s)
611char s[VL];
612{
613register struct Intrblock *p;
614char nm[VL];
615register int i;
616
617for(i = 0 ; i<VL ; ++s)
618 nm[i++] = (*s==' ' ? '\0' : *s);
619
620for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
621 {
622 if( eqn(VL, nm, p->intrfname) )
623 {
624 packed.bits.f1 = p->intrval.intrgroup;
625 packed.bits.f2 = p->intrval.intrstuff;
626 packed.bits.f3 = p->intrval.intrno;
627 return(packed.ijunk);
628 }
629 }
630
631return(0);
632}
633
634
635
636
637
638Addrp intraddr(np)
639Namep np;
640{
641Addrp q;
642register struct Specblock *sp;
643int f3field;
644
645if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
646 fatalstr("intraddr: %s is not intrinsic", varstr(VL,np->varname));
647packed.ijunk = np->vardesc.varno;
648f3field = packed.bits.f3;
649
650switch(packed.bits.f1)
651 {
652 case INTRGEN:
653 /* imag, log, and log10 arent specific functions */
654 if(f3field==31 || f3field==43 || f3field==47)
655 goto bad;
656
657 case INTRSPEC:
658 sp = spectab + f3field;
659 if(tyint==TYLONG && sp->rtype==TYSHORT)
660 ++sp;
661 q = builtin(sp->rtype, varstr(XL,sp->spxname) );
662 return(q);
663
664 case INTRCONV:
665 case INTRMIN:
666 case INTRMAX:
667 case INTRBOOL:
668 case INTRCNST:
669 bad:
670 errstr("cannot pass %s as actual",
671 varstr(VL,np->varname));
672 return( (Addrp) errnode() );
673 }
674fatali("intraddr: impossible f1=%d\n", (int) packed.bits.f1);
675/* NOTREACHED */
676}
677
678
679
680
681
682expptr inline(fno, type, args)
683int fno;
684int type;
685struct Chain *args;
686{
687register expptr q, t, t1;
688
689switch(fno)
690 {
691 case 8: /* real abs */
692 case 9: /* short int abs */
693 case 10: /* long int abs */
694 case 11: /* double precision abs */
695 if( addressable(q = (expptr) (args->datap)) )
696 {
697 t = q;
698 q = NULL;
699 }
700 else
701 t = (expptr) mktemp(type,PNULL);
702 t1 = mkexpr(OPQUEST,
703 mkexpr(OPLE, mkconv(type,ICON(0)), cpexpr(t)),
704 mkexpr(OPCOLON, cpexpr(t),
705 mkexpr(OPNEG, cpexpr(t), ENULL) ));
706 if(q)
707 t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
708 frexpr(t);
709 return(t1);
710
711 case 26: /* dprod */
712 q = mkexpr(OPSTAR, mkconv(TYDREAL,args->datap), args->nextp->datap);
713 return(q);
714
715 case 27: /* len of character string */
716 q = (expptr) cpexpr(args->datap->headblock.vleng);
717 frexpr(args->datap);
718 return(q);
719
720 case 14: /* half-integer mod */
721 case 15: /* mod */
722 return( mkexpr(OPMOD, (expptr) (args->datap),
723 (expptr) (args->nextp->datap) ));
724 }
725return(NULL);
726}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.