Return to dblsub.c CVS log

Up to [gforth] / gforth

completed double-cell support for machines without a corresponding C int type

    1: /* some routines for double-cell arithmetic
    2:    only used if BUGGY_LONG_LONG
    3: 
    4:    Copyright (C) 1996 Free Software Foundation, Inc.
    5:  * Copyright (C) 1995  Dirk Uwe Zoller
    6:  *
    7:  * This library is free software; you can redistribute it and/or
    8:  * modify it under the terms of the GNU Library General Public
    9:  * License as published by the Free Software Foundation; either
   10:  * version 2 of the License, or (at your option) any later version.
   11:  *
   12:  * This library 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.
   15:  * See the GNU Library General Public License for more details.
   16:  *
   17:  * You should have received a copy of the GNU Library General Public
   18:  * License along with this library; if not, write to the Free
   19:  * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21:  This has been adapted from pfe-0.9.14
   22:  */
   23: 
   24: #include "config.h"
   25: #include "forth.h"
   26: 
   27: /* !! a bit machine dependent */
   28: #define HALFCELL_BITS	(CELL_BITS/2)
   29: #define UH(x)		(((UCell)(x))>>HALFCELL_BITS)
   30: #define LH(x)		((x)&((~(UCell)0)>>HALFCELL_BITS))
   31: #define L2U(x)		(((UCell)(x))<<HALFCELL_BITS)
   32: #define HIGHBIT(x)	(((UCell)(x))>>(CELL_BITS-1))
   33: #define UD2D(ud)	({UDCell _ud=(ud); (DCell){_ud.hi,_ud.lo};})
   34: #define D2UD(d)		({DCell _d=(d); (UDCell){_d.hi,_d.lo};})
   35: 
   36: DCell dnegate(DCell d1)
   37: {
   38:   DCell res;
   39: 
   40:   res.hi = ~d1.hi + (d1.lo==0);
   41:   res.lo = -d1.lo;
   42:   return res;
   43: }
   44: 
   45: UDCell ummul (UCell a, UCell b)	/* unsigned multiply, mixed precision */
   46: {
   47:   UDCell res;
   48:   UCell m,ul,lu,uu;
   49: 
   50:   res.lo = a*b;
   51: /*ll = LH(a)*LH(b); dead code */
   52:   ul = UH(a)*LH(b);
   53:   lu = LH(a)*UH(b);
   54:   uu = UH(a)*UH(b);
   55:   m = ul+lu;
   56:   res.hi = (uu
   57: 	    + L2U(m<ul) /* the carry of ul+lu */
   58: 	    + UH(m)
   59: 	    + (res.lo<L2U(m)) /* the carry of ll+L2U(m) */
   60: 	    );
   61:   return res;
   62: }
   63: 
   64: DCell mmul (Cell a, Cell b)		/* signed multiply, mixed precision */
   65: {
   66:   DCell res;
   67:   Cell sign = a^b;
   68: 
   69:   if (a < 0)
   70:     a = -a;
   71:   if (b < 0)
   72:     b = -b;
   73:   res = UD2D(ummul (a, b));
   74:   if (sign < 0)
   75:     return dnegate (res);
   76:   else
   77:     return res;
   78: }
   79: 
   80: UDCell umdiv (UDCell u, UCell v)
   81: /* Divide unsigned double by single precision using shifts and subtracts.
   82:    Return quotient in lo, remainder in hi. */
   83: {
   84:   int i = CELL_BITS, c = 0;
   85:   UCell q = 0, h = u.hi, l = u.lo;
   86:   UDCell res;
   87: 
   88:   for (;;)
   89:     {
   90:       if (c || h >= v)
   91: 	{
   92: 	  q++;
   93: 	  h -= v;
   94: 	}
   95:       if (--i < 0)
   96: 	break;
   97:       c = HIGHBIT (h);
   98:       h <<= 1;
   99:       h += HIGHBIT (l);
  100:       l <<= 1;
  101:       q <<= 1;
  102:     }
  103:   res.hi = h;
  104:   res.lo = q;
  105:   return res;
  106: }
  107: 
  108: DCell smdiv (DCell num, Cell denom)	/* symmetric divide procedure, mixed prec */
  109: {
  110:   DCell res;
  111:   Cell numsign=num.hi;
  112:   Cell denomsign=denom;
  113: 
  114:   if (numsign < 0)
  115:     num = dnegate (num);
  116:   if (denomsign < 0)
  117:     denom = -denom;
  118:   res = UD2D(umdiv (D2UD(num), denom));
  119:   if ((numsign^denomsign)<0)
  120:     res.lo = -res.lo;
  121:   if (numsign<0)
  122:     res.hi = -res.hi;
  123:   return res;
  124: }
  125: 
  126: DCell fmdiv (DCell num, Cell denom)	/* floored divide procedure, mixed prec */
  127: {
  128:   /* I have this technique from Andrew Haley */
  129:   DCell res;
  130:   Cell denomsign=denom;
  131: 
  132:   if (denom < 0) {
  133:     denom = -denom;
  134:     num = dnegate(num);
  135:   }
  136:   if (num.hi < 0)
  137:     num.hi += denom;
  138:   res = UD2D(umdiv(D2UD(num),denom));
  139:   if (denomsign<0)
  140:     res.hi = -res.hi;
  141:   return res;
  142: }