File:  [gforth] / gforth / engine / dblsub.c
Revision 1.11: download - view: text, annotated - select for diffs
Mon Dec 31 20:35:21 2007 UTC (13 years, 5 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year

    1: /* some routines for double-cell arithmetic
    2:    only used if BUGGY_LONG_LONG
    3: 
    4:    Copyright (C) 1996,2000,2003,2006,2007 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 Lesser General Public
    9:  * License as published by the Free Software Foundation; either
   10:  * version 3 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 Lesser General Public License for more details.
   16:  *
   17:  * You should have received a copy of the GNU Lesser 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: DCell dnegate(DCell d1)
   28: {
   29:   DCell res;
   30: 
   31:   res.hi = ~d1.hi + (d1.lo==0);
   32:   res.lo = -d1.lo;
   33:   return res;
   34: }
   35: 
   36: UDCell ummul (UCell a, UCell b)	/* unsigned multiply, mixed precision */
   37: {
   38:   UDCell res;
   39:   UCell m,ul,lu,uu;
   40: 
   41:   res.lo = a*b;
   42: /*ll = LH(a)*LH(b); dead code */
   43:   ul = UH(a)*LH(b);
   44:   lu = LH(a)*UH(b);
   45:   uu = UH(a)*UH(b);
   46:   m = ul+lu;
   47:   res.hi = (uu
   48: 	    + L2U(m<ul) /* the carry of ul+lu */
   49: 	    + UH(m)
   50: 	    + (res.lo<L2U(m)) /* the carry of ll+L2U(m) */
   51: 	    );
   52:   return res;
   53: }
   54: 
   55: DCell mmul (Cell a, Cell b)		/* signed multiply, mixed precision */
   56: {
   57:   DCell res;
   58: 
   59:   res = UD2D(ummul (a, b));
   60:   if (a < 0)
   61:     res.hi -= b;
   62:   if (b < 0)
   63:     res.hi -= a;
   64:   return res;
   65: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>