gcc/config/vax/vax.c

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