gcc/config/vax/vax.c

   1 /* Subroutines for insn-output.c for Vax.
   2    Copyright (C) 1987, 1994, 1995, 1997, 1998, 1999, 2000
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GNU CC.
   6
   7 GNU CC is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU CC is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU CC; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "rtl.h"
  25 #include "regs.h"
  26 #include "hard-reg-set.h"
  27 #include "real.h"
  28 #include "insn-config.h"
  29 #include "conditions.h"
  30 #include "insn-flags.h"
  31 #include "function.h"
  32 #include "output.h"
  33 #include "insn-attr.h"
  34 #ifdef VMS_TARGET
  35 #include "tree.h"
  36 #endif
  37 #include "tm_p.h"
  38
  39 /* This is like nonimmediate_operand with a restriction on the type of MEM.  */
  40
  41 void
  42 split_quadword_operands (operands, low, n)
  43      rtx *operands, *low;
  44      int n ATTRIBUTE_UNUSED;
  45 {
  46   int i;
  47   /* Split operands.  */
  48
  49   low[0] = low[1] = low[2] = 0;
  50   for (i = 0; i < 3; i++)
  51     {
  52       if (low[i])
  53         /* it's already been figured out */;
  54       else if (GET_CODE (operands[i]) == MEM
  55                && (GET_CODE (XEXP (operands[i], 0)) == POST_INC))
  56         {
  57           rtx addr = XEXP (operands[i], 0);
  58           operands[i] = low[i] = gen_rtx_MEM (SImode, addr);
  59           if (which_alternative == 0 && i == 0)
  60             {
  61               addr = XEXP (operands[i], 0);
  62               operands[i+1] = low[i+1] = gen_rtx_MEM (SImode, addr);
  63             }
  64         }
  65       else
  66         {
  67           low[i] = operand_subword (operands[i], 0, 0, DImode);
  68           operands[i] = operand_subword (operands[i], 1, 0, DImode);
  69         }
  70     }
  71 }
  72 \f
  73 void
  74 print_operand_address (file, addr)
  75      FILE *file;
  76      register rtx addr;
  77 {
  78   register rtx reg1, breg, ireg;
  79   rtx offset;
  80
  81  retry:
  82   switch (GET_CODE (addr))
  83     {
  84     case MEM:
  85       fprintf (file, "*");
  86       addr = XEXP (addr, 0);
  87       goto retry;
  88
  89     case REG:
  90       fprintf (file, "(%s)", reg_names[REGNO (addr)]);
  91       break;
  92
  93     case PRE_DEC:
  94       fprintf (file, "-(%s)", reg_names[REGNO (XEXP (addr, 0))]);
  95       break;
  96
  97     case POST_INC:
  98       fprintf (file, "(%s)+", reg_names[REGNO (XEXP (addr, 0))]);
  99       break;
 100
 101     case PLUS:
 102       /* There can be either two or three things added here.  One must be a
 103          REG.  One can be either a REG or a MULT of a REG and an appropriate
 104          constant, and the third can only be a constant or a MEM.
 105
 106          We get these two or three things and put the constant or MEM in
 107          OFFSET, the MULT or REG in IREG, and the REG in BREG.  If we have
 108          a register and can't tell yet if it is a base or index register,
 109          put it into REG1.  */
 110
 111       reg1 = 0; ireg = 0; breg = 0; offset = 0;
 112
 113       if (CONSTANT_ADDRESS_P (XEXP (addr, 0))
 114           || GET_CODE (XEXP (addr, 0)) == MEM)
 115         {
 116           offset = XEXP (addr, 0);
 117           addr = XEXP (addr, 1);
 118         }
 119       else if (CONSTANT_ADDRESS_P (XEXP (addr, 1))
 120                || GET_CODE (XEXP (addr, 1)) == MEM)
 121         {
 122           offset = XEXP (addr, 1);
 123           addr = XEXP (addr, 0);
 124         }
 125       else if (GET_CODE (XEXP (addr, 1)) == MULT)
 126         {
 127           ireg = XEXP (addr, 1);
 128           addr = XEXP (addr, 0);
 129         }
 130       else if (GET_CODE (XEXP (addr, 0)) == MULT)
 131         {
 132           ireg = XEXP (addr, 0);
 133           addr = XEXP (addr, 1);
 134         }
 135       else if (GET_CODE (XEXP (addr, 1)) == REG)
 136         {
 137           reg1 = XEXP (addr, 1);
 138           addr = XEXP (addr, 0);
 139         }
 140       else if (GET_CODE (XEXP (addr, 0)) == REG)
 141         {
 142           reg1 = XEXP (addr, 0);
 143           addr = XEXP (addr, 1);
 144         }
 145       else
 146         abort ();
 147
 148       if (GET_CODE (addr) == REG)
 149         {
 150           if (reg1)
 151             ireg = addr;
 152           else
 153             reg1 = addr;
 154         }
 155       else if (GET_CODE (addr) == MULT)
 156         ireg = addr;
 157       else if (GET_CODE (addr) == PLUS)
 158         {
 159           if (CONSTANT_ADDRESS_P (XEXP (addr, 0))
 160               || GET_CODE (XEXP (addr, 0)) == MEM)
 161             {
 162               if (offset)
 163                 {
 164                   if (GET_CODE (offset) == CONST_INT)
 165                     offset = plus_constant (XEXP (addr, 0), INTVAL (offset));
 166                   else if (GET_CODE (XEXP (addr, 0)) == CONST_INT)
 167                     offset = plus_constant (offset, INTVAL (XEXP (addr, 0)));
 168                   else
 169                     abort ();
 170                 }
 171               offset = XEXP (addr, 0);
 172             }
 173           else if (GET_CODE (XEXP (addr, 0)) == REG)
 174             {
 175               if (reg1)
 176                 ireg = reg1, breg = XEXP (addr, 0), reg1 = 0;
 177               else
 178                 reg1 = XEXP (addr, 0);
 179             }
 180           else if (GET_CODE (XEXP (addr, 0)) == MULT)
 181             {
 182               if (ireg)
 183                 abort ();
 184               ireg = XEXP (addr, 0);
 185             }
 186           else
 187             abort ();
 188
 189           if (CONSTANT_ADDRESS_P (XEXP (addr, 1))
 190               || GET_CODE (XEXP (addr, 1)) == MEM)
 191             {
 192               if (offset)
 193                 {
 194                   if (GET_CODE (offset) == CONST_INT)
 195                     offset = plus_constant (XEXP (addr, 1), INTVAL (offset));
 196                   else if (GET_CODE (XEXP (addr, 1)) == CONST_INT)
 197                     offset = plus_constant (offset, INTVAL (XEXP (addr, 1)));
 198                   else
 199                     abort ();
 200                 }
 201               offset = XEXP (addr, 1);
 202             }
 203           else if (GET_CODE (XEXP (addr, 1)) == REG)
 204             {
 205               if (reg1)
 206                 ireg = reg1, breg = XEXP (addr, 1), reg1 = 0;
 207               else
 208                 reg1 = XEXP (addr, 1);
 209             }
 210           else if (GET_CODE (XEXP (addr, 1)) == MULT)
 211             {
 212               if (ireg)
 213                 abort ();
 214               ireg = XEXP (addr, 1);
 215             }
 216           else
 217             abort ();
 218         }
 219       else
 220         abort ();
 221
 222       /* If REG1 is non-zero, figure out if it is a base or index register.  */
 223       if (reg1)
 224         {
 225           if (breg != 0 || (offset && GET_CODE (offset) == MEM))
 226             {
 227               if (ireg)
 228                 abort ();
 229               ireg = reg1;
 230             }
 231           else
 232             breg = reg1;
 233         }
 234
 235       if (offset != 0)
 236         output_address (offset);
 237
 238       if (breg != 0)
 239         fprintf (file, "(%s)", reg_names[REGNO (breg)]);
 240
 241       if (ireg != 0)
 242         {
 243           if (GET_CODE (ireg) == MULT)
 244             ireg = XEXP (ireg, 0);
 245           if (GET_CODE (ireg) != REG)
 246             abort ();
 247           fprintf (file, "[%s]", reg_names[REGNO (ireg)]);
 248         }
 249       break;
 250
 251     default:
 252       output_addr_const (file, addr);
 253     }
 254 }
 255 \f
 256 const char *
 257 rev_cond_name (op)
 258      rtx op;
 259 {
 260   switch (GET_CODE (op))
 261     {
 262     case EQ:
 263       return "neq";
 264     case NE:
 265       return "eql";
 266     case LT:
 267       return "geq";
 268     case LE:
 269       return "gtr";
 270     case GT:
 271       return "leq";
 272     case GE:
 273       return "lss";
 274     case LTU:
 275       return "gequ";
 276     case LEU:
 277       return "gtru";
 278     case GTU:
 279       return "lequ";
 280     case GEU:
 281       return "lssu";
 282
 283     default:
 284       abort ();
 285     }
 286 }
 287
 288 int
 289 vax_float_literal(c)
 290     register rtx c;
 291 {
 292   register enum machine_mode mode;
 293 #if HOST_FLOAT_FORMAT == VAX_FLOAT_FORMAT
 294   int i;
 295   union {double d; int i[2];} val;
 296 #endif
 297
 298   if (GET_CODE (c) != CONST_DOUBLE)
 299     return 0;
 300
 301   mode = GET_MODE (c);
 302
 303   if (c == const_tiny_rtx[(int) mode][0]
 304       || c == const_tiny_rtx[(int) mode][1]
 305       || c == const_tiny_rtx[(int) mode][2])
 306     return 1;
 307
 308 #if HOST_FLOAT_FORMAT == VAX_FLOAT_FORMAT
 309
 310   val.i[0] = CONST_DOUBLE_LOW (c);
 311   val.i[1] = CONST_DOUBLE_HIGH (c);
 312
 313   for (i = 0; i < 7; i ++)
 314     if (val.d == 1 << i || val.d == 1 / (1 << i))
 315       return 1;
 316 #endif
 317   return 0;
 318 }
 319
 320
 321 /* Return the cost in cycles of a memory address, relative to register
 322    indirect.
 323
 324    Each of the following adds the indicated number of cycles:
 325
 326    1 - symbolic address
 327    1 - pre-decrement
 328    1 - indexing and/or offset(register)
 329    2 - indirect */
 330
 331
 332 int
 333 vax_address_cost (addr)
 334     register rtx addr;
 335 {
 336   int reg = 0, indexed = 0, indir = 0, offset = 0, predec = 0;
 337   rtx plus_op0 = 0, plus_op1 = 0;
 338  restart:
 339   switch (GET_CODE (addr))
 340     {
 341     case PRE_DEC:
 342       predec = 1;
 343     case REG:
 344     case SUBREG:
 345     case POST_INC:
 346       reg = 1;
 347       break;
 348     case MULT:
 349       indexed = 1;      /* 2 on VAX 2 */
 350       break;
 351     case CONST_INT:
 352       /* byte offsets cost nothing (on a VAX 2, they cost 1 cycle) */
 353       if (offset == 0)
 354         offset = (unsigned)(INTVAL(addr)+128) > 256;
 355       break;
 356     case CONST:
 357     case SYMBOL_REF:
 358       offset = 1;       /* 2 on VAX 2 */
 359       break;
 360     case LABEL_REF:     /* this is probably a byte offset from the pc */
 361       if (offset == 0)
 362         offset = 1;
 363       break;
 364     case PLUS:
 365       if (plus_op0)
 366         plus_op1 = XEXP (addr, 0);
 367       else
 368         plus_op0 = XEXP (addr, 0);
 369       addr = XEXP (addr, 1);
 370       goto restart;
 371     case MEM:
 372       indir = 2;        /* 3 on VAX 2 */
 373       addr = XEXP (addr, 0);
 374       goto restart;
 375     default:
 376       break;
 377     }
 378
 379   /* Up to 3 things can be added in an address.  They are stored in
 380      plus_op0, plus_op1, and addr.  */
 381
 382   if (plus_op0)
 383     {
 384       addr = plus_op0;
 385       plus_op0 = 0;
 386       goto restart;
 387     }
 388   if (plus_op1)
 389     {
 390       addr = plus_op1;
 391       plus_op1 = 0;
 392       goto restart;
 393     }
 394   /* Indexing and register+offset can both be used (except on a VAX 2)
 395      without increasing execution time over either one alone. */
 396   if (reg && indexed && offset)
 397     return reg + indir + offset + predec;
 398   return reg + indexed + indir + offset + predec;
 399 }
 400
 401
 402 /* Cost of an expression on a VAX.  This version has costs tuned for the
 403    CVAX chip (found in the VAX 3 series) with comments for variations on
 404    other models.  */
 405
 406 int
 407 vax_rtx_cost (x)
 408     register rtx x;
 409 {
 410   register enum rtx_code code = GET_CODE (x);
 411   enum machine_mode mode = GET_MODE (x);
 412   register int c;
 413   int i = 0;                            /* may be modified in switch */
 414   const char *fmt = GET_RTX_FORMAT (code); /* may be modified in switch */
 415
 416   switch (code)
 417     {
 418     case POST_INC:
 419       return 2;
 420     case PRE_DEC:
 421       return 3;
 422     case MULT:
 423       switch (mode)
 424         {
 425         case DFmode:
 426           c = 16;               /* 4 on VAX 9000 */
 427           break;
 428         case SFmode:
 429           c = 9;                /* 4 on VAX 9000, 12 on VAX 2 */
 430           break;
 431         case DImode:
 432           c = 16;               /* 6 on VAX 9000, 28 on VAX 2 */
 433           break;
 434         case SImode:
 435         case HImode:
 436         case QImode:
 437           c = 10;               /* 3-4 on VAX 9000, 20-28 on VAX 2 */
 438           break;
 439         default:
 440           break;
 441         }
 442       break;
 443     case UDIV:
 444       c = 17;
 445       break;
 446     case DIV:
 447       if (mode == DImode)
 448         c = 30; /* highly variable */
 449       else if (mode == DFmode)
 450         /* divide takes 28 cycles if the result is not zero, 13 otherwise */
 451         c = 24;
 452       else
 453         c = 11;                 /* 25 on VAX 2 */
 454       break;
 455     case MOD:
 456       c = 23;
 457       break;
 458     case UMOD:
 459       c = 29;
 460       break;
 461     case FLOAT:
 462       c = 6 + (mode == DFmode) + (GET_MODE (XEXP (x, 0)) != SImode);
 463       /* 4 on VAX 9000 */
 464       break;
 465     case FIX:
 466       c = 7;                    /* 17 on VAX 2 */
 467       break;
 468     case ASHIFT:
 469     case LSHIFTRT:
 470     case ASHIFTRT:
 471       if (mode == DImode)
 472         c = 12;
 473       else
 474         c = 10;                 /* 6 on VAX 9000 */
 475       break;
 476     case ROTATE:
 477     case ROTATERT:
 478       c = 6;                    /* 5 on VAX 2, 4 on VAX 9000 */
 479       if (GET_CODE (XEXP (x, 1)) == CONST_INT)
 480         fmt = "e";      /* all constant rotate counts are short */
 481       break;
 482     case PLUS:
 483       /* Check for small negative integer operand: subl2 can be used with
 484          a short positive constant instead.  */
 485       if (GET_CODE (XEXP (x, 1)) == CONST_INT)
 486         if ((unsigned)(INTVAL (XEXP (x, 1)) + 63) < 127)
 487           fmt = "e";
 488     case MINUS:
 489       c = (mode == DFmode) ? 13 : 8;    /* 6/8 on VAX 9000, 16/15 on VAX 2 */
 490     case IOR:
 491     case XOR:
 492       c = 3;
 493       break;
 494     case AND:
 495       /* AND is special because the first operand is complemented. */
 496       c = 3;
 497       if (GET_CODE (XEXP (x, 0)) == CONST_INT)
 498         {
 499           if ((unsigned)~INTVAL (XEXP (x, 0)) > 63)
 500             c = 4;
 501           fmt = "e";
 502           i = 1;
 503         }
 504       break;
 505     case NEG:
 506       if (mode == DFmode)
 507         return 9;
 508       else if (mode == SFmode)
 509         return 6;
 510       else if (mode == DImode)
 511         return 4;
 512     case NOT:
 513       return 2;
 514     case ZERO_EXTRACT:
 515     case SIGN_EXTRACT:
 516       c = 15;
 517       break;
 518     case MEM:
 519       if (mode == DImode || mode == DFmode)
 520         c = 5;                          /* 7 on VAX 2 */
 521       else
 522         c = 3;                          /* 4 on VAX 2 */
 523       x = XEXP (x, 0);
 524       if (GET_CODE (x) == REG || GET_CODE (x) == POST_INC)
 525         return c;
 526       return c + vax_address_cost (x);
 527     default:
 528       c = 3;
 529       break;
 530     }
 531
 532
 533   /* Now look inside the expression.  Operands which are not registers or
 534      short constants add to the cost.
 535
 536      FMT and I may have been adjusted in the switch above for instructions
 537      which require special handling */
 538
 539   while (*fmt++ == 'e')
 540     {
 541       register rtx op = XEXP (x, i++);
 542       code = GET_CODE (op);
 543
 544       /* A NOT is likely to be found as the first operand of an AND
 545          (in which case the relevant cost is of the operand inside
 546          the not) and not likely to be found anywhere else.  */
 547       if (code == NOT)
 548         op = XEXP (op, 0), code = GET_CODE (op);
 549
 550       switch (code)
 551         {
 552         case CONST_INT:
 553           if ((unsigned)INTVAL (op) > 63 && GET_MODE (x) != QImode)
 554             c += 1;             /* 2 on VAX 2 */
 555           break;
 556         case CONST:
 557         case LABEL_REF:
 558         case SYMBOL_REF:
 559           c += 1;               /* 2 on VAX 2 */
 560           break;
 561         case CONST_DOUBLE:
 562           if (GET_MODE_CLASS (GET_MODE (op)) == MODE_FLOAT)
 563             {
 564               /* Registers are faster than floating point constants -- even
 565                  those constants which can be encoded in a single byte.  */
 566               if (vax_float_literal (op))
 567                 c++;
 568               else
 569                 c += (GET_MODE (x) == DFmode) ? 3 : 2;
 570             }
 571           else
 572             {
 573               if (CONST_DOUBLE_HIGH (op) != 0
 574                   || (unsigned)CONST_DOUBLE_LOW (op) > 63)
 575                 c += 2;
 576             }
 577           break;
 578         case MEM:
 579           c += 1;               /* 2 on VAX 2 */
 580           if (GET_CODE (XEXP (op, 0)) != REG)
 581             c += vax_address_cost (XEXP (op, 0));
 582           break;
 583         case REG:
 584         case SUBREG:
 585           break;
 586         default:
 587           c += 1;
 588           break;
 589         }
 590     }
 591   return c;
 592 }
 593
 594 /* Check a `double' value for validity for a particular machine mode.  */
 595
 596 static const char *const float_strings[] =
 597 {
 598    "1.70141173319264430e+38", /* 2^127 (2^24 - 1) / 2^24 */
 599   "-1.70141173319264430e+38",
 600    "2.93873587705571877e-39", /* 2^-128 */
 601   "-2.93873587705571877e-39"
 602 };
 603
 604 static REAL_VALUE_TYPE float_values[4];
 605
 606 static int inited_float_values = 0;
 607
 608
 609 int
 610 check_float_value (mode, d, overflow)
 611      enum machine_mode mode;
 612      REAL_VALUE_TYPE *d;
 613      int overflow;
 614 {
 615   if (inited_float_values == 0)
 616     {
 617       int i;
 618       for (i = 0; i < 4; i++)
 619         {
 620           float_values[i] = REAL_VALUE_ATOF (float_strings[i], DFmode);
 621         }
 622
 623       inited_float_values = 1;
 624     }
 625
 626   if (overflow)
 627     {
 628       memcpy (d, &float_values[0], sizeof (REAL_VALUE_TYPE));
 629       return 1;
 630     }
 631
 632   if ((mode) == SFmode)
 633     {
 634       REAL_VALUE_TYPE r;
 635       memcpy (&r, d, sizeof (REAL_VALUE_TYPE));
 636       if (REAL_VALUES_LESS (float_values[0], r))
 637         {
 638           memcpy (d, &float_values[0], sizeof (REAL_VALUE_TYPE));
 639           return 1;
 640         }
 641       else if (REAL_VALUES_LESS (r, float_values[1]))
 642         {
 643           memcpy (d, &float_values[1], sizeof (REAL_VALUE_TYPE));
 644           return 1;
 645         }
 646       else if (REAL_VALUES_LESS (dconst0, r)
 647                 && REAL_VALUES_LESS (r, float_values[2]))
 648         {
 649           memcpy (d, &dconst0, sizeof (REAL_VALUE_TYPE));
 650           return 1;
 651         }
 652       else if (REAL_VALUES_LESS (r, dconst0)
 653                 && REAL_VALUES_LESS (float_values[3], r))
 654         {
 655           memcpy (d, &dconst0, sizeof (REAL_VALUE_TYPE));
 656           return 1;
 657         }
 658     }
 659
 660   return 0;
 661 }
 662 \f
 663 #ifdef VMS_TARGET
 664 /* Additional support code for VMS target. */
 665
 666 /* Linked list of all externals that are to be emitted when optimizing
 667    for the global pointer if they haven't been declared by the end of
 668    the program with an appropriate .comm or initialization.  */
 669
 670 static
 671 struct extern_list {
 672   struct extern_list *next;     /* next external */
 673   const char *name;             /* name of the external */
 674   int size;                     /* external's actual size */
 675   int in_const;                 /* section type flag */
 676 } *extern_head = 0, *pending_head = 0;
 677
 678 /* Check whether NAME is already on the external definition list.  If not,
 679    add it to either that list or the pending definition list.  */
 680
 681 void
 682 vms_check_external (decl, name, pending)
 683      tree decl;
 684      const char *name;
 685      int pending;
 686 {
 687   register struct extern_list *p, *p0;
 688
 689   for (p = extern_head; p; p = p->next)
 690     if (!strcmp (p->name, name))
 691       return;
 692
 693   for (p = pending_head, p0 = 0; p; p0 = p, p = p->next)
 694     if (!strcmp (p->name, name))
 695       {
 696         if (pending)
 697           return;
 698
 699         /* Was pending, but has now been defined; move it to other list.  */
 700         if (p == pending_head)
 701           pending_head = p->next;
 702         else
 703           p0->next = p->next;
 704         p->next = extern_head;
 705         extern_head = p;
 706         return;
 707       }
 708
 709   /* Not previously seen; create a new list entry.  */
 710   p = (struct extern_list *)permalloc ((long) sizeof (struct extern_list));
 711   p->name = name;
 712
 713   if (pending)
 714     {
 715       /* Save the size and section type and link to `pending' list.  */
 716       p->size = (DECL_SIZE (decl) == 0) ? 0 :
 717         TREE_INT_CST_LOW (size_binop (CEIL_DIV_EXPR, DECL_SIZE (decl),
 718                                       size_int (BITS_PER_UNIT)));
 719       p->in_const = (TREE_READONLY (decl) && ! TREE_THIS_VOLATILE (decl));
 720
 721       p->next = pending_head;
 722       pending_head = p;
 723     }
 724   else
 725     {
 726       /* Size and section type don't matter; link to `declared' list.  */
 727       p->size = p->in_const = 0;        /* arbitrary init */
 728
 729       p->next = extern_head;
 730       extern_head = p;
 731     }
 732   return;
 733 }
 734
 735 void
 736 vms_flush_pending_externals (file)
 737      FILE *file;
 738 {
 739   register struct extern_list *p;
 740
 741   while (pending_head)
 742     {
 743       /* Move next pending declaration to the "done" list.  */
 744       p = pending_head;
 745       pending_head = p->next;
 746       p->next = extern_head;
 747       extern_head = p;
 748
 749       /* Now output the actual declaration.  */
 750       if (p->in_const)
 751         const_section ();
 752       else
 753         data_section ();
 754       fputs (".comm ", file);
 755       assemble_name (file, p->name);
 756       fprintf (file, ",%d\n", p->size);
 757     }
 758 }
 759 #endif /* VMS_TARGET */
 760 \f
 761 #ifdef VMS
 762 /* Additional support code for VMS host. */
 763
 764 #ifdef QSORT_WORKAROUND
 765   /*
 766         Do not use VAXCRTL's qsort() due to a severe bug:  once you've
 767         sorted something which has a size that's an exact multiple of 4
 768         and is longword aligned, you cannot safely sort anything which
 769         is either not a multiple of 4 in size or not longword aligned.
 770         A static "move-by-longword" optimization flag inside qsort() is
 771         never reset.  This is known of affect VMS V4.6 through VMS V5.5-1,
 772         and was finally fixed in VMS V5.5-2.
 773
 774         In this work-around an insertion sort is used for simplicity.
 775         The qsort code from glibc should probably be used instead.
 776    */
 777 void
 778 not_qsort (array, count, size, compare)
 779      void *array;
 780      unsigned count, size;
 781      int (*compare)();
 782 {
 783
 784   if (size == sizeof (short))
 785     {
 786       register int i;
 787       register short *next, *prev;
 788       short tmp, *base = array;
 789
 790       for (next = base, i = count - 1; i > 0; i--)
 791         {
 792           prev = next++;
 793           if ((*compare)(next, prev) < 0)
 794             {
 795               tmp = *next;
 796               do  *(prev + 1) = *prev;
 797                 while (--prev >= base ? (*compare)(&tmp, prev) < 0 : 0);
 798               *(prev + 1) = tmp;
 799             }
 800         }
 801     }
 802   else if (size == sizeof (long))
 803     {
 804       register int i;
 805       register long *next, *prev;
 806       long tmp, *base = array;
 807
 808       for (next = base, i = count - 1; i > 0; i--)
 809         {
 810           prev = next++;
 811           if ((*compare)(next, prev) < 0)
 812             {
 813               tmp = *next;
 814               do  *(prev + 1) = *prev;
 815                 while (--prev >= base ? (*compare)(&tmp, prev) < 0 : 0);
 816               *(prev + 1) = tmp;
 817             }
 818         }
 819     }
 820   else  /* arbitrary size */
 821     {
 822       register int i;
 823       register char *next, *prev, *tmp = alloca (size), *base = array;
 824
 825       for (next = base, i = count - 1; i > 0; i--)
 826         {   /* count-1 forward iterations */
 827           prev = next,  next += size;           /* increment front pointer */
 828           if ((*compare)(next, prev) < 0)
 829             {   /* found element out of order; move others up then re-insert */
 830               memcpy (tmp, next, size);         /* save smaller element */
 831               do { memcpy (prev + size, prev, size); /* move larger elem. up */
 832                    prev -= size;                /* decrement back pointer */
 833                  } while (prev >= base ? (*compare)(tmp, prev) < 0 : 0);
 834               memcpy (prev + size, tmp, size);  /* restore small element */
 835             }
 836         }
 837 #ifdef USE_C_ALLOCA
 838       alloca (0);
 839 #endif
 840     }
 841
 842   return;
 843 }
 844 #endif /* QSORT_WORKAROUND */
 845
 846 #endif /* VMS */