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

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

version 1.2, 2003/09/21 18:54:38 version 1.3, 2003/09/29 20:51:16
Line 196  end-struct register% Line 196  end-struct register%
   
 struct%  struct%
     cell% 2* field ss-registers  \ addr u; ss-registers[0] is TOS      cell% 2* field ss-registers  \ addr u; ss-registers[0] is TOS
                                    \ 0 means: use memory
     cell%    field ss-offset     \ stack pointer offset: sp[-offset] is TOS      cell%    field ss-offset     \ stack pointer offset: sp[-offset] is TOS
 end-struct ss% \ stack-state  end-struct ss% \ stack-state
   
Line 287  end-struct prim% Line 288  end-struct prim%
 0 value combined \ in combined prims the combined prim  0 value combined \ in combined prims the combined prim
 variable in-part \ true if processing a part  variable in-part \ true if processing a part
  in-part off   in-part off
   0 value state-in  \ state on entering prim
   0 value state-out \ state on exiting prim
   
 : prim-context ( ... p xt -- ... )  : prim-context ( ... p xt -- ... )
     \ execute xt with prim set to p      \ execute xt with prim set to p
Line 369  defer inst-stream-f ( -- stack ) Line 372  defer inst-stream-f ( -- stack )
 \ stack access stuff  \ stack access stuff
   
 : normal-stack-access0 { n stack -- }  : normal-stack-access0 { n stack -- }
       \ 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 ." ]" ;
           
 : normal-stack-access1 { n stack -- }  : normal-stack-access1 { n stack state -- }
       state state-sss stack stack-number @ th @ { ss }
       ss ss-registers 2@ n u> if ( addr ) \ in ss-registers?
           n th @ dup if ( register ) \ and is ss-registers[n] a register?
               \ then use the register
               register-name 2@ type exit
           endif
       endif
       drop
     stack stack-pointer 2@ type      stack stack-pointer 2@ type
     n if      n ss ss-offset @ - stack normal-stack-access0 ;
         n stack normal-stack-access0  
     else  
         ." TOS"  
     endif ;  
   
 : normal-stack-access ( n stack -- )  : normal-stack-access ( n stack state -- )
     dup inst-stream-f = if      over inst-stream-f = if
         ." IMM_ARG(" normal-stack-access1 ." ," immarg ? ." )"          ." IMM_ARG(" normal-stack-access1 ." ," immarg ? ." )"
         1 immarg +!          1 immarg +!
     else      else
Line 409  defer inst-stream-f ( -- stack ) Line 417  defer inst-stream-f ( -- stack )
     stack stack-number @ part-num @ s-c-max-depth @      stack stack-number @ part-num @ s-c-max-depth @
 \    max-depth stack stack-number @ th @ ( ndepth nmaxdepth )  \    max-depth stack stack-number @ th @ ( ndepth nmaxdepth )
     over <= if ( ndepth ) \ load from memory      over <= if ( ndepth ) \ load from memory
         stack normal-stack-access          stack state-in normal-stack-access
     else      else
         drop n stack part-stack-access          drop n stack part-stack-access
     endif ;      endif ;
Line 423  defer inst-stream-f ( -- stack ) Line 431  defer inst-stream-f ( -- stack )
     stack stack-number @ part-num @ s-c-max-back-depth @      stack stack-number @ part-num @ s-c-max-back-depth @
     over <= if ( ndepth )      over <= if ( ndepth )
         stack combined ['] stack-diff prim-context -          stack combined ['] stack-diff prim-context -
         stack normal-stack-access          stack state-out normal-stack-access
     else      else
         drop n stack part-stack-access          drop n stack part-stack-access
     endif ;      endif ;
Line 433  defer inst-stream-f ( -- stack ) Line 441  defer inst-stream-f ( -- stack )
     in-part @ if      in-part @ if
         part-stack-read          part-stack-read
     else      else
         normal-stack-access          state-in normal-stack-access
     endif ;      endif ;
   
 : stack-write ( n stack -- )  : stack-write ( n stack -- )
Line 441  defer inst-stream-f ( -- stack ) Line 449  defer inst-stream-f ( -- stack )
     in-part @ if      in-part @ if
         part-stack-write          part-stack-write
     else      else
         normal-stack-access          state-out normal-stack-access
     endif ;      endif ;
   
 : item-in-index { item -- n }  : item-in-index { item -- n }
Removed from v.1.2  
changed lines
  Added in v.1.3

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