Diff for /gforth/prim between versions 1.203 and 1.207

version 1.203, 2006/10/30 16:20:41 version 1.207, 2007/03/02 22:06:55
Line 1 Line 1
 \ Gforth primitives  \ Gforth primitives
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 851  DCell d = (DCell)n1 * (DCell)n2; Line 851  DCell d = (DCell)n1 * (DCell)n2;
 #endif  #endif
 #ifdef ASM_SM_SLASH_REM  #ifdef ASM_SM_SLASH_REM
 ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, n4, n5);  ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, n4, n5);
 if (((DHI(d)^n3)<0) && n4!=0) {  if (FLOORED_DIV && ((DHI(d)^n3)<0) && n4!=0) {
   if (CHECK_DIVISION && n5 == CELL_MIN)    if (CHECK_DIVISION && n5 == CELL_MIN)
     throw(BALL_RESULTRANGE);      throw(BALL_RESULTRANGE);
   n5--;    n5--;
   n4+=n3;    n4+=n3;
 }  }
 #else  #else
 DCell r = fmdiv(d,n3);  DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3);
 n4=DHI(r);  n4=DHI(r);
 n5=DLO(r);  n5=DLO(r);
 #endif  #endif
Line 875  DCell d = (DCell)n1 * (DCell)n2; Line 875  DCell d = (DCell)n1 * (DCell)n2;
 #ifdef ASM_SM_SLASH_REM  #ifdef ASM_SM_SLASH_REM
 Cell remainder;  Cell remainder;
 ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, remainder, n4);  ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, remainder, n4);
 if (((DHI(d)^n3)<0) && remainder!=0) {  if (FLOORED_DIV && ((DHI(d)^n3)<0) && remainder!=0) {
   if (CHECK_DIVISION && n4 == CELL_MIN)    if (CHECK_DIVISION && n4 == CELL_MIN)
     throw(BALL_RESULTRANGE);      throw(BALL_RESULTRANGE);
   n4--;    n4--;
 }  }
 #else  #else
 DCell r = fmdiv(d,n3);  DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3);
 n4=DLO(r);  n4=DLO(r);
 #endif  #endif
 :  :
Line 1028  d2 = -d1; Line 1028  d2 = -d1;
   
 d2*     ( d1 -- d2 )            double          d_two_star  d2*     ( d1 -- d2 )            double          d_two_star
 ""Shift left by 1; also works on unsigned numbers""  ""Shift left by 1; also works on unsigned numbers""
 #ifdef BUGGY_LL_SHIFT  d2 = DLSHIFT(d1,1);
 DLO_IS(d2, DLO(d1)<<1);  
 DHI_IS(d2, (DHI(d1)<<1) | (DLO(d1)>>(CELL_BITS-1)));  
 #else  
 d2 = 2*d1;  
 #endif  
 :  :
  2dup d+ ;   2dup d+ ;
   
Line 2766  define(`uploop', Line 2761  define(`uploop',
 define(`_uploop',  define(`_uploop',
        `ifelse($1, `$3', `$5',         `ifelse($1, `$3', `$5',
                `$4`'define(`$1', incr($1))_uploop(`$1', `$2', `$3', `$4', `$5')')')                 `$4`'define(`$1', incr($1))_uploop(`$1', `$2', `$3', `$4', `$5')')')
   
 \ argflist(argnum): Forth argument list  \ argflist(argnum): Forth argument list
 define(argflist,  define(argflist,
        `ifelse($1, 0, `',         `ifelse($1, 0, `',
                `uploop(`_i', 1, $1, `format(`u%d ', _i)', `format(`u%d ', _i)')')')                 `uploop(`_i', 1, $1, ``u''`_i ', ``u''`_i')')')
 \ argdlist(argnum): declare C's arguments  \ argdlist(argnum): declare C's arguments
 define(argdlist,  define(argdlist,
        `ifelse($1, 0, `',         `ifelse($1, 0, `',
Line 2777  define(argdlist, Line 2773  define(argdlist,
 \ argclist(argnum): pass C's arguments  \ argclist(argnum): pass C's arguments
 define(argclist,  define(argclist,
        `ifelse($1, 0, `',         `ifelse($1, 0, `',
                `uploop(`_i', 1, $1, `format(`u%d, ', _i)', `format(`u%d', _i)')')')                 `uploop(`_i', 1, $1, ``u''`_i, ', ``u''`_i')')')
 \ icall(argnum)  \ icall(argnum)
 define(icall,  define(icall,
 `icall$1        ( argflist($1)u -- uret )       gforth  `icall$1        ( argflist($1) u -- uret )      gforth
 uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1));  uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1));
   
 ')  ')
 define(fcall,  define(fcall,
 `fcall$1        ( argflist($1)u -- rret )       gforth  `fcall$1        ( argflist($1) u -- rret )      gforth
 rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1));  rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1));
   
 ')  ')

Removed from v.1.203  
changed lines
  Added in v.1.207


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