gcc/config/vax/vax.c

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