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

version 1.3, 1997/06/15 19:43:28 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> ;

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

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