[gforth] / gforth / Attic / prims2y.fs  

gforth: gforth/Attic/prims2y.fs

Diff for /gforth/Attic/prims2y.fs between version 1.7 and 1.8

version 1.7, Wed Oct 8 13:17:10 2003 UTC version 1.8, Wed Oct 8 17:51:56 2003 UTC
Line 201 
Line 201 
 end-struct ss% \ stack-state  end-struct ss% \ stack-state
   
 struct%  struct%
       cell%              field state-number
     cell% max-stacks * field state-sss      cell% max-stacks * field state-sss
 end-struct state%  end-struct state%
   
Line 209 
Line 210 
 256 constant max-registers  256 constant max-registers
 create registers max-registers cells allot \ array of registers  create registers max-registers cells allot \ array of registers
 variable nregisters 0 nregisters ! \ number of registers  variable nregisters 0 nregisters ! \ number of registers
   variable next-state-number 0 next-state-number ! \ next state number
   
 : stack-in-index ( in-size item -- in-index )  : stack-in-index ( in-size item -- in-index )
     item-offset @ - 1- ;      item-offset @ - 1- ;
Line 290 
Line 292 
  in-part off   in-part off
 0 value state-in  \ state on entering prim  0 value state-in  \ state on entering prim
 0 value state-out \ state on exiting prim  0 value state-out \ state on exiting prim
 0 value state-in-default  \ state on entering prim  0 value state-default  \ canonical state at bb boundaries
 0 value state-out-default \ 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 705 
Line 706 
   
 : state ( "name" -- )  : state ( "name" -- )
     \ create a state initialized with default-sss      \ create a state initialized with default-sss
     create state% %allot state-sss { sss }      create state% %allot { s }
       next-state-number @ s state-number ! 1 next-state-number +!
     max-stacks 0 ?do      max-stacks 0 ?do
         default-ss sss i th !          default-ss s state-sss i th !
     loop ;      loop ;
   
 : set-ss ( ss stack state -- )  : set-ss ( ss stack state -- )
Line 1328 
Line 1330 
     primitives search-wordlist 0= -13 and throw execute ;      primitives search-wordlist 0= -13 and throw execute ;
   
 : state-prim1 { in-state out-state prim -- }  : state-prim1 { in-state out-state prim -- }
     in-state out-state state-in-default state-out-default d= ?EXIT      in-state out-state state-default dup d= ?EXIT
     in-state  to state-in      in-state  to state-in
     out-state to state-out      out-state to state-out
     prim reprocess-simple ;      prim reprocess-simple ;
Line 1361 
Line 1363 
 : prim-states ( "name" -- )  : prim-states ( "name" -- )
     parse-word lookup-prim gen-prim-states ;      parse-word lookup-prim gen-prim-states ;
   
 : gen-branch-states ( out-state prim -- )  : gen-branch-states ( prim -- )
     \ generate versions that produce out-state; useful for branches      \ generate versions that produce state-default; useful for branches
     to prim { out-state }      to prim
     cache-states 2@ swap { states } ( nstates )      cache-states 2@ swap { states } ( nstates )
     cache-stack stack-in @ +do      cache-stack stack-in @ +do
         states i th @ out-state prim state-prim1          states i th @ state-default prim state-prim1
     loop ;      loop ;
   
 : branch-states ( out-state "name" -- )  : branch-states ( out-state "name" -- )
Line 1537 
Line 1539 
 : output-costs-prefix ( -- )  : output-costs-prefix ( -- )
     ." {" prim compute-costs      ." {" prim compute-costs
     rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , "      rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , "
     prim prim-branch? negate . ." ," ;      prim prim-branch? negate . ." ,"
       state-in  state-number @ 2 .r ." ,"
       state-out state-number @ 2 .r ." ," ;
   
 : output-costs-gforth-simple ( -- )  : output-costs-gforth-simple ( -- )
     output-costs-prefix      output-costs-prefix

Generate output suitable for use with a patch program
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help