Annotation of gforth/dblsub.c, revision 1.1
1.1 ! anton 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>