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

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

version 1.7, 2003/10/08 13:17:10 version 1.8, 2003/10/08 17:51:56
Line 201  struct% Line 201  struct%
 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  create stacks max-stacks cells allot \ a Line 210  create stacks max-stacks cells allot \ a
 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  variable in-part \ true if processing a Line 292  variable in-part \ true if processing a
  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  stack inst-stream IP Cell Line 706  stack inst-stream IP Cell
   
 : 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  variable reprocessed-num 0 reprocessed-n Line 1330  variable reprocessed-num 0 reprocessed-n
     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  variable reprocessed-num 0 reprocessed-n Line 1363  variable reprocessed-num 0 reprocessed-n
 : 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  variable offset-super2  0 offset-super2 Line 1539  variable offset-super2  0 offset-super2
 : 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
Removed from v.1.7  
changed lines
  Added in v.1.8

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