Return to dblsub.c CVS log

Up to [gforth] / gforth / engine

fixes to make the division checking work with dblsub.c

    1: /* some routines for double-cell arithmetic
    2:    only used if BUGGY_LONG_LONG
    3: 
    4:    Copyright (C) 1996,2000,2003 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., 59 Temple Place, Suite 330, Boston, MA 02111, 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: 
   68:   res = UD2D(ummul (a, b));
   69:   if (a < 0)
   70:     res.hi -= b;
   71:   if (b < 0)
   72:     res.hi -= a;
   73:   return res;
   74: }
   75: 
   76: UDCell umdiv (UDCell u, UCell v)
   77: /* Divide unsigned double by single precision using shifts and subtracts.
   78:    Return quotient in lo, remainder in hi. */
   79: {
   80:   int i = CELL_BITS, c = 0;
   81:   UCell q = 0, h = u.hi, l = u.lo;
   82:   UDCell res;
   83: 
   84:   if (v==0)
   85:     throw(BALL_DIVZERO);
   86:   if (h>=v)
   87:     throw(BALL_RESULTRANGE);
   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 (res.lo > (UCell)CELL_MIN)
  120:     throw(BALL_RESULTRANGE);
  121:   if ((numsign^denomsign)<0) {
  122:     res.lo = -res.lo;
  123:   } else {
  124:     if (res.lo == CELL_MIN)
  125:       throw(BALL_RESULTRANGE);
  126:   }
  127:   if (numsign<0)
  128:     res.hi = -res.hi;
  129:   return res;
  130: }
  131: 
  132: DCell fmdiv (DCell num, Cell denom)	/* floored divide procedure, mixed prec */
  133: {
  134:   /* I have this technique from Andrew Haley */
  135:   DCell res;
  136:   Cell denomsign=denom;
  137:   Cell numsign;
  138: 
  139:   if (denom < 0) {
  140:     denom = -denom;
  141:     num = dnegate(num);
  142:   }
  143:   numsign = num.hi;
  144:   if (numsign < 0)
  145:     num.hi += denom;
  146:   res = UD2D(umdiv(D2UD(num),denom));
  147:   if (numsign < 0) {
  148:     if (res.lo < (UCell)CELL_MIN)
  149:       throw(BALL_RESULTRANGE);
  150:   } else {
  151:     if (res.lo >= (UCell)CELL_MIN)
  152:       throw(BALL_RESULTRANGE);
  153:   }
  154:   if (denomsign<0)
  155:     res.hi = -res.hi;
  156:   return res;
  157: }