home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / f77 / putdmr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-05-05  |  19.8 KB  |  1,282 lines
  1. /*  INTERMEDIATE CODE GENERATION FOR D. M. RITCHIE C COMPILERS */
  2. #if FAMILY != DMR
  3.     WRONG put FILE !!!!
  4. #endif
  5.  
  6. #include "defs"
  7. #include "dmrdefs"
  8.  
  9.  
  10. extern int ops2[];
  11. extern int types2[];
  12.  
  13.  
  14. puthead(s, class)
  15. char *s;
  16. int class;
  17. {
  18. if( ! headerdone )
  19.     {
  20.     p2op2(P2SETREG, ARGREG-maxregvar);
  21.     p2op(P2PROG);
  22.     headerdone = YES;
  23. #if TARGET == PDP11
  24.     /* fake jump to start the optimizer */
  25.     if(class != CLBLOCK)
  26.         putgoto( fudgelabel = newlabel() );
  27. #endif
  28.     }
  29. }
  30.  
  31.  
  32.  
  33.  
  34. putnreg()
  35. {
  36. p2op2(P2SETREG, ARGREG-nregvar);
  37. }
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. puteof()
  45. {
  46. p2op(P2EOF);
  47. }
  48.  
  49.  
  50.  
  51. putstmt()
  52. {
  53. p2op2(P2EXPR, lineno);
  54. }
  55.  
  56.  
  57.  
  58.  
  59. /* put out code for if( ! p) goto l  */
  60. putif(p,l)
  61. register expptr p;
  62. int l;
  63. {
  64. register int k;
  65. if( (k = (p = fixtype(p))->vtype) != TYLOGICAL)
  66.     {
  67.     if(k != TYERROR)
  68.         err("non-logical expression in IF statement");
  69.     frexpr(p);
  70.     }
  71. else
  72.     {
  73.     putex1(p);
  74.     p2op2(P2CBRANCH, l);
  75.     p2i(0);
  76.     p2i(lineno);
  77.     }
  78. }
  79.  
  80.  
  81.  
  82.  
  83.  
  84. /* put out code for  goto l   */
  85. putgoto(label)
  86. int label;
  87. {
  88. p2op2(P2GOTO, label);
  89. }
  90.  
  91.  
  92. /* branch to address constant or integer variable */
  93. putbranch(p)
  94. register struct addrblock *p;
  95. {
  96. register int type;
  97.  
  98. type = p->vtype;
  99. if(p->tag != TADDR)
  100.     fatal("invalid goto label");
  101. putaddr(p, YES);
  102. if(type != TYINT)
  103.     p2op2(P2LTOI, P2INT);
  104. p2op2(P2INDIRECT, P2INT);
  105. p2op2(P2JUMP, P2INT);
  106. putstmt();
  107. }
  108.  
  109.  
  110.  
  111. /* put out label  l:     */
  112. putlabel(label)
  113. int label;
  114. {
  115. p2op2(P2LABEL, label);
  116. }
  117.  
  118.  
  119.  
  120.  
  121. putexpr(p)
  122. expptr p;
  123. {
  124. putex1(p);
  125. putstmt();
  126. }
  127.  
  128.  
  129.  
  130.  
  131.  
  132. prarif(p, neg, zero, pos)
  133. expptr p;
  134. int neg ,zero, pos;
  135. {
  136. putx(p);
  137. p2op(P2ARIF);
  138. p2i(neg);
  139. p2i(zero);
  140. p2i(pos);
  141. p2i(lineno);
  142. }
  143.  
  144.  
  145.  
  146. putcmgo(index, nlab, labs)
  147. expptr index;
  148. int nlab;
  149. struct labelblock *labs[];
  150. {
  151. register int i;
  152. int skiplabel;
  153.  
  154. if(! ISINT(index->vtype) )
  155.     {
  156.     execerr("computed goto index must be integer", NULL);
  157.     return;
  158.     }
  159.  
  160. putforce(TYINT, mkconv(TYINT, index) );
  161. p2op(P2SWITCH);
  162. p2i(skiplabel = newlabel() );
  163. p2i(lineno);
  164. for(i = 0 ; i<nlab ; ++i)
  165.     {
  166.     p2i(labs[i]->labelno);
  167.     p2i(i+1);
  168.     }
  169. p2i(0);
  170. putlabel(skiplabel);
  171. }
  172.  
  173. putx(p)
  174. register expptr p;
  175. {
  176. struct addrblock *putcall(), *putcx1(), *realpart();
  177. char *memname();
  178. int opc;
  179. int type, ncomma;
  180.  
  181. switch(p->tag)
  182.     {
  183.     case TERROR:
  184.         free(p);
  185.         break;
  186.  
  187.     case TCONST:
  188.         switch(type = p->vtype)
  189.             {
  190.             case TYLOGICAL:
  191.                 type = tylogical;
  192.             case TYLONG:
  193.             case TYSHORT:
  194.                 if(type == TYSHORT)
  195.                     {
  196.                     p2op2(P2ICON, P2SHORT);
  197.                     p2i( (short)(p->const.ci) );
  198.                     }
  199.                 else
  200.                     {
  201.                     p2op2(P2LCON, P2LONG);
  202.                     p2li(p->const.ci);
  203.                     }
  204.                 free(p);
  205.                 break;
  206.  
  207.             case TYADDR:
  208.                 p2op(P2NAME);
  209.                 p2i(P2STATIC);
  210.                 p2i(P2INT);
  211.                 p2i( (int) p->const.ci);
  212.                 p2op2(P2ADDR, P2PTR);
  213.                 free(p);
  214.                 break;
  215.  
  216.             default:
  217.                 putx( putconst(p) );
  218.                 break;
  219.             }
  220.         break;
  221.  
  222.     case TEXPR:
  223.         switch(opc = p->opcode)
  224.             {
  225.             case OPCALL:
  226.             case OPCCALL:
  227.                 if( ISCOMPLEX(p->vtype) )
  228.                     putcxop(p);
  229.                 else    putcall(p);
  230.                 break;
  231.  
  232.             case OPMIN:
  233.             case OPMAX:
  234.                 putmnmx(p);
  235.                 break;
  236.  
  237.  
  238.             case OPASSIGN:
  239.                 if( ISCOMPLEX(p->leftp->vtype) || ISCOMPLEX(p->rightp->vtype) )
  240.                     frexpr( putcxeq(p) );
  241.                 else if( ISCHAR(p) )
  242.                     putcheq(p);
  243.                 else
  244.                     goto putopp;
  245.                 break;
  246.  
  247.             case OPEQ:
  248.             case OPNE:
  249.                 if( ISCOMPLEX(p->leftp->vtype) || ISCOMPLEX(p->rightp->vtype) )
  250.                     {
  251.                     putcxcmp(p);
  252.                     break;
  253.                     }
  254.             case OPLT:
  255.             case OPLE:
  256.             case OPGT:
  257.             case OPGE:
  258.                 if(ISCHAR(p->leftp))
  259.                     putchcmp(p);
  260.                 else
  261.                     goto putopp;
  262.                 break;
  263.  
  264.             case OPPOWER:
  265.                 putpower(p);
  266.                 break;
  267.  
  268.             case OPMOD:
  269.                 goto putopp;
  270.             case OPSTAR:
  271.  
  272.             case OPPLUS:
  273.             case OPMINUS:
  274.             case OPSLASH:
  275.             case OPNEG:
  276.                 if( ISCOMPLEX(p->vtype) )
  277.                     putcxop(p);
  278.                 else    goto putopp;
  279.                 break;
  280.  
  281.             case OPCONV:
  282.                 if( ISCOMPLEX(p->vtype) )
  283.                     putcxop(p);
  284.                 else if( ISCOMPLEX(p->leftp->vtype) )
  285.                     {
  286.                     ncomma = 0;
  287.                     putx( mkconv(p->vtype,
  288.                         realpart(putcx1(p->leftp, &ncomma))));
  289.                     putcomma(ncomma, p->vtype, NO);
  290.                     free(p);
  291.                     }
  292.                 else    goto putopp;
  293.                 break;
  294.  
  295.             case OPNOT:
  296.             case OPOR:
  297.             case OPAND:
  298.             case OPEQV:
  299.             case OPNEQV:
  300.             case OPADDR:
  301.             case OPPLUSEQ:
  302.             case OPSTAREQ:
  303.             case OPCOMMA:
  304.             case OPQUEST:
  305.             case OPCOLON:
  306.             case OPBITOR:
  307.             case OPBITAND:
  308.             case OPBITXOR:
  309.             case OPBITNOT:
  310.             case OPLSHIFT:
  311.             case OPRSHIFT:
  312.         putopp:
  313.                 putop(p);
  314.                 break;
  315.  
  316.             default:
  317.                 fatal1("putx: invalid opcode %d", opc);
  318.             }
  319.         break;
  320.  
  321.     case TADDR:
  322.         putaddr(p, YES);
  323.         break;
  324.  
  325.     default:
  326.         fatal1("putx: impossible tag %d", p->tag);
  327.     }
  328. }
  329.  
  330.  
  331.  
  332. LOCAL putop(p)
  333. register expptr p;
  334. {
  335. int k, ncomma;
  336. int type2, ptype, ltype;
  337. int convop;
  338. register expptr lp, tp;
  339.  
  340. switch(p->opcode)    /* check for special cases and rewrite */
  341.     {
  342.  
  343.     case OPCONV:
  344.         lp = p->leftp;
  345.         while(p->tag==TEXPR && p->opcode==OPCONV &&
  346.              (    ( (ptype = p->vtype) == (ltype = lp->vtype) ) ||
  347.              (ISREAL(ptype)&&ISREAL(ltype)) ||
  348.              (ONEOF(ptype, M(TYSHORT)|M(TYADDR)) &&
  349.             ONEOF(ltype, M(TYSHORT)|M(TYADDR))) ||
  350.                 (ptype==TYINT && ONEOF(ltype, M(TYSUBR)|M(TYCHAR))) ))
  351.                 {
  352.                 free(p);
  353.                 p = lp;
  354.                 lp = p->leftp;
  355.                 }
  356.         if(p->tag!=TEXPR || p->opcode!=OPCONV || ISCOMPLEX((ltype = lp->vtype)) )
  357.             {
  358.             putx(p);
  359.             return;
  360.             }
  361.         ltype = lp->vtype;
  362.         switch(ptype = p->vtype)
  363.             {
  364.             case TYCHAR:
  365.                 p->leftp = lp = mkconv(TYSHORT, lp);
  366.                 convop = P2ITOC;
  367.                 break;
  368.  
  369.             case TYSHORT:
  370.             case TYADDR:
  371.                 switch(ltype)
  372.                     {
  373.                     case TYLONG:
  374.                         convop = P2LTOI; break;
  375.                     case TYREAL:
  376.                     case TYDREAL:
  377.                         convop = P2FTOI; break;
  378.                     default:
  379.                         goto badconv;
  380.                     }
  381.                 break;
  382.  
  383.             case TYLONG:
  384.                 switch(ltype)
  385.                     {
  386.                     case TYCHAR:
  387.                     case TYSHORT:
  388.                     case TYADDR:
  389.                         convop = P2ITOL; break;
  390.                     case TYREAL:
  391.                     case TYDREAL:
  392.                         convop = P2FTOL; break;
  393.                     default:
  394.                         goto badconv;
  395.                     }
  396.                 break;
  397.  
  398.             case TYREAL:
  399.             case TYDREAL:
  400.                 switch(ltype)
  401.                     {
  402.                     case TYCHAR:
  403.                     case TYSHORT:
  404.                     case TYADDR:
  405.                         convop = P2ITOF; break;
  406.                     case TYLONG:
  407.                         convop = P2LTOF; break;
  408.                     default:
  409.                         goto badconv;
  410.                     }
  411.                 break;
  412.  
  413.             default:
  414.             badconv:
  415.                 fatal("putop: impossible conversion");
  416.             }
  417.         putx(lp);
  418.         p2op2(convop, types2[ptype]);
  419.         free(p);
  420.         return;
  421.  
  422.     case OPADDR:
  423.         lp = p->leftp;
  424.         if(lp->tag != TADDR)
  425.             {
  426.             tp = mktemp(lp->vtype, lp->vleng);
  427.             putx( mkexpr(OPASSIGN, cpexpr(tp), lp) );
  428.             ncomma = 1;
  429.             lp = tp;
  430.             }
  431.         else    ncomma = 0;
  432.         putaddr(lp, NO);
  433.         putcomma(ncomma, TYINT, NO);
  434.         free(p);
  435.         return;
  436.  
  437.     case OPASSIGN:
  438.         if(p->vtype==TYLOGICAL && tylogical!=TYINT &&
  439.            p->rightp->tag==TEXPR && p->rightp->opcode!=OPCALL && p->rightp->opcode!=OPCCALL)
  440.             {
  441.             p->rightp->vtype = TYINT;
  442.             p->rightp = mkconv(tylogical, p->rightp);
  443.             }
  444.         break;
  445.     }
  446.  
  447. if( (k = ops2[p->opcode]) <= 0)
  448.     fatal1("putop: invalid opcode %d", p->opcode);
  449. putx(p->leftp);
  450. if(p->rightp)
  451.     putx(p->rightp);
  452. type2 = (p->vtype==TYLOGICAL ? P2INT : types2[p->vtype]);
  453. p2op2(k, type2);
  454.  
  455. if(p->vleng)
  456.     frexpr(p->vleng);
  457. free(p);
  458. }
  459.  
  460. putforce(t, p)
  461. int t;
  462. expptr p;
  463. {
  464. p = mkconv(t, fixtype(p));
  465. putx(p);
  466. p2op2(P2FORCE, (t==TYSHORT ? P2SHORT : (t==TYLONG ? P2LONG : P2DREAL)) );
  467. putstmt();
  468. }
  469.  
  470.  
  471.  
  472. LOCAL putpower(p)
  473. expptr p;
  474. {
  475. expptr base;
  476. struct addrblock *t1, *t2;
  477. ftnint k;
  478. int type;
  479. int ncomma;
  480.  
  481. if(!ISICON(p->rightp) || (k = p->rightp->const.ci)<2)
  482.     fatal("putpower: bad call");
  483. base = p->leftp;
  484. type = base->vtype;
  485. t1 = mktemp(type, NULL);
  486. t2 = NULL;
  487. ncomma = 1;
  488. putassign(cpexpr(t1), cpexpr(base) );
  489.  
  490. for( ; (k&1)==0 && k>2 ; k>>=1 )
  491.     {
  492.     ++ncomma;
  493.     putsteq(t1, t1);
  494.     }
  495.  
  496. if(k == 2)
  497.     putx( mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) );
  498. else
  499.     {
  500.     t2 = mktemp(type, NULL);
  501.     ++ncomma;
  502.     putassign(cpexpr(t2), cpexpr(t1));
  503.     
  504.     for(k>>=1 ; k>1 ; k>>=1)
  505.         {
  506.         ++ncomma;
  507.         putsteq(t1, t1);
  508.         if(k & 1)
  509.             {
  510.             ++ncomma;
  511.             putsteq(t2, t1);
  512.             }
  513.         }
  514.     putx( mkexpr(OPSTAR, cpexpr(t2),
  515.         mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) ));
  516.     }
  517. putcomma(ncomma, type, NO);
  518. frexpr(t1);
  519. if(t2)
  520.     frexpr(t2);
  521. frexpr(p);
  522. }
  523.  
  524.  
  525.  
  526.  
  527. LOCAL struct addrblock *intdouble(p, ncommap)
  528. struct addrblock *p;
  529. int *ncommap;
  530. {
  531. register struct addrblock *t;
  532.  
  533. t = mktemp(TYDREAL, NULL);
  534. ++*ncommap;
  535. putassign(cpexpr(t), p);
  536. return(t);
  537. }
  538.  
  539.  
  540.  
  541.  
  542.  
  543. LOCAL putcxeq(p)
  544. register struct exprblock *p;
  545. {
  546. register struct addrblock *lp, *rp;
  547. int ncomma;
  548.  
  549. ncomma = 0;
  550. lp = putcx1(p->leftp, &ncomma);
  551. rp = putcx1(p->rightp, &ncomma);
  552. putassign(realpart(lp), realpart(rp));
  553. if( ISCOMPLEX(p->vtype) )
  554.     {
  555.     ++ncomma;
  556.     putassign(imagpart(lp), imagpart(rp));
  557.     }
  558. putcomma(ncomma, TYREAL, NO);
  559. frexpr(rp);
  560. free(p);
  561. return(lp);
  562. }
  563.  
  564.  
  565.  
  566. LOCAL putcxop(p)
  567. expptr p;
  568. {
  569. struct addrblock *putcx1();
  570. int ncomma;
  571.  
  572. ncomma = 0;
  573. putaddr( putcx1(p, &ncomma), NO);
  574. putcomma(ncomma, TYINT, NO);
  575. }
  576.  
  577.  
  578.  
  579. LOCAL struct addrblock *putcx1(p, ncommap)
  580. register expptr p;
  581. int *ncommap;
  582. {
  583. struct addrblock *q, *lp, *rp;
  584. register struct addrblock *resp;
  585. int opcode;
  586. int ltype, rtype;
  587.  
  588. if(p == NULL)
  589.     return(NULL);
  590.  
  591. switch(p->tag)
  592.     {
  593.     case TCONST:
  594.         if( ISCOMPLEX(p->vtype) )
  595.             p = putconst(p);
  596.         return( p );
  597.  
  598.     case TADDR:
  599.         if( ! addressable(p) )
  600.             {
  601.             ++*ncommap;
  602.             resp = mktemp(tyint, NULL);
  603.             putassign( cpexpr(resp), p->memoffset );
  604.             p->memoffset = resp;
  605.             }
  606.         return( p );
  607.  
  608.     case TEXPR:
  609.         if( ISCOMPLEX(p->vtype) )
  610.             break;
  611.         ++*ncommap;
  612.         resp = mktemp(TYDREAL, NO);
  613.         putassign( cpexpr(resp), p);
  614.         return(resp);
  615.  
  616.     default:
  617.         fatal1("putcx1: bad tag %d", p->tag);
  618.     }
  619.  
  620. opcode = p->opcode;
  621. if(opcode==OPCALL || opcode==OPCCALL)
  622.     {
  623.     ++*ncommap;
  624.     return( putcall(p) );
  625.     }
  626. else if(opcode == OPASSIGN)
  627.     {
  628.     ++*ncommap;
  629.     return( putcxeq(p) );
  630.     }
  631. resp = mktemp(p->vtype, NULL);
  632. if(lp = putcx1(p->leftp, ncommap) )
  633.     ltype = lp->vtype;
  634. if(rp = putcx1(p->rightp, ncommap) )
  635.     rtype = rp->vtype;
  636.  
  637. switch(opcode)
  638.     {
  639.     case OPCOMMA:
  640.         frexpr(resp);
  641.         resp = rp;
  642.         rp = NULL;
  643.         break;
  644.  
  645.     case OPNEG:
  646.         putassign( realpart(resp), mkexpr(OPNEG, realpart(lp), NULL) );
  647.         putassign( imagpart(resp), mkexpr(OPNEG, imagpart(lp), NULL) );
  648.         *ncommap += 2;
  649.         break;
  650.  
  651.     case OPPLUS:
  652.     case OPMINUS:
  653.         putassign( realpart(resp), mkexpr(opcode, realpart(lp), realpart(rp) ));
  654.         if(rtype < TYCOMPLEX)
  655.             putassign( imagpart(resp), imagpart(lp) );
  656.         else if(ltype < TYCOMPLEX)
  657.             {
  658.             if(opcode == OPPLUS)
  659.                 putassign( imagpart(resp), imagpart(rp) );
  660.             else    putassign( imagpart(resp), mkexpr(OPNEG, imagpart(rp), NULL) );
  661.             }
  662.         else
  663.             putassign( imagpart(resp), mkexpr(opcode, imagpart(lp), imagpart(rp) ));
  664.  
  665.         *ncommap += 2;
  666.         break;
  667.  
  668.     case OPSTAR:
  669.         if(ltype < TYCOMPLEX)
  670.             {
  671.             if( ISINT(ltype) )
  672.                 lp = intdouble(lp, ncommap);
  673.             putassign( realpart(resp), mkexpr(OPSTAR, cpexpr(lp), realpart(rp) ));
  674.             putassign( imagpart(resp), mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) ));
  675.             }
  676.         else if(rtype < TYCOMPLEX)
  677.             {
  678.             if( ISINT(rtype) )
  679.                 rp = intdouble(rp, ncommap);
  680.             putassign( realpart(resp), mkexpr(OPSTAR, cpexpr(rp), realpart(lp) ));
  681.             putassign( imagpart(resp), mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) ));
  682.             }
  683.         else    {
  684.             putassign( realpart(resp), mkexpr(OPMINUS,
  685.                 mkexpr(OPSTAR, realpart(lp), realpart(rp)),
  686.                 mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) ));
  687.             putassign( imagpart(resp), mkexpr(OPPLUS,
  688.                 mkexpr(OPSTAR, realpart(lp), imagpart(rp)),
  689.                 mkexpr(OPSTAR, imagpart(lp), realpart(rp)) ));
  690.             }
  691.         *ncommap += 2;
  692.         break;
  693.  
  694.     case OPSLASH:
  695.         /* fixexpr has already replaced all divisions
  696.          * by a complex by a function call
  697.          */
  698.         if( ISINT(rtype) )
  699.             rp = intdouble(rp, ncommap);
  700.         putassign( realpart(resp), mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) );
  701.         putassign( imagpart(resp), mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) );
  702.         *ncommap += 2;
  703.         break;
  704.  
  705.     case OPCONV:
  706.         putassign( realpart(resp), realpart(lp) );
  707.         if( ISCOMPLEX(lp->vtype) )
  708.             q = imagpart(lp);
  709.         else if(rp != NULL)
  710.             q = realpart(rp);
  711.         else
  712.             q = mkrealcon(TYDREAL, 0.0);
  713.         putassign( imagpart(resp), q);
  714.         *ncommap += 2;
  715.         break;
  716.  
  717.     default:
  718.         fatal1("putcx1 of invalid opcode %d", opcode);
  719.     }
  720.  
  721. frexpr(lp);
  722. frexpr(rp);
  723. free(p);
  724. return(resp);
  725. }
  726.  
  727.  
  728.  
  729.  
  730. LOCAL putcxcmp(p)
  731. register struct exprblock *p;
  732. {
  733. int opcode;
  734. int ncomma;
  735. register struct addrblock *lp, *rp;
  736. struct exprblock *q;
  737.  
  738. ncomma = 0;
  739. opcode = p->opcode;
  740. lp = putcx1(p->leftp, &ncomma);
  741. rp = putcx1(p->rightp, &ncomma);
  742.  
  743. q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
  744.     mkexpr(opcode, realpart(lp), realpart(rp)),
  745.     mkexpr(opcode, imagpart(lp), imagpart(rp)) );
  746. putx( fixexpr(q) );
  747. putcomma(ncomma, TYINT, NO);
  748.  
  749. free(lp);
  750. free(rp);
  751. free(p);
  752. }
  753.  
  754. LOCAL struct addrblock *putch1(p, ncommap)
  755. register expptr p;
  756. int * ncommap;
  757. {
  758. register struct addrblock *t;
  759. struct addrblock *mktemp(), *putconst();
  760.  
  761. switch(p->tag)
  762.     {
  763.     case TCONST:
  764.         return( putconst(p) );
  765.  
  766.     case TADDR:
  767.         return(p);
  768.  
  769.     case TEXPR:
  770.         ++*ncommap;
  771.  
  772.         switch(p->opcode)
  773.             {
  774.             case OPCALL:
  775.             case OPCCALL:
  776.                 t = putcall(p);
  777.                 break;
  778.  
  779.             case OPCONCAT:
  780.                 t = mktemp(TYCHAR, cpexpr(p->vleng) );
  781.                 putcat( cpexpr(t), p );
  782.                 break;
  783.  
  784.             case OPCONV:
  785.                 if(!ISICON(p->vleng) || p->vleng->const.ci!=1
  786.                    || ! INT(p->leftp->vtype) )
  787.                     fatal("putch1: bad character conversion");
  788.                 t = mktemp(TYCHAR, ICON(1) );
  789.                 putop( mkexpr(OPASSIGN, cpexpr(t), p) );
  790.                 break;
  791.             default:
  792.                 fatal1("putch1: invalid opcode %d", p->opcode);
  793.             }
  794.         return(t);
  795.  
  796.     default:
  797.         fatal1("putch1: bad tag %d", p->tag);
  798.     }
  799. /* NOTREACHED */
  800. }
  801.  
  802.  
  803.  
  804.  
  805. LOCAL putchop(p)
  806. expptr p;
  807. {
  808. int ncomma;
  809.  
  810. ncomma = 0;
  811. putaddr( putch1(p, &ncomma) , NO );
  812. putcomma(ncomma, TYCHAR, YES);
  813. }
  814.  
  815.  
  816.  
  817.  
  818. LOCAL putcheq(p)
  819. register struct exprblock *p;
  820. {
  821. int ncomma;
  822.  
  823. ncomma = 0;
  824. if( p->rightp->tag==TEXPR && p->rightp->opcode==OPCONCAT )
  825.     putcat(p->leftp, p->rightp);
  826. else if( ISONE(p->leftp->vleng) && ISONE(p->rightp->vleng) )
  827.     {
  828.     putaddr( putch1(p->leftp, &ncomma) , YES );
  829.     putaddr( putch1(p->rightp, &ncomma) , YES );
  830.     putcomma(ncomma, TYINT, NO);
  831.     p2op2(P2ASSIGN, P2CHAR);
  832.     }
  833. else
  834.     {
  835.     putx( call2(TYINT, "s_copy", p->leftp, p->rightp) );
  836.     putcomma(ncomma, TYINT, NO);
  837.     }
  838. frexpr(p->vleng);
  839. free(p);
  840. }
  841.  
  842.  
  843.  
  844.  
  845. LOCAL putchcmp(p)
  846. register struct exprblock *p;
  847. {
  848. int ncomma;
  849.  
  850. ncomma = 0;
  851. if(ISONE(p->leftp->vleng) && ISONE(p->rightp->vleng) )
  852.     {
  853.     putaddr( putch1(p->leftp, &ncomma) , YES );
  854.     putaddr( putch1(p->rightp, &ncomma) , YES );
  855.     p2op2(ops2[p->opcode], P2CHAR);
  856.     free(p);
  857.     putcomma(ncomma, TYINT, NO);
  858.     }
  859. else
  860.     {
  861.     p->leftp = call2(TYINT,"s_cmp", p->leftp, p->rightp);
  862.     p->rightp = ICON(0);
  863.     putop(p);
  864.     }
  865. }
  866.  
  867.  
  868.  
  869.  
  870.  
  871. LOCAL putcat(lhs, rhs)
  872. register struct addrblock *lhs;
  873. register expptr rhs;
  874. {
  875. int n, ncomma;
  876. struct addrblock *lp, *cp;
  877.  
  878. ncomma = 0;
  879. n = ncat(rhs);
  880. lp = mktmpn(n, TYLENG, NULL);
  881. cp = mktmpn(n, TYADDR, NULL);
  882.  
  883. n = 0;
  884. putct1(rhs, lp, cp, &n, &ncomma);
  885.  
  886. putx( call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n)) ) );
  887. putcomma(ncomma, TYINT, NO);
  888. }
  889.  
  890.  
  891.  
  892.  
  893.  
  894. LOCAL ncat(p)
  895. register expptr p;
  896. {
  897. if(p->tag==TEXPR && p->opcode==OPCONCAT)
  898.     return( ncat(p->leftp) + ncat(p->rightp) );
  899. else    return(1);
  900. }
  901.  
  902.  
  903.  
  904.  
  905. LOCAL putct1(q, lp, cp, ip, ncommap)
  906. register expptr q;
  907. register struct addrblock *lp, *cp;
  908. int *ip, *ncommap;
  909. {
  910. int i;
  911. struct addrblock *lp1, *cp1;
  912.  
  913. if(q->tag==TEXPR && q->opcode==OPCONCAT)
  914.     {
  915.     putct1(q->leftp, lp, cp, ip, ncommap);
  916.     putct1(q->rightp, lp, cp , ip, ncommap);
  917.     frexpr(q->vleng);
  918.     free(q);
  919.     }
  920. else
  921.     {
  922.     i = (*ip)++;
  923.     lp1 = cpexpr(lp);
  924.     lp1->memoffset = mkexpr(OPPLUS, lp1->memoffset, ICON(i*SZLENG));
  925.     cp1 = cpexpr(cp);
  926.     cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR));
  927.     putassign( lp1, cpexpr(q->vleng) );
  928.     putassign( cp1, addrof(putch1(q,ncommap)) );
  929.     *ncommap += 2;
  930.     }
  931. }
  932.  
  933. LOCAL putaddr(p, indir)
  934. register struct addrblock *p;
  935. int indir;
  936. {
  937. int type, type2, funct;
  938. expptr offp;
  939.  
  940. type = p->vtype;
  941. type2 = types2[type];
  942. if(p->vclass == CLPROC)
  943.     {
  944.     funct = P2FUNCT;
  945.     if(type == TYUNKNOWN)
  946.         type2 = P2INT;
  947.     }
  948. else
  949.     funct = 0;
  950. if(p->memoffset && (!ISICON(p->memoffset) || p->memoffset->const.ci!=0) )
  951.     offp = cpexpr(p->memoffset);
  952. else
  953.     offp = NULL;
  954.  
  955. #if FUDGEOFFSET != 1
  956. if(offp)
  957.     offp = mkexpr(OPSTAR, ICON(FUDGEOFFSET), offp);
  958. #endif
  959.  
  960. switch(p->vstg)
  961.     {
  962.     case STGAUTO:
  963.         p2reg(AUTOREG, P2PTR);
  964.         p2offset(type2|P2PTR, offp);
  965.         if(indir)
  966.             p2op2(P2INDIRECT, type2);
  967.         break;
  968.  
  969.     case STGLENG:
  970.     case STGARG:
  971.         p2reg(ARGREG, type2|P2PTR|((funct?funct:P2PTR)<<2));
  972.         if(p->memno)
  973.             {
  974.             putx( ICON(p->memno) );
  975.             p2op2(P2PLUS, type2|P2PTR|(funct<<2));
  976.             }
  977.         if(p->vstg == STGARG)
  978.             {
  979.             p2op2(P2INDIRECT, type2|P2PTR);
  980.             p2offset(type2|P2PTR|(funct<<2), offp);
  981.             }
  982.         if(indir)
  983.             p2op2(P2INDIRECT, type2|funct);
  984.         break;
  985.  
  986.     case STGBSS:
  987.     case STGINIT:
  988.     case STGEXT:
  989.     case STGCOMMON:
  990.     case STGEQUIV:
  991.     case STGCONST:
  992.         p2op(P2NAME);
  993.         p2i(P2EXTERN);
  994.         p2i(type2|funct);
  995.         p2str( memname(p->vstg,p->memno) );
  996.         if(!indir || offp!=NULL)
  997.             p2op2(P2ADDR, type2|P2PTR);
  998.         p2offset(type2|P2PTR, offp);
  999.         if(indir && offp!=NULL)
  1000.             p2op2(P2INDIRECT, type2);
  1001.         break;
  1002.  
  1003.     case STGREG:
  1004.         if(indir)
  1005.             p2reg(p->memno, type2);
  1006.         break;
  1007.  
  1008.     default:
  1009.         fatal1("putaddr: invalid vstg %d", p->vstg);
  1010.     }
  1011. frexpr(p);
  1012. }
  1013.  
  1014.  
  1015.  
  1016.  
  1017.  
  1018. LOCAL struct addrblock *putcall(p)
  1019. register struct exprblock *p;
  1020. {
  1021. chainp arglist, charsp, cp;
  1022. int first;
  1023. struct addrblock *t;
  1024. register struct exprblock *q;
  1025. struct exprblock *fval;
  1026. int type, type2, ctype, indir;
  1027.  
  1028. if( (type = p->vtype) == TYLOGICAL)
  1029.     type = tylogical;
  1030. type2 = types2[type];
  1031. charsp = NULL;
  1032. first = YES;
  1033. indir =  (p->opcode == OPCCALL);
  1034.  
  1035. if(p->rightp)
  1036.     {
  1037.     arglist = p->rightp->listp;
  1038.     free(p->rightp);
  1039.     }
  1040. else
  1041.     arglist = NULL;
  1042.  
  1043. if(!indir)  for(cp = arglist ; cp ; cp = cp->nextp)
  1044.     {
  1045.     q = cp->datap;
  1046.     if( ISCONST(q) )
  1047.         {
  1048.         if(q->vtype == TYSHORT)
  1049.             q = mkconv(tyint, q);
  1050.         cp->datap = q = putconst(q);
  1051.         }
  1052.     if( ISCHAR(q) )
  1053.         charsp = hookup(charsp, mkchain(cpexpr(q->vleng), 0) );
  1054.     else if(q->vclass == CLPROC)
  1055.         charsp = hookup(charsp, mkchain( ICON(0) , 0));
  1056.     }
  1057.  
  1058. if(type == TYCHAR)
  1059.     {
  1060.     if( ISICON(p->vleng) )
  1061.         fval = mktemp(TYCHAR, p->vleng);
  1062.     else    {
  1063.         err("adjustable character function");
  1064.         return(NULL);
  1065.         }
  1066.     }
  1067. else if( ISCOMPLEX(type) )
  1068.     fval = mktemp(type, NULL);
  1069. else
  1070.     fval = NULL;
  1071.  
  1072. ctype = (fval ? P2INT : type2);
  1073. putaddr(p->leftp, YES);
  1074.  
  1075. if(fval)
  1076.     {
  1077.     first = NO;
  1078.     putaddr( cpexpr(fval), NO);
  1079.     if(type==TYCHAR)
  1080.         {
  1081.         putx( mkconv(TYLENG, p->vleng) );
  1082.         p2op2(P2LISTOP, P2INT);
  1083.         }
  1084.     }
  1085.  
  1086. for(cp = arglist ; cp ; cp = cp->nextp)
  1087.     {
  1088.     q = cp->datap;
  1089.     if(q->tag==TADDR && (indir || q->vstg!=STGREG) )
  1090.         putaddr(q, indir && q->vtype!=TYCHAR);
  1091.     else if( ISCOMPLEX(q->vtype) )
  1092.         putcxop(q);
  1093.     else if (ISCHAR(q) )
  1094.         putchop(q);
  1095.     else if( ! ISERROR(q) )
  1096.         {
  1097.         if(indir)
  1098.             putx(q);
  1099.         else    {
  1100.             t = mktemp(q->vtype, q->vleng);
  1101.             putassign( cpexpr(t), q );
  1102.             putaddr(t, NO);
  1103.             putcomma(1, q->vtype, YES);
  1104.             }
  1105.         }
  1106.     if(first)
  1107.         first = NO;
  1108.     else
  1109.         p2op2(P2LISTOP, P2INT);
  1110.     }
  1111.  
  1112. if(arglist)
  1113.     frchain(&arglist);
  1114. for(cp = charsp ; cp ; cp = cp->nextp)
  1115.     {
  1116.     putx( mkconv(TYLENG, cp->datap) );
  1117.     if(first)
  1118.         first = NO;
  1119.     else
  1120.         p2op2(P2LISTOP, P2INT);
  1121.     }
  1122. frchain(&charsp);
  1123.  
  1124. if(first)
  1125.     p2op(P2NULL);
  1126. p2op2(P2CALL, ctype);
  1127. free(p);
  1128. return(fval);
  1129. }
  1130.  
  1131.  
  1132.  
  1133. LOCAL putmnmx(p)
  1134. register struct exprblock *p;
  1135. {
  1136. int op, type;
  1137. int ncomma;
  1138. struct exprblock *qp;
  1139. chainp p0, p1;
  1140. struct addrblock *sp, *tp;
  1141.  
  1142. type = p->vtype;
  1143. op = (p->opcode==OPMIN ? OPLT : OPGT );
  1144. p0 = p->leftp->listp;
  1145. free(p->leftp);
  1146. free(p);
  1147.  
  1148. sp = mktemp(type, NULL);
  1149. tp = mktemp(type, NULL);
  1150. qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp));
  1151. qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp);
  1152. qp = fixexpr(qp);
  1153.  
  1154. ncomma = 1;
  1155. putassign( cpexpr(sp), p0->datap );
  1156.  
  1157. for(p1 = p0->nextp ; p1 ; p1 = p1->nextp)
  1158.     {
  1159.     ++ncomma;
  1160.     putassign( cpexpr(tp), p1->datap );
  1161.     if(p1->nextp)
  1162.         {
  1163.         ++ncomma;
  1164.         putassign( cpexpr(sp), cpexpr(qp) );
  1165.         }
  1166.     else
  1167.         putx(qp);
  1168.     }
  1169.  
  1170. putcomma(ncomma, type, NO);
  1171. frtemp(sp);
  1172. frtemp(tp);
  1173. frchain( &p0 );
  1174. }
  1175.  
  1176.  
  1177.  
  1178.  
  1179. LOCAL putcomma(n, type, indir)
  1180. int n, type, indir;
  1181. {
  1182. type = types2[type];
  1183. if(indir)
  1184.     type |= P2PTR;
  1185. while(--n >= 0)
  1186.     p2op2(P2COMOP, type);
  1187. }
  1188.  
  1189. /*
  1190.  *  routines that put bytes on the pass2 input stream
  1191. */
  1192.  
  1193.  
  1194. p2i(k)
  1195. int k;
  1196. {
  1197. register char *s;
  1198. s = &k;
  1199.  
  1200. putc(*s++, textfile);
  1201. putc(*s, textfile);
  1202. }
  1203.  
  1204.  
  1205.  
  1206.  
  1207. p2op(op)
  1208. int op;
  1209. {
  1210. putc(op, textfile);
  1211. putc(0376, textfile);   /* MAGIC NUMBER */
  1212. }
  1213.  
  1214.  
  1215.  
  1216.  
  1217. p2str(s)
  1218. register char *s;
  1219. {
  1220. do
  1221.     putc(*s, textfile);
  1222.         while(*s++);
  1223. }
  1224.  
  1225.  
  1226.  
  1227. p2op2(op, i)
  1228. int op, i;
  1229. {
  1230. p2op(op);
  1231. p2i(i);
  1232. }
  1233.  
  1234.  
  1235.  
  1236. p2reg(k, type)
  1237. int k;
  1238. {
  1239. p2op2(P2NAME, P2REG);
  1240. p2i(type);
  1241. p2i(k);
  1242. }
  1243.  
  1244.  
  1245.  
  1246. LOCAL p2li(n)
  1247. long int n;
  1248. {
  1249. register int *p, i;
  1250.  
  1251. p = &n;
  1252. for(i = 0 ; i< sizeof(long int)/sizeof(int) ; ++i)
  1253.     p2i(*p++);
  1254. }
  1255.  
  1256.  
  1257.  
  1258. LOCAL p2offset(type, offp)
  1259. int type;
  1260. register expptr offp;
  1261. {
  1262. expptr shorten();
  1263.  
  1264. if(offp)
  1265.     {
  1266. #if SZINT < SZLONG
  1267.     if(shortsubs)
  1268.         offp = shorten(offp);
  1269. #endif
  1270.     if(offp->vtype != TYLONG)
  1271.         offp = mkconv(TYINT, offp);
  1272.     if(offp->vtype == TYLONG)
  1273.         {
  1274.         putx(offp);
  1275.         p2op2(P2LTOI, P2INT);
  1276.         }
  1277.     else
  1278.         putx( offp );
  1279.     p2op2(P2PLUS, type);
  1280.     }
  1281. }
  1282.