version 1.204, 2006/12/31 13:39:13
|
version 1.206, 2007/02/09 17:53:54
|
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)); |
|
|
') |
') |