# 2.11BSD#431 - /usr/src/usr.bin/f77/intr.c

##### Functions

    inline            X
    intraddr          X
    intrcall          X
    intrfunct         X

##### Variables

    callbyvalue       X
    intrtab           X
    spectab           X

##### Macros

    BITFUNC           X

##### struct's

    intrbits          X
    intrblock         X
    specblock         X

       1: #include "defs"
       2: #include "string_defs"
       3:
       4: /*
       5:  * Note: an addition has been made to the intrinsic
       6:  * function tables to support the fortran bit
       7:  * functions:
       8:  *  	igetbt, iand, ieor, inot, ior, ishft, iputbt
       9:  *
      10:  *  mod is selected by '#define BITFUNC'
      11:  * wfj and jlh 8 august 1979 USGS Menlo Park.
      12:  */
      13: /* INTRINSIC FUNCTIONS: The compiler needs to recognize the name of an
      14: intrinsic function, decide on which C routine to call depending on the
      15: type of the arguement, then call that routine and tell the compiler
      16: the type of the result.
      17:      The structure intrblock is the intrinsic function table. Each line
      18: of the table contains the intrinsic function name (intrtab[i].intrfname)
      19: and three numbers that are actually packed into one long word with the
      20: structure intrbits. The first number (intrtab.intrval.f1) tells how the
      21: type is to be checked and converted if necessary. The second number
      22: (intrtab.intrval.f2) tells either the type of the argument required
      23: or in the case of INTRGEN tells how many lines of the spectable to
      24: search. The third number (intrtab.intrval.f3) tells which line of the
      25: spectable to go to or to begin at.
      26:      The spectable is the structure specblock and contains four columns:
      27: the type of argument(s) required, the type of result returned, the number
      28: of arguments required, and the name of the C routine to be called.
      29:      INTRCONV, INTRBOOL, INTRMAX, and INTRMIN are all done internally
      30: with no subroutine call necessary. INTRSPEC requires that the argument
      31: be of the type specified. INTRGEN requires that the argument be of one
      32: of the types specified in the spectable beginning at line intrtab.intrval.
      33: f3 and going for intrtab.intrval.f2 lines.
      34: PLWard, Menlo  4/8/80                    */
      35:
      36: #define BITFUNC
      37:
      38:
      39: union
      40:     {
      41:     int ijunk;
      42:     struct intrpacked bits;
      43:     } packed;
      44:
      45: struct intrbits
      46:     {
      47:     int intrgroup /* :3 */;
      48:     int intrstuff /* result type or number of generics */;
      49:     int intrno /* :7 */;
      50:     };
      51:
      52: LOCAL struct intrblock
      53:     {
      54:     char intrfname[VL];
      55:     struct intrbits intrval;
      56:     } intrtab[ ] =
      57: {
      58: "int",      { INTRCONV, TYLONG },
      59: "real",     { INTRCONV, TYREAL },
      60: "dble",     { INTRCONV, TYDREAL },
      61: "dreal",    { INTRCONV, TYDREAL },
      62: "cmplx",    { INTRCONV, TYCOMPLEX },
      63: "dcmplx",   { INTRCONV, TYDCOMPLEX },
      64: "ifix",     { INTRCONV, TYLONG },
      65: "idint",    { INTRCONV, TYLONG },
      66: "float",    { INTRCONV, TYREAL },
      67: "dfloat",   { INTRCONV, TYDREAL },
      68: "sngl",     { INTRCONV, TYREAL },
      69: "ichar",    { INTRCONV, TYLONG },
      70: "char",     { INTRCONV, TYCHAR },
      71:
      72: "max",      { INTRMAX, TYUNKNOWN },
      73: "max0",     { INTRMAX, TYLONG },
      74: "amax0",    { INTRMAX, TYREAL },
      75: "max1",     { INTRMAX, TYLONG },
      76: "amax1",    { INTRMAX, TYREAL },
      77: "dmax1",    { INTRMAX, TYDREAL },
      78:
      79: "and",      { INTRBOOL, TYUNKNOWN, OPBITAND },
      80: "or",       { INTRBOOL, TYUNKNOWN, OPBITOR },
      81: "xor",      { INTRBOOL, TYUNKNOWN, OPBITXOR },
      82: "not",      { INTRBOOL, TYUNKNOWN, OPBITNOT },
      83: "lshift",   { INTRBOOL, TYUNKNOWN, OPLSHIFT },
      84: "rshift",   { INTRBOOL, TYUNKNOWN, OPRSHIFT },
      85:
      86: "min",      { INTRMIN, TYUNKNOWN },
      87: "min0",     { INTRMIN, TYLONG },
      88: "amin0",    { INTRMIN, TYREAL },
      89: "min1",     { INTRMIN, TYLONG },
      90: "amin1",    { INTRMIN, TYREAL },
      91: "dmin1",    { INTRMIN, TYDREAL },
      92:
      93: "aint",     { INTRGEN, 2, 0 },
      94: "dint",     { INTRSPEC, TYDREAL, 1 },
      95:
      96: "anint",    { INTRGEN, 2, 2 },
      97: "dnint",    { INTRSPEC, TYDREAL, 3 },
      98:
      99: "nint",     { INTRGEN, 4, 4 },
     100: "idnint",   { INTRGEN, 2, 6 },
     101:
     102: "abs",      { INTRGEN, 6, 8 },
     103: "iabs",     { INTRGEN, 2, 9 },
     104: "dabs",     { INTRSPEC, TYDREAL, 11 },
     105: "cabs",     { INTRSPEC, TYREAL, 12 },
     106: "zabs",     { INTRSPEC, TYDREAL, 13 },
     107:
     108: "mod",      { INTRGEN, 4, 14 },
     109: "amod",     { INTRSPEC, TYREAL, 16 },
     110: "dmod",     { INTRSPEC, TYDREAL, 17 },
     111:
     112: "sign",     { INTRGEN, 4, 18 },
     113: "isign",    { INTRGEN, 2, 19 },
     114: "dsign",    { INTRSPEC, TYDREAL, 21 },
     115:
     116: "dim",      { INTRGEN, 4, 22 },
     117: "idim",     { INTRGEN, 2, 23 },
     118: "ddim",     { INTRSPEC, TYDREAL, 25 },
     119:
     120: "dprod",    { INTRSPEC, TYDREAL, 26 },
     121:
     122: "len",      { INTRSPEC, TYLONG, 27 },
     123: "index",    { INTRSPEC, TYLONG, 29 },
     124:
     125: "imag",     { INTRGEN, 2, 31 },
     126: "aimag",    { INTRSPEC, TYREAL, 31 },
     127: "dimag",    { INTRSPEC, TYDREAL, 32 },
     128:
     129: "conjg",    { INTRGEN, 2, 33 },
     130: "dconjg",   { INTRSPEC, TYDCOMPLEX, 34 },
     131:
     132: "sqrt",     { INTRGEN, 4, 35 },
     133: "dsqrt",    { INTRSPEC, TYDREAL, 36 },
     134: "csqrt",    { INTRSPEC, TYCOMPLEX, 37 },
     135: "zsqrt",    { INTRSPEC, TYDCOMPLEX, 38 },
     136:
     137: "exp",      { INTRGEN, 4, 39 },
     138: "dexp",     { INTRSPEC, TYDREAL, 40 },
     139: "cexp",     { INTRSPEC, TYCOMPLEX, 41 },
     140: "zexp",     { INTRSPEC, TYDCOMPLEX, 42 },
     141: "cdexp",    { INTRSPEC, TYDCOMPLEX, 42 },
     142:
     143: "log",      { INTRGEN, 4, 43 },
     144: "alog",     { INTRSPEC, TYREAL, 43 },
     145: "dlog",     { INTRSPEC, TYDREAL, 44 },
     146: "clog",     { INTRSPEC, TYCOMPLEX, 45 },
     147: "zlog",     { INTRSPEC, TYDCOMPLEX, 46 },
     148:
     149: "log10",    { INTRGEN, 2, 47 },
     150: "alog10",   { INTRSPEC, TYREAL, 47 },
     151: "dlog10",   { INTRSPEC, TYDREAL, 48 },
     152:
     153: "sin",      { INTRGEN, 4, 49 },
     154: "dsin",     { INTRSPEC, TYDREAL, 50 },
     155: "csin",     { INTRSPEC, TYCOMPLEX, 51 },
     156: "zsin",     { INTRSPEC, TYDCOMPLEX, 52 },
     157:
     158: "cos",      { INTRGEN, 4, 53 },
     159: "dcos",     { INTRSPEC, TYDREAL, 54 },
     160: "ccos",     { INTRSPEC, TYCOMPLEX, 55 },
     161: "zcos",     { INTRSPEC, TYDCOMPLEX, 56 },
     162:
     163: "tan",      { INTRGEN, 2, 57 },
     164: "dtan",     { INTRSPEC, TYDREAL, 58 },
     165:
     166: "asin",     { INTRGEN, 2, 59 },
     167: "dasin",    { INTRSPEC, TYDREAL, 60 },
     168:
     169: "acos",     { INTRGEN, 2, 61 },
     170: "dacos",    { INTRSPEC, TYDREAL, 62 },
     171:
     172: "atan",     { INTRGEN, 2, 63 },
     173: "datan",    { INTRSPEC, TYDREAL, 64 },
     174:
     175: "atan2",    { INTRGEN, 2, 65 },
     176: "datan2",   { INTRSPEC, TYDREAL, 66 },
     177:
     178: "sinh",     { INTRGEN, 2, 67 },
     179: "dsinh",    { INTRSPEC, TYDREAL, 68 },
     180:
     181: "cosh",     { INTRGEN, 2, 69 },
     182: "dcosh",    { INTRSPEC, TYDREAL, 70 },
     183:
     184: "tanh",     { INTRGEN, 2, 71 },
     185: "dtanh",    { INTRSPEC, TYDREAL, 72 },
     186:
     187: "lge",      { INTRSPEC, TYLOGICAL, 73},
     188: "lgt",      { INTRSPEC, TYLOGICAL, 75},
     189: "lle",      { INTRSPEC, TYLOGICAL, 77},
     190: "llt",      { INTRSPEC, TYLOGICAL, 79},
     191:
     192: #ifdef BITFUNC
     193:
     194: "igetbt",   { INTRGEN,2, 81},
     195: "iand",     { INTRGEN, 2, 83},
     196: "ieor",     { INTRGEN, 2, 85},
     197: "inot",     { INTRGEN, 2, 87},
     198: "ior",      { INTRGEN, 2, 89},
     199: "ishft",    { INTRGEN, 2, 91},
     200: "iputbt",   { INTRGEN, 2, 93},
     201:
     202: #endif
     203:
     204: "" };
     205:
     206:
     207: LOCAL struct specblock
     208:     {
     209:     char atype;
     210:     char rtype;
     211:     char nargs;
     212:     char spxname[XL];
     213:     char othername; /* index into callbyvalue table */
     214:     } spectab[ ] =
     215: {
     216:     { TYREAL,TYREAL,1,"r_int" },
     217:     { TYDREAL,TYDREAL,1,"d_int" },
     218:
     219:     { TYREAL,TYREAL,1,"r_nint" },
     220:     { TYDREAL,TYDREAL,1,"d_nint" },
     221:
     222:     { TYREAL,TYSHORT,1,"h_nint" },
     223:     { TYREAL,TYLONG,1,"i_nint" },
     224:
     225:     { TYDREAL,TYSHORT,1,"h_dnnt" },
     226:     { TYDREAL,TYLONG,1,"i_dnnt" },
     227:
     228:     { TYREAL,TYREAL,1,"r_abs" },
     229:     { TYSHORT,TYSHORT,1,"h_abs" },
     230:     { TYLONG,TYLONG,1,"i_abs" },
     231:     { TYDREAL,TYDREAL,1,"d_abs" },
     232:     { TYCOMPLEX,TYREAL,1,"c_abs" },
     233:     { TYDCOMPLEX,TYDREAL,1,"z_abs" },
     234:
     235:     { TYSHORT,TYSHORT,2,"h_mod" },
     236:     { TYLONG,TYLONG,2,"i_mod" },
     237:     { TYREAL,TYREAL,2,"r_mod" },
     238:     { TYDREAL,TYDREAL,2,"d_mod" },
     239:
     240:     { TYREAL,TYREAL,2,"r_sign" },
     241:     { TYSHORT,TYSHORT,2,"h_sign" },
     242:     { TYLONG,TYLONG,2,"i_sign" },
     243:     { TYDREAL,TYDREAL,2,"d_sign" },
     244:
     245:     { TYREAL,TYREAL,2,"r_dim" },
     246:     { TYSHORT,TYSHORT,2,"h_dim" },
     247:     { TYLONG,TYLONG,2,"i_dim" },
     248:     { TYDREAL,TYDREAL,2,"d_dim" },
     249:
     250:     { TYREAL,TYDREAL,2,"d_prod" },
     251:
     252:     { TYCHAR,TYSHORT,1,"h_len" },
     253:     { TYCHAR,TYLONG,1,"i_len" },
     254:
     255:     { TYCHAR,TYSHORT,2,"h_indx" },
     256:     { TYCHAR,TYLONG,2,"i_indx" },
     257:
     258:     { TYCOMPLEX,TYREAL,1,"r_imag" },
     259:     { TYDCOMPLEX,TYDREAL,1,"d_imag" },
     260:     { TYCOMPLEX,TYCOMPLEX,1,"r_cnjg" },
     261:     { TYDCOMPLEX,TYDCOMPLEX,1,"d_cnjg" },
     262:
     263:     { TYREAL,TYREAL,1,"r_sqrt", 1 },
     264:     { TYDREAL,TYDREAL,1,"d_sqrt", 1 },
     265:     { TYCOMPLEX,TYCOMPLEX,1,"c_sqrt" },
     266:     { TYDCOMPLEX,TYDCOMPLEX,1,"z_sqrt" },
     267:
     268:     { TYREAL,TYREAL,1,"r_exp", 2 },
     269:     { TYDREAL,TYDREAL,1,"d_exp", 2 },
     270:     { TYCOMPLEX,TYCOMPLEX,1,"c_exp" },
     271:     { TYDCOMPLEX,TYDCOMPLEX,1,"z_exp" },
     272:
     273:     { TYREAL,TYREAL,1,"r_log", 3 },
     274:     { TYDREAL,TYDREAL,1,"d_log", 3 },
     275:     { TYCOMPLEX,TYCOMPLEX,1,"c_log" },
     276:     { TYDCOMPLEX,TYDCOMPLEX,1,"z_log" },
     277:
     278:     { TYREAL,TYREAL,1,"r_lg10" },
     279:     { TYDREAL,TYDREAL,1,"d_lg10" },
     280:
     281:     { TYREAL,TYREAL,1,"r_sin", 4 },
     282:     { TYDREAL,TYDREAL,1,"d_sin", 4 },
     283:     { TYCOMPLEX,TYCOMPLEX,1,"c_sin" },
     284:     { TYDCOMPLEX,TYDCOMPLEX,1,"z_sin" },
     285:
     286:     { TYREAL,TYREAL,1,"r_cos", 5 },
     287:     { TYDREAL,TYDREAL,1,"d_cos", 5 },
     288:     { TYCOMPLEX,TYCOMPLEX,1,"c_cos" },
     289:     { TYDCOMPLEX,TYDCOMPLEX,1,"z_cos" },
     290:
     291:     { TYREAL,TYREAL,1,"r_tan", 6 },
     292:     { TYDREAL,TYDREAL,1,"d_tan", 6 },
     293:
     294:     { TYREAL,TYREAL,1,"r_asin", 7 },
     295:     { TYDREAL,TYDREAL,1,"d_asin", 7 },
     296:
     297:     { TYREAL,TYREAL,1,"r_acos", 8 },
     298:     { TYDREAL,TYDREAL,1,"d_acos", 8 },
     299:
     300:     { TYREAL,TYREAL,1,"r_atan", 9 },
     301:     { TYDREAL,TYDREAL,1,"d_atan", 9 },
     302:
     303:     { TYREAL,TYREAL,2,"r_atn2", 10 },
     304:     { TYDREAL,TYDREAL,2,"d_atn2", 10 },
     305:
     306:     { TYREAL,TYREAL,1,"r_sinh", 11 },
     307:     { TYDREAL,TYDREAL,1,"d_sinh", 11 },
     308:
     309:     { TYREAL,TYREAL,1,"r_cosh", 12 },
     310:     { TYDREAL,TYDREAL,1,"d_cosh", 12 },
     311:
     312:     { TYREAL,TYREAL,1,"r_tanh", 13 },
     313:     { TYDREAL,TYDREAL,1,"d_tanh", 13 },
     314:
     315:     { TYCHAR,TYLOGICAL,2,"hl_ge" },
     316:     { TYCHAR,TYLOGICAL,2,"l_ge" },
     317:
     318:     { TYCHAR,TYLOGICAL,2,"hl_gt" },
     319:     { TYCHAR,TYLOGICAL,2,"l_gt" },
     320:
     321:     { TYCHAR,TYLOGICAL,2,"hl_le" },
     322:     { TYCHAR,TYLOGICAL,2,"l_le" },
     323:
     324:     { TYCHAR,TYLOGICAL,2,"hl_lt" },
     325:     { TYCHAR,TYLOGICAL,2,"l_lt" }
     326:
     327: #ifdef BITFUNC
     328:         ,
     329:
     330:     { TYSHORT,TYSHORT,3,"h_getbit" },
     331:     { TYLONG,TYLONG,3,"i_getbit" },
     332:     { TYSHORT,TYSHORT,2,"h_iand" },
     333:     { TYLONG,TYLONG,2,"i_iand" },
     334:     { TYSHORT,TYSHORT,2,"h_ieor" },
     335:     { TYLONG,TYLONG,2,"i_ieor" },
     336:     { TYSHORT,TYSHORT,1,"h_not" },
     337:     { TYLONG,TYLONG,1,"i_not" },
     338:     { TYSHORT,TYSHORT,2,"h_ior" },
     339:     { TYLONG,TYLONG,2,"i_ior" },
     340:     { TYSHORT,TYSHORT,2,"h_ishft" },
     341:     { TYLONG,TYLONG,2,"i_ishft" },
     342:     { TYSHORT,TYSHORT,4,"h_putbit" },
     343:     { TYLONG,TYLONG,4,"i_putbit" }
     344:
     345: #endif
     346:
     347: } ;
     348:
     349:
     350:
     351:
     352:
     353:
     354: char callbyvalue[ ][XL] =
     355:     {
     356:     "sqrt",
     357:     "exp",
     358:     "log",
     359:     "sin",
     360:     "cos",
     361:     "tan",
     362:     "asin",
     363:     "acos",
     364:     "atan",
     365:     "atan2",
     366:     "sinh",
     367:     "cosh",
     368:     "tanh"
     369:     };
     370:
     371: struct exprblock *intrcall(np, argsp, nargs)
     372: struct nameblock *np;
     373: struct listblock *argsp;
     374: int nargs;
     375: {
     376: int i, rettype;
     377: struct addrblock *ap;
     378: register struct specblock *sp;
     379: struct exprblock *q, *inline();
     380: register chainp cp;
     381: struct constblock *mkcxcon();
     382: expptr ep;
     383: int mtype;
     384: int op;
     385:
     386: packed.ijunk = np->vardesc.varno;
     387: if(nargs == 0)
     388:     goto badnargs;
     389:
     390: mtype = 0;
     391: for(cp = argsp->listp ; cp ; cp = cp->nextp)
     392:     {
     393: /* TEMPORARY */ ep = cp->datap;
     394: /* TEMPORARY */ if( ISCONST(ep) && ep->vtype==TYSHORT )
     395: /* TEMPORARY */     cp->datap = mkconv(tyint, ep);
     396:     mtype = maxtype(mtype, ep->vtype);
     397:     }
     398:
     399: switch(packed.bits.f1)
     400:     {
     401:     case INTRBOOL:
     402:         op = packed.bits.f3;
     403:         if( ! ONEOF(mtype, MSKINT|MSKLOGICAL) )
     404:             goto badtype;
     405:         if(op == OPBITNOT)
     406:             {
     407:             if(nargs != 1)
     408:                 goto badnargs;
     409:             q = mkexpr(OPBITNOT, argsp->listp->datap, NULL);
     410:             }
     411:         else
     412:             {
     413:             if(nargs != 2)
     414:                 goto badnargs;
     415:             q = mkexpr(op, argsp->listp->datap,
     416:                 argsp->listp->nextp->datap);
     417:             }
     418:         frchain( &(argsp->listp) );
     419:         free(argsp);
     420:         return(q);
     421:
     422:     case INTRCONV:
     423:         rettype = packed.bits.f2;
     424:         if(rettype == TYLONG)
     425:             rettype = tyint;
     426:         if( ISCOMPLEX(rettype) && nargs==2)
     427:             {
     428:             expptr qr, qi;
     429:             qr = argsp->listp->datap;
     430:             qi = argsp->listp->nextp->datap;
     431:             if(ISCONST(qr) && ISCONST(qi))
     432:                 q = mkcxcon(qr,qi);
     433:             else    q = mkexpr(OPCONV,mkconv(rettype-2,qr),
     434:                     mkconv(rettype-2,qi));
     435:             }
     436:         else if(nargs == 1)
     437:             q = mkconv(rettype, argsp->listp->datap);
     438:         else goto badnargs;
     439:
     440:         q->vtype = rettype;
     441:         frchain(&(argsp->listp));
     442:         free(argsp);
     443:         return(q);
     444:
     445:
     446:     case INTRGEN:
     447:         sp = spectab + packed.bits.f3;
     448:         for(i=0; i<packed.bits.f2 ; ++i)
     449:             if(sp->atype == mtype)
     450:                 goto specfunct;
     451:             else
     452:                 ++sp;
     453:         goto badtype;
     454:
     455:     case INTRSPEC:
     456:         sp = spectab + packed.bits.f3;
     457:         if(tyint==TYLONG && sp->rtype==TYSHORT)
     458:             ++sp;
     459:
     460:     specfunct:
     461:         if(nargs != sp->nargs)
     462:             goto badnargs;
     463:         if(mtype != sp->atype)
     464:             goto badtype;
     465:         fixargs(YES, argsp);
     466:         if(q = inline(sp-spectab, mtype, argsp->listp))
     467:             {
     468:             frchain( &(argsp->listp) );
     469:             free(argsp);
     470:             }
     471:         else if(sp->othername)
     472:             {
     473:             ap = builtin(sp->rtype,
     474:                 varstr(XL, callbyvalue[sp->othername-1]) );
     475:             q = fixexpr( mkexpr(OPCCALL, ap, argsp) );
     476:             }
     477:         else
     478:             {
     479:             ap = builtin(sp->rtype, varstr(XL, sp->spxname) );
     480:             q = fixexpr( mkexpr(OPCALL, ap, argsp) );
     481:             }
     482:         return(q);
     483:
     484:     case INTRMIN:
     485:     case INTRMAX:
     486:         if(nargs < 2)
     487:             goto badnargs;
     488:         if( ! ONEOF(mtype, MSKINT|MSKREAL) )
     489:             goto badtype;
     490:         argsp->vtype = mtype;
     491:         q = mkexpr( (packed.bits.f1==INTRMIN ? OPMIN : OPMAX), argsp, NULL);
     492:
     493:         q->vtype = mtype;
     494:         rettype = packed.bits.f2;
     495:         if(rettype == TYLONG)
     496:             rettype = tyint;
     497:         else if(rettype == TYUNKNOWN)
     498:             rettype = mtype;
     499:         return( mkconv(rettype, q) );
     500:
     501:     default:
     502:         error("intrcall: bad intrgroup %d", packed.bits.f1,0,FATAL1);
     503:     }
     504: badnargs:
     505:     error("bad number of arguments to intrinsic %s",
     506:         varstr(VL,np->varname),0,ERR1);
     507:     goto bad;
     508:
     509: badtype:
     510:     error("bad argument type to intrinsic %s", varstr(VL, np->varname),
     511:         0,ERR1);
     512:
     513: bad:
     514:     return( errnode() );
     515: }
     516:
     517:
     518:
     519:
     520: intrfunct(s)
     521: char s[VL];
     522: {
     523: register struct intrblock *p;
     524: char nm[VL];
     525: register int i;
     526:
     527: for(i = 0 ; i<VL ; ++s)
     528:     nm[i++] = (*s==' ' ? '\0' : *s);
     529:
     530: for(p = intrtab; p->intrval.intrgroup!=INTREND ; ++p)
     531:     {
     532:     if( eqn(VL, nm, p->intrfname) )
     533:         {
     534:         packed.bits.f1 = p->intrval.intrgroup;
     535:         packed.bits.f2 = p->intrval.intrstuff;
     536:         packed.bits.f3 = p->intrval.intrno;
     537:         return(packed.ijunk);
     538:         }
     539:     }
     540:
     541: return(0);
     542: }
     543:
     544:
     545:
     546:
     547:
     548: struct addrblock *intraddr(np)
     549: struct nameblock *np;
     550: {
     551: struct addrblock *q;
     552: struct specblock *sp;
     553:
     554: if(np->vclass!=CLPROC || np->vprocclass!=PINTRINSIC)
     555:     error("intraddr: %s is not intrinsic", varstr(VL,np->varname),0,FATAL1);
     556: packed.ijunk = np->vardesc.varno;
     557:
     558: switch(packed.bits.f1)
     559:     {
     560:     case INTRGEN:
     561:         /* imag, log, and log10 arent specific functions */
     562:         if(packed.bits.f3==31 || packed.bits.f3==43 || packed.bits.f3==47)
     563:             goto bad;
     564:
     565:     case INTRSPEC:
     566:         sp = spectab + packed.bits.f3;
     567:         if(tyint==TYLONG && sp->rtype==TYSHORT)
     568:             ++sp;
     569:         q = builtin(sp->rtype, varstr(XL,sp->spxname) );
     570:         return(q);
     571:
     572:     case INTRCONV:
     573:     case INTRMIN:
     574:     case INTRMAX:
     575:     case INTRBOOL:
     576:     bad:
     577:         error("cannot pass %s as actual",
     578:             varstr(VL,np->varname),0,ERR1);
     579:         return( errnode() );
     580:     }
     581: error("intraddr: impossible f1=%d\n", packed.bits.f1,0,FATAL1);
     582: /* NOTREACHED */
     583: }
     584:
     585:
     586:
     587:
     588:
     589: struct exprblock *inline(fno, type, args)
     590: int fno;
     591: int type;
     592: chainp args;
     593: {
     594: register struct exprblock *q, *t, *t1;
     595:
     596: switch(fno)
     597:     {
     598:     case 8: /* real abs */
     599:     case 9: /* short int abs */
     600:     case 10:    /* long int abs */
     601:     case 11:    /* double precision abs */
     602:         if( addressable(q = args->datap) )
     603:             {
     604:             t = q;
     605:             q = NULL;
     606:             }
     607:         else
     608:             t = mktemp(type);
     609:         t1 = mkexpr(OPQUEST,  mkexpr(OPLE, mkconv(type,ICON(0)), cpexpr(t)),
     610:             mkexpr(OPCOLON, cpexpr(t),
     611:                 mkexpr(OPNEG, cpexpr(t), NULL) ));
     612:         if(q)
     613:             t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
     614:         frexpr(t);
     615:         return(t1);
     616:
     617:     case 26:    /* dprod */
     618:         q = mkexpr(OPSTAR, args->datap, args->nextp->datap);
     619:         q->vtype = TYDREAL;
     620:         return(q);
     621:
     622:     case 27:    /* len of character string */
     623:         q = cpexpr(args->datap->vleng);
     624:         frexpr(args->datap);
     625:         return(q);
     626:
     627:     case 14:    /* half-integer mod */
     628:     case 15:    /* mod */
     629:         return( mkexpr(OPMOD, args->datap, args->nextp->datap) );
     630:     }
     631: return(NULL);
     632: }

#### Defined functions

inline defined in line 589; used 2 times

- in line 379, 466

intraddr defined in line 548; used 2 times

- in /usr/src/usr.bin/f77/expr.c line 1123, 1159

intrcall defined in line 371; used 2 times

- in /usr/src/usr.bin/f77/expr.c line 684, 741

intrfunct defined in line 520; used 2 times

- in /usr/src/usr.bin/f77/expr.c line 696
- in /usr/src/usr.bin/f77/proc.c line 779

#### Defined variables

callbyvalue defined in line 354; used 1 times

- in line 474

intrtab defined in line 56; used 1 times

- in line 530

spectab defined in line 214; used 4 times

- in line 447, 456, 466, 566

#### Defined struct's

intrbits defined in line 45; used 2 times

- in line 55(2)

intrblock defined in line 52; used 2 times

- in line 523(2)

specblock defined in line 207; used 4 times

- in line 378(2), 552(2)

#### Defined macros

BITFUNC defined in line 36; used 2 times

- in line 192, 327

Last modified: 1992-03-05 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 944 |