[gforth] / gforth / prim

# gforth: gforth/prim

### Diff for /gforth/prim between version 1.4 and 1.5

version 1.4, Mon Jun 23 15:53:53 1997 UTC version 1.5, Sun Jul 6 14:37:00 1997 UTC
 Line 171
 Line 171
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
 Line 409

\+[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 607
 Line 622
:  :
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
 Line 709
#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> ;

Generate output suitable for use with a patch program
Legend:
 Removed from v.1.4 changed lines Added in v.1.5