cc/ccom/complex.c

   1 /*      $Id: complex.c,v 1.5 2023/07/26 06:46:44 ragge Exp $    */
   2 /*
   3  * Copyright (c) 2003 Anders Magnusson (ragge@ludd.luth.se).
   4  * All rights reserved.
   5  *
   6  * Redistribution and use in source and binary forms, with or without
   7  * modification, are permitted provided that the following conditions
   8  * are met:
   9  * 1. Redistributions of source code must retain the above copyright
  10  *    notice, this list of conditions and the following disclaimer.
  11  * 2. 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  *
  15  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  16  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  17  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  18  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  19  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  20  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  21  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  22  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  23  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  24  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  25  */
  26
  27 #include "pass1.h"
  28
  29 #undef n_type
  30 #define n_type ptype
  31 #undef n_qual
  32 #define n_qual pqual
  33 #undef n_df
  34 #define n_df pdf
  35
  36
  37 #ifndef NO_COMPLEX
  38
  39 extern int dimfuncnt;
  40
  41 static char *real, *imag;
  42 static struct symtab *cxsp[3], *cxmul[3], *cxdiv[3];
  43 static char *cxnmul[] = { "__mulsc3", "__muldc3", "__mulxc3" };
  44 static char *cxndiv[] = { "__divsc3", "__divdc3", "__divxc3" };
  45 /*
  46  * As complex numbers internally are handled as structs, create
  47  * these by hand-crafting them.
  48  */
  49 void
  50 complinit(void)
  51 {
  52         struct attr *ap;
  53         struct rstack *rp;
  54         P1ND *p, *q;
  55         char *n[] = { "0f", "0d", "0l" };
  56         int i, d_debug;
  57
  58         d_debug = ddebug;
  59         ddebug = 0;
  60         real = addname("__real");
  61         imag = addname("__imag");
  62         p = block(NAME, NULL, NULL, FLOAT, 0, 0);
  63         for (i = 0; i < 3; i++) {
  64                 p->n_type = FLOAT+i;
  65                 rpole = rp = bstruct(NULL, STNAME, NULL);
  66                 soumemb(p, real, 0);
  67                 soumemb(p, imag, 0);
  68                 q = dclstruct(rp);
  69                 cxsp[i] = q->n_sp = lookup(addname(n[i]), 0);
  70                 defid(q, TYPEDEF);
  71                 ap = attr_new(ATTR_COMPLEX, 0);
  72                 q->n_sp->sap = attr_add(q->n_sp->sap, ap);
  73                 p1nfree(q);
  74         }
  75         /* create function declarations for external ops */
  76         for (i = 0; i < 3; i++) {
  77                 cxnmul[i] = addname(cxnmul[i]);
  78                 p->n_sp = cxmul[i] = lookup(cxnmul[i], 0);
  79                 p->n_type = FTN|STRTY;
  80                 p->n_ap = cxsp[i]->sap;
  81                 p->n_df = cxsp[i]->sdf;
  82                 p->pss = cxsp[i]->sss;
  83                 defid2(p, EXTERN, 0);
  84                 cxmul[i]->sdf = permalloc(sizeof(union dimfun));
  85                 dimfuncnt++;
  86                 cxmul[i]->sdf->dlst = 0;
  87                 cxndiv[i] = addname(cxndiv[i]);
  88                 p->n_sp = cxdiv[i] = lookup(cxndiv[i], 0);
  89                 p->n_type = FTN|STRTY;
  90                 p->n_ap = cxsp[i]->sap;
  91                 p->n_df = cxsp[i]->sdf;
  92                 p->pss = cxsp[i]->sss;
  93                 defid2(p, EXTERN, 0);
  94                 cxdiv[i]->sdf = permalloc(sizeof(union dimfun));
  95                 dimfuncnt++;
  96                 cxdiv[i]->sdf->dlst = 0;
  97         }
  98         p1nfree(p);
  99         ddebug = d_debug;
 100 }
 101
 102 static TWORD
 103 maxtt(P1ND *p)
 104 {
 105         TWORD t;
 106
 107         t = ANYCX(p) ? strmemb(p->n_td->ss)->stype : p->n_type;
 108         t = BTYPE(t);
 109         if (t == VOID)
 110                 t = CHAR; /* pointers */
 111         if (ISITY(t))
 112                 t -= (FIMAG - FLOAT);
 113         return t;
 114 }
 115
 116 /*
 117  * Return the highest real floating point type.
 118  * Known that at least one type is complex or imaginary.
 119  */
 120 static TWORD
 121 maxtyp(P1ND *l, P1ND *r)
 122 {
 123         TWORD tl, tr, t;
 124
 125         tl = maxtt(l);
 126         tr = maxtt(r);
 127         t = tl > tr ? tl : tr;
 128         if (!ISFTY(t))
 129                 cerror("maxtyp");
 130         return t;
 131 }
 132
 133 /*
 134  * Fetch space on stack for complex struct.
 135  */
 136 static P1ND *
 137 cxstore(TWORD t)
 138 {
 139         struct symtab s;
 140
 141         s = *cxsp[t - FLOAT];
 142         s.sclass = AUTO;
 143         s.soffset = NOOFFSET;
 144         oalloc(&s, &autooff);
 145         return nametree(&s);
 146 }
 147
 148 #define comop(x,y) buildtree(COMOP, x, y)
 149
 150 /*
 151  * Convert node p to complex type dt.
 152  */
 153 P1ND *
 154 mkcmplx(P1ND *p, TWORD dt)
 155 {
 156         P1ND *q, *r, *i, *t;
 157
 158         if (!ANYCX(p)) {
 159                 /* Not complex, convert to complex on stack */
 160                 q = cxstore(dt);
 161                 if (ISITY(p->n_type)) {
 162                         p->n_type = p->n_type - FIMAG + FLOAT;
 163                         r = bcon(0);
 164                         i = p;
 165                 } else {
 166                         if (ISPTR(p->n_type))
 167                                 p = cast(p, INTPTR, 0);
 168                         r = p;
 169                         i = bcon(0);
 170                 }
 171                 p = buildtree(ASSIGN, structref(p1tcopy(q), DOT, real), r);
 172                 p = comop(p, buildtree(ASSIGN, structref(p1tcopy(q), DOT, imag), i));
 173                 p = comop(p, q);
 174         } else {
 175                 if (strmemb(p->n_td->ss)->stype != dt) {
 176                         q = cxstore(dt);
 177                         p = buildtree(ADDROF, p, NULL);
 178                         t = tempnode(0, p->n_type, p->n_df, p->pss);
 179                         p = buildtree(ASSIGN, p1tcopy(t), p);
 180                         p = comop(p, buildtree(ASSIGN,
 181                             structref(p1tcopy(q), DOT, real),
 182                             structref(p1tcopy(t), STREF, real)));
 183                         p = comop(p, buildtree(ASSIGN,
 184                             structref(p1tcopy(q), DOT, imag),
 185                             structref(t, STREF, imag)));
 186                         p = comop(p, q);
 187                 }
 188         }
 189         return p;
 190 }
 191
 192 static P1ND *
 193 cxasg(P1ND *l, P1ND *r)
 194 {
 195         TWORD tl, tr;
 196
 197         tl = strattr(l->n_td) ? strmemb(l->n_td->ss)->stype : 0;
 198         tr = strattr(r->n_td) ? strmemb(r->n_td->ss)->stype : 0;
 199
 200         if (ANYCX(l) && ANYCX(r) && tl != tr) {
 201                 /* different types in structs */
 202                 r = mkcmplx(r, tl);
 203         } else if (!ANYCX(l))
 204                 r = structref(r, DOT, ISITY(l->n_type) ? imag : real);
 205         else if (!ANYCX(r))
 206                 r = mkcmplx(r, tl);
 207         return buildtree(ASSIGN, l, r);
 208 }
 209
 210 /*
 211  * Fixup complex operations.
 212  * At least one operand is complex.
 213  */
 214 P1ND *
 215 cxop(int op, P1ND *l, P1ND *r)
 216 {
 217         TWORD mxtyp;
 218         P1ND *p, *q;
 219         P1ND *ltemp, *rtemp;
 220         P1ND *real_l, *imag_l;
 221         P1ND *real_r, *imag_r;
 222         real_r = imag_r = NULL; /* bad uninit var warning */
 223
 224         if (op == ASSIGN)
 225                 return cxasg(l, r);
 226
 227         mxtyp = maxtyp(l, r);
 228         l = mkcmplx(l, mxtyp);
 229         if (op != UMINUS)
 230                 r = mkcmplx(r, mxtyp);
 231
 232         if (op == COLON)
 233                 return buildtree(COLON, l, r);
 234
 235         /* put a pointer to left and right elements in a TEMP */
 236         l = buildtree(ADDROF, l, NULL);
 237         ltemp = tempnode(0, l->n_type, l->n_df, l->pss);
 238         l = buildtree(ASSIGN, p1tcopy(ltemp), l);
 239
 240         if (op != UMINUS) {
 241                 r = buildtree(ADDROF, r, NULL);
 242                 rtemp = tempnode(0, r->n_type, r->n_df, r->pss);
 243                 r = buildtree(ASSIGN, p1tcopy(rtemp), r);
 244
 245                 p = comop(l, r);
 246         } else
 247                 p = l;
 248
 249         /* create the four trees needed for calculation */
 250         real_l = structref(p1tcopy(ltemp), STREF, real);
 251         imag_l = structref(ltemp, STREF, imag);
 252         if (op != UMINUS) {
 253                 real_r = structref(p1tcopy(rtemp), STREF, real);
 254                 imag_r = structref(rtemp, STREF, imag);
 255         }
 256
 257         /* get storage on stack for the result */
 258         q = cxstore(mxtyp);
 259
 260         switch (op) {
 261         case NE:
 262         case EQ:
 263                 p1tfree(q);
 264                 p = buildtree(op, comop(p, real_l), real_r);
 265                 q = buildtree(op, imag_l, imag_r);
 266                 p = buildtree(op == EQ ? ANDAND : OROR, p, q);
 267                 return p;
 268
 269         case ANDAND:
 270         case OROR: /* go via EQ to get INT of it */
 271                 p1tfree(q);
 272                 p = buildtree(NE, comop(p, real_l), bcon(0)); /* gets INT */
 273                 q = buildtree(NE, imag_l, bcon(0));
 274                 p = buildtree(OR, p, q);
 275
 276                 q = buildtree(NE, real_r, bcon(0));
 277                 q = buildtree(OR, q, buildtree(NE, imag_r, bcon(0)));
 278
 279                 p = buildtree(op, p, q);
 280                 return p;
 281
 282         case UMINUS:
 283                 p = comop(p, buildtree(ASSIGN, structref(p1tcopy(q), DOT, real),
 284                     buildtree(op, real_l, NULL)));
 285                 p = comop(p, buildtree(ASSIGN, structref(p1tcopy(q), DOT, imag),
 286                     buildtree(op, imag_l, NULL)));
 287                 break;
 288
 289         case PLUS:
 290         case MINUS:
 291                 p = comop(p, buildtree(ASSIGN, structref(p1tcopy(q), DOT, real),
 292                     buildtree(op, real_l, real_r)));
 293                 p = comop(p, buildtree(ASSIGN, structref(p1tcopy(q), DOT, imag),
 294                     buildtree(op, imag_l, imag_r)));
 295                 break;
 296
 297         case MUL:
 298         case DIV:
 299                 /* Complex mul is "complex" */
 300                 /* (u+iv)*(x+iy)=((u*x)-(v*y))+i(v*x+y*u) */
 301                 /* Complex div is even more "complex" */
 302                 /* (u+iv)/(x+iy)=(u*x+v*y)/(x*x+y*y)+i((v*x-u*y)/(x*x+y*y)) */
 303                 /* but we need to do it via a subroutine */
 304                 p1tfree(q);
 305                 p = buildtree(CM, comop(p, real_l), imag_l);
 306                 p = buildtree(CM, p, real_r);
 307                 p = buildtree(CM, p, imag_r);
 308                 q = nametree(op == DIV ?
 309                     cxdiv[mxtyp-FLOAT] : cxmul[mxtyp-FLOAT]);
 310                 return buildtree(CALL, q, p);
 311                 break;
 312         default:
 313                 uerror("illegal operator %s", copst(op));
 314         }
 315         return comop(p, q);
 316 }
 317
 318 /*
 319  * Fixup imaginary operations.
 320  * At least one operand is imaginary, none is complex.
 321  */
 322 P1ND *
 323 imop(int op, P1ND *l, P1ND *r)
 324 {
 325         P1ND *p, *q;
 326         TWORD mxtyp;
 327         int li, ri;
 328
 329         li = ri = 0;
 330         if (ISITY(l->n_type))
 331                 li = 1, l->n_type = l->n_type - (FIMAG-FLOAT);
 332         if (ISITY(r->n_type))
 333                 ri = 1, r->n_type = r->n_type - (FIMAG-FLOAT);
 334
 335         mxtyp = maxtyp(l, r);
 336         switch (op) {
 337         case ASSIGN:
 338                 /* if both are imag, store value, otherwise store 0.0 */
 339                 if (!(li && ri)) {
 340                         p1tfree(r);
 341                         r = bcon(0);
 342                 }
 343                 p = buildtree(ASSIGN, l, r);
 344                 p->n_type += (FIMAG-FLOAT);
 345                 break;
 346
 347         case PLUS:
 348                 if (li && ri) {
 349                         p = buildtree(PLUS, l, r);
 350                         p->n_type += (FIMAG-FLOAT);
 351                 } else {
 352                         /* If one is imaginary and one is real, make complex */
 353                         if (li)
 354                                 q = l, l = r, r = q; /* switch */
 355                         q = cxstore(mxtyp);
 356                         p = buildtree(ASSIGN,
 357                             structref(p1tcopy(q), DOT, real), l);
 358                         p = comop(p, buildtree(ASSIGN,
 359                             structref(p1tcopy(q), DOT, imag), r));
 360                         p = comop(p, q);
 361                 }
 362                 break;
 363
 364         case MINUS:
 365                 if (li && ri) {
 366                         p = buildtree(MINUS, l, r);
 367                         p->n_type += (FIMAG-FLOAT);
 368                 } else if (li) {
 369                         q = cxstore(mxtyp);
 370                         p = buildtree(ASSIGN, structref(p1tcopy(q), DOT, real),
 371                             buildtree(UMINUS, r, NULL));
 372                         p = comop(p, buildtree(ASSIGN,
 373                             structref(p1tcopy(q), DOT, imag), l));
 374                         p = comop(p, q);
 375                 } else /* if (ri) */ {
 376                         q = cxstore(mxtyp);
 377                         p = buildtree(ASSIGN,
 378                             structref(p1tcopy(q), DOT, real), l);
 379                         p = comop(p, buildtree(ASSIGN,
 380                             structref(p1tcopy(q), DOT, imag),
 381                             buildtree(UMINUS, r, NULL)));
 382                         p = comop(p, q);
 383                 }
 384                 break;
 385
 386         case MUL:
 387                 p = buildtree(MUL, l, r);
 388                 if (li && ri)
 389                         p = buildtree(UMINUS, p, NULL);
 390                 if (li ^ ri)
 391                         p->n_type += (FIMAG-FLOAT);
 392                 break;
 393
 394         case DIV:
 395                 p = buildtree(DIV, l, r);
 396                 if (ri && !li)
 397                         p = buildtree(UMINUS, p, NULL);
 398                 if (li ^ ri)
 399                         p->n_type += (FIMAG-FLOAT);
 400                 break;
 401
 402         case EQ:
 403         case NE:
 404         case LT:
 405         case LE:
 406         case GT:
 407         case GE:
 408                 if (li ^ ri) { /* always 0 */
 409                         p1tfree(l);
 410                         p1tfree(r);
 411                         p = bcon(0);
 412                 } else
 413                         p = buildtree(op, l, r);
 414                 break;
 415
 416         default:
 417                 cerror("imop");
 418                 p = NULL;
 419         }
 420         return p;
 421 }
 422
 423 P1ND *
 424 cxelem(int op, P1ND *p)
 425 {
 426
 427         if (ANYCX(p)) {
 428                 p = structref(p, DOT, op == XREAL ? real : imag);
 429         } else if (op == XIMAG) {
 430                 /* XXX  sanitycheck? */
 431                 p1tfree(p);
 432                 p = bcon(0);
 433         }
 434         return p;
 435 }
 436
 437 P1ND *
 438 cxconj(P1ND *p)
 439 {
 440         P1ND *q, *r;
 441
 442         /* XXX side effects? */
 443         q = cxstore(strmemb(p->n_td->ss)->stype);
 444         r = buildtree(ASSIGN, structref(p1tcopy(q), DOT, real),
 445             structref(p1tcopy(p), DOT, real));
 446         r = comop(r, buildtree(ASSIGN, structref(p1tcopy(q), DOT, imag),
 447             buildtree(UMINUS, structref(p, DOT, imag), NULL)));
 448         return comop(r, q);
 449 }
 450
 451 /*
 452  * Prepare for return.
 453  * There may be implicit casts to other types.
 454  */
 455 P1ND *
 456 imret(P1ND *p, P1ND *q)
 457 {
 458         if (ISITY(q->n_type) && ISITY(p->n_type)) {
 459                 if (p->n_type != q->n_type) {
 460                         p->n_type -= (FIMAG-FLOAT);
 461                         p = cast(p, q->n_type - (FIMAG-FLOAT), 0);
 462                         p->n_type += (FIMAG-FLOAT);
 463                 }
 464         } else {
 465                 p1tfree(p);
 466                 if (ISITY(q->n_type)) {
 467                         p = block(FCON, 0, 0, q->n_type, 0, 0);
 468                         p->n_scon = sfallo();
 469                         FLOAT_INT2FP(p->n_scon, 0, INT);
 470                 } else
 471                         p = bcon(0);
 472         }
 473
 474         return p;
 475 }
 476
 477 /*
 478  * Prepare for return.
 479  * There may be implicit casts to other types.
 480  */
 481 P1ND *
 482 cxret(P1ND *p, P1ND *q)
 483 {
 484         if (ANYCX(q)) { /* Return complex type */
 485                 p = mkcmplx(p, strmemb(q->n_td->ss)->stype);
 486         } else if (q->n_type < STRTY || ISITY(q->n_type)) { /* real or imag */
 487                 p = structref(p, DOT, ISITY(q->n_type) ? imag : real);
 488                 if (p->n_type != q->n_type)
 489                         p = cast(p, q->n_type, 0);
 490         } else
 491                 cerror("cxred failing type");
 492         return p;
 493 }
 494
 495 /*
 496  * either p1 or p2 is complex, so fixup the remaining type accordingly.
 497  */
 498 P1ND *
 499 cxcast(P1ND *p1, P1ND *p2)
 500 {
 501         if (ANYCX(p1) && ANYCX(p2)) {
 502                 if (p1->n_type != p2->n_type)
 503                         p2 = mkcmplx(p2, p1->n_type);
 504         } else if (ANYCX(p1)) {
 505                 p2 = mkcmplx(p2, strmemb(p1->n_td->ss)->stype);
 506         } else /* if (ANYCX(p2)) */ {
 507                 p2 = cast(structref(p2, DOT, real), p1->n_type, 0);
 508         }
 509         p1nfree(p1);
 510         return p2;
 511 }
 512
 513 void
 514 //cxargfixup(P1ND *a, TWORD dt, struct attr *ap)
 515 cxargfixup(P1ND *a, struct tdef *td)
 516 {
 517         P1ND *p;
 518         TWORD t;
 519
 520         p = p1alloc();
 521         *p = *a;
 522         if (td->type == STRTY) {
 523                 /* dest complex */
 524                 t = strmemb(td->ss)->stype;
 525                 p = mkcmplx(p, t);
 526         } else {
 527                 /* src complex, not dest */
 528                 p = structref(p, DOT, ISFTY(td->type) ? real : imag);
 529         }
 530         *a = *p;
 531         p1nfree(p);
 532 }
 533 #endif