[BACK]Return to prim-new.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / arch / 4stack

Diff for /gforth/arch/4stack/prim-new.fs between versions 1.4 and 1.7

version 1.4, 2007/12/31 18:40:24 version 1.7, 2008/11/01 22:19:30
Line 1 Line 1
 \ 4stack primitives  \ 4stack primitives
   
 \ Copyright (C) 2000 Free Software Foundation, Inc.  \ Copyright (C) 2000,2007,2008 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 72  docon:  .endif ;; Line 72  docon:  .endif ;;
         nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;          nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code  end-code
   
 -3 Alias: :docon  -2 Doer: :docol
   -3 Doer: :docon
   -4 Doer: :dovar
   -8 Doer: :dodoes
   -9 Doer: :doesjump
   
 Code execute ( xt -- )  Code execute ( xt -- )
         nop      nop       nop      ip@       br .endif          nop      nop       nop      ip@       br .endif
Line 171  Code (emit) Line 175  Code (emit)
         nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;          nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code  end-code
   
 : (type)  
     bounds ?DO  I c@ (emit)  LOOP ;  
 \    BEGIN  dup  WHILE  
 \       >r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;  
   
 \ obligatory code address manipulations  
   
 : >code-address ( xt -- addr )  cell+ @ -8 and ;  
 : >does-code    ( xt -- addr )  
     cell+ @ -8 and \ dup 3 and 3 <> IF  drop 0  EXIT  THEN  
     8 + dup cell - @ 3 and 0<> and ;  
 : code-address! ( addr xt -- )  >r 3 or $808 @ r> 2! ;  
 : does-code!    ( a_addr xt -- )  >r 5 - $808 @ r> 2! ;  
 : does-handler! ( a_addr -- )  $818 2@ rot 2! ;  
   
 \ this was obligatory, now some things to speed it up  
   
 Code 2/  Code 2/
         asr      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;          asr      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code  end-code
Line 417  Code (find-samelen) Line 404  Code (find-samelen)
         nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;          nop      ip!       ip@      nop       set 2: R1   ld 1: R1 N+ ;;
 end-code  end-code
   
   \ obligatory code address manipulations
   
   : >code-address ( xt -- addr )  cell+ @ -8 and ;
   : >does-code    ( xt -- addr )
       cell+ @ -8 and \ dup 3 and 3 <> IF  drop 0  EXIT  THEN
       8 + dup cell - @ 3 and 0<> and ;
   : code-address! ( addr xt -- )  >r 3 or $808 @ r> 2! ;
   : does-code!    ( a_addr xt -- )  >r 5 - $808 @ r> 2! ;
   : does-handler! ( a_addr -- )  $818 2@ rot 2! ;
   
   \ this was obligatory, now some things to speed it up
   
   : (type)
       bounds ?DO  I c@ (emit)  LOOP ;
   \    BEGIN  dup  WHILE
   \       >r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;
   
 \ division a/b  \ division a/b
 \ x:=a, y:=b, r:=est; iterate(x:=x*r, y:=y*r, r:=2-y*r);  \ x:=a, y:=b, r:=est; iterate(x:=x*r, y:=y*r, r:=2-y*r);
 \ result: x=a/b; y=1; r=1  \ result: x=a/b; y=1; r=1
Removed from v.1.4  
changed lines
  Added in v.1.7

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