[BACK]Return to prims2y.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/prims2y.fs between versions 1.3 and 1.4

version 1.3, 2003/09/29 20:51:16 version 1.4, 2003/10/01 09:15:45
Line 374  defer inst-stream-f ( -- stack ) Line 374  defer inst-stream-f ( -- stack )
 : normal-stack-access0 { n stack -- }  : normal-stack-access0 { n stack -- }
     \ n has the ss-offset already applied (see ...-access1)      \ n has the ss-offset already applied (see ...-access1)
     n stack stack-access-transform @ execute ." [" 0 .r ." ]" ;      n stack stack-access-transform @ execute ." [" 0 .r ." ]" ;
       
   : state-ss { stack state -- ss }
       state state-sss stack stack-number @ th @ ;
   
   : stack-reg { n stack state -- reg }
       \ n is the index (TOS=0); reg is 0 if the access is to memory
       stack state state-ss ss-registers 2@ n u> if ( addr ) \ in ss-registers?
           n th @
       else
           drop 0
       endif ;
   
 : normal-stack-access1 { n stack state -- }  : normal-stack-access1 { n stack state -- }
     state state-sss stack stack-number @ th @ { ss }      n stack state stack-reg ?dup-if
     ss ss-registers 2@ n u> if ( addr ) \ in ss-registers?          register-name 2@ type exit
         n th @ dup if ( register ) \ and is ss-registers[n] a register?  
             \ then use the register  
             register-name 2@ type exit  
         endif  
     endif      endif
     drop  
     stack stack-pointer 2@ type      stack stack-pointer 2@ type
     n ss ss-offset @ - stack normal-stack-access0 ;      n stack state state-ss ss-offset @ - stack normal-stack-access0 ;
   
 : normal-stack-access ( n stack state -- )  : normal-stack-access ( n stack state -- )
     over inst-stream-f = if      over inst-stream-f = if
Line 500  defer inst-stream-f ( -- stack ) Line 506  defer inst-stream-f ( -- stack )
  rdrop ;   rdrop ;
   
 : item-out-index ( item -- n )  : item-out-index ( item -- n )
     \ n is the index of item (in the in-effect)      \ n is the index of item (in the out-effect)
     >r r@ item-stack @ stack-out @ r> item-offset @ - 1- ;      >r r@ item-stack @ stack-out @ r> item-offset @ - 1- ;
   
 : really-store-single ( item -- )  : really-store-single ( item -- )
Line 512  defer inst-stream-f ( -- stack ) Line 518  defer inst-stream-f ( -- stack )
     r@ item-out-index r@ item-stack @ stack-write ." );"      r@ item-out-index r@ item-stack @ stack-write ." );"
     rdrop ;      rdrop ;
   
 : store-single ( item -- )  : store-single { item -- }
     >r      item item-stack @ { stack }
     store-optimization @ in-part @ 0= and r@ same-as-in? and if      store-optimization @ in-part @ 0= and item same-as-in? and
         r@ item-in-index 0= r@ item-out-index 0= xor if      item item-in-index  stack state-in  stack-reg 0= and \  in in memory?
             ." IF_" r@ item-stack @ stack-pointer 2@ type      item item-out-index stack state-out stack-reg 0= and \ out in memory?
             ." TOS(" r@ really-store-single ." );" cr      0= if
         endif          item really-store-single cr
     else      endif ;
         r@ really-store-single cr  
     endif  
     rdrop ;  
   
 : store-double ( item -- )  : store-double ( item -- )
 \ !! store optimization is not performed, because it is not yet needed  \ !! store optimization is not performed, because it is not yet needed
Removed from v.1.3  
changed lines
  Added in v.1.4

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