### Diff for /gforth/prim between versions 1.1 and 1.5

version 1.1, 1997/05/21 20:39:36 version 1.5, 1997/07/06 14:37:00
Line 171  else Line 171  else
condbranch(?branch,f --         f83     question_branch,  condbranch(?branch,f --         f83     question_branch,
if (f==0) {  if (f==0) {
IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
,)  ,:
0= dup     \ !f !f
r> dup @   \ !f !f IP branchoffset
rot and +  \ !f IP|IP+branchoffset
swap 0= cell and + \ IP''
>r ;)

\ we don't need an lp_plus_store version of the ?dup-stuff, because it  \ we don't need an lp_plus_store version of the ?dup-stuff, because it
\ is only used in if's (yet)  \ is only used in if's (yet)
Line 404  else { Line 409  else {

\+[THEN]  \+[THEN]

\ don't make any assumptions where the return stack is!!
\ implement this in machine code if it should run quickly!

i       -- n            core  i       -- n            core
n = *rp;  n = *rp;
:  :
rp@ cell+ @ ;  \ rp@ cell+ @ ;
r> r> tuck >r >r ;

i'      -- w            gforth          i_tick  i'      -- w            gforth          i_tick
""loop end value""  ""loop end value""
w = rp[1];  w = rp[1];
:  :
rp@ cell+ cell+ @ ;  \ rp@ cell+ cell+ @ ;
r> r> r> dup itmp ! >r >r >r itmp @ ;
variable itmp

j       -- n            core  j       -- n            core
n = rp[2];  n = rp[2];
:  :
rp@ cell+ cell+ cell+ @ ;  \ rp@ cell+ cell+ cell+ @ ;
r> r> r> r> dup itmp ! >r >r >r >r itmp @ ;
[IFUNDEF] itmp variable itmp [THEN]

k       -- n            gforth  k       -- n            gforth
n = rp[4];  n = rp[4];
:  :
rp@ [ 5 cells ] Literal + @ ;  \ rp@ [ 5 cells ] Literal + @ ;
r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ;
[IFUNDEF] itmp variable itmp [THEN]

\ digit is high-level: 0/0%  \ digit is high-level: 0/0%

Line 508  else if (n>0) Line 523  else if (n>0)

u2 = u1;  u2 = u1;
while (c_addr[u2-1] == ' ')  while (u2>0 && c_addr[u2-1] == ' ')
u2--;    u2--;
:  :
BEGIN  1- 2dup + c@ bl =  WHILE   BEGIN  1- 2dup + c@ bl =  WHILE
Line 607  n2 = n1>>1; Line 622  n2 = n1>>1;
:  :
dup MINI and IF 1 ELSE 0 THEN   dup MINI and IF 1 ELSE 0 THEN
[ bits/byte cell * 1- ] literal    [ bits/byte cell * 1- ] literal
0 DO 2* swap dup 2* >r U-HIGHBIT and    0 DO 2* swap dup 2* >r MINI and
IF 1 ELSE 0 THEN or r> swap       IF 1 ELSE 0 THEN or r> swap
LOOP nip ;   LOOP nip ;

Line 694  u2 = ud%u1; Line 709  u2 = ud%u1;
#endif  #endif
:  :
0 swap [ 8 cells 1 + ] literal 0     0 swap [ 8 cells 1 + ] literal 0
?DO >r /modstep r>      ?DO /modstep
LOOP drop swap 1 rshift or swap ;     LOOP drop swap 1 rshift or swap ;
: /modstep ( ud c R: u -- ud-?u c R: u )  : /modstep ( ud c R: u -- ud-?u c R: u )
over I' u< 0= or IF I' - 1 ELSE 0 THEN  d2*+ ;     >r over r@ u< 0= or IF r@ - 1 ELSE 0 THEN  d2*+ r> ;
: d2*+ ( ud n -- ud+n c )  : d2*+ ( ud n -- ud+n c )
over MINI     over MINI
and >r >r 2dup d+ swap r> + swap r> ;     and >r >r 2dup d+ swap r> + swap r> ;
Line 1795  r2 = exp(r1); Line 1810  r2 = exp(r1);
fexpm1          r1 -- r2        float-ext  fexpm1          r1 -- r2        float-ext
""@i{r2}=@i{e}**@i{r1}@minus{}1""  ""@i{r2}=@i{e}**@i{r1}@minus{}1""
#ifdef HAVE_EXPM1  #ifdef HAVE_EXPM1
extern double expm1(double);  extern double
#ifdef NeXT
const
#endif
expm1(double);
r2 = expm1(r1);  r2 = expm1(r1);
#else  #else
r2 = exp(r1)-1.;  r2 = exp(r1)-1.;
Line 1807  r2 = log(r1); Line 1826  r2 = log(r1);
flnp1           r1 -- r2        float-ext  flnp1           r1 -- r2        float-ext
""@i{r2}=ln(@i{r1}+1)""  ""@i{r2}=ln(@i{r1}+1)""
#ifdef HAVE_LOG1P  #ifdef HAVE_LOG1P
extern double log1p(double);  extern double
#ifdef NeXT
const
#endif
log1p(double);
r2 = log1p(r1);  r2 = log1p(r1);
#else  #else
r2 = log(r1+1.);  r2 = log(r1+1.);

 Removed from v.1.1 changed lines Added in v.1.5

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