Diff for /gforth/prims2x.fs between versions 1.146 and 1.153

version 1.146, 2003/10/16 18:48:03 version 1.153, 2005/01/22 22:16:59
Line 1 Line 1
 \ converts primitives to, e.g., C code   \ converts primitives to, e.g., C code 
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 535  defer inst-stream-f ( -- stack ) Line 535  defer inst-stream-f ( -- stack )
 : store-single { item -- }  : store-single { item -- }
     item item-stack @ { stack }      item item-stack @ { stack }
     store-optimization @ in-part @ 0= and item same-as-in? and      store-optimization @ in-part @ 0= and item same-as-in? and
     item item-in-index  stack state-in  stack-reg 0= and \  in in memory?      item item-in-index  stack state-in  stack-reg       \  in reg/mem
     item item-out-index stack state-out stack-reg 0= and \ out in memory?      item item-out-index stack state-out stack-reg = and \ out reg/mem
     0= if      0= if
         item really-store-single cr          item really-store-single cr
     endif ;      endif ;
Line 716  stack inst-stream IP Cell Line 716  stack inst-stream IP Cell
         default-ss s state-sss i th !          default-ss s state-sss i th !
     loop ;      loop ;
   
   : .state ( state -- )
       0 >body - >name .name ;
   
 : set-ss ( ss stack state -- )  : set-ss ( ss stack state -- )
     state-sss swap stack-number @ th ! ;      state-sss swap stack-number @ th ! ;
   
Line 910  variable tail-nextp2 \ xt to execute for Line 913  variable tail-nextp2 \ xt to execute for
   
 : output-label2 ( -- )  : output-label2 ( -- )
     ." LABEL2(" prim prim-c-name 2@ type ." )" cr      ." LABEL2(" prim prim-c-name 2@ type ." )" cr
     ." NEXT_P2;" cr ;      ." NEXT_P1_5;" cr
       ." LABEL3(" prim prim-c-name 2@ type ." )" cr
       ." DO_GOTO;" cr ;
   
 : output-c-tail1 { xt -- }  : output-c-tail1 { xt -- }
     \ the final part of the generated C code, with xt printing LABEL2 or not.      \ the final part of the generated C code, with xt printing LABEL2 or not.
Line 961  variable tail-nextp2 \ xt to execute for Line 966  variable tail-nextp2 \ xt to execute for
     ." LABEL(" prim prim-c-name 2@ type ." )" ;      ." LABEL(" prim prim-c-name 2@ type ." )" ;
           
 : output-c ( -- )   : output-c ( -- ) 
     print-entry ."  /* " prim prim-name 2@ type ."  ( " prim prim-stack-string 2@ type ." ) */" cr      print-entry ."  /* " prim prim-name 2@ type
       ."  ( " prim prim-stack-string 2@ type ." ) "
       state-in .state ." -- " state-out .state ."  */" cr
     ." /* " prim prim-doc 2@ type ."  */" cr      ." /* " prim prim-doc 2@ type ."  */" cr
     ." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging      ." NAME(" quote prim prim-name 2@ type quote ." )" cr \ debugging
     ." {" cr      ." {" cr
Line 1110  variable tail-nextp2 \ xt to execute for Line 1117  variable tail-nextp2 \ xt to execute for
 : output-alias ( -- )   : output-alias ( -- ) 
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;      ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
   
 : output-c-prim-num ( -- )  defer output-c-prim-num ( -- )
   
   :noname ( -- )
     ." N_" prim prim-c-name 2@ type ." ," cr ;      ." N_" prim prim-c-name 2@ type ." ," cr ;
   is output-c-prim-num
   
 : output-forth ( -- )    : output-forth ( -- )  
     prim prim-forth-code @ 0=      prim prim-forth-code @ 0=
Line 1559  variable offset-super2  0 offset-super2 Line 1569  variable offset-super2  0 offset-super2
     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-in  state-number @ 2 .r ." ,"
     state-out state-number @ 2 .r ." ," ;      state-out state-number @ 2 .r ." ,"
       inst-stream stack-in @ 1 .r ." ,"
   ;
   
 : output-costs-gforth-simple ( -- )  : output-costs-gforth-simple ( -- )
     output-costs-prefix      output-costs-prefix
Line 1575  variable offset-super2  0 offset-super2 Line 1587  variable offset-super2  0 offset-super2
     output-name-comment      output-name-comment
     cr ;      cr ;
   
 : output-costs ( -- )  \  : output-costs ( -- )
     \ description of superinstructions and simple instructions  \      \ description of superinstructions and simple instructions
     ." {" prim compute-costs  \      ." {" prim compute-costs
     rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ,"  \      rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ,"
     offset-super2 @ 5 .r ." ,"  \      offset-super2 @ 5 .r ." ,"
     super2-length dup 2 .r ." }," offset-super2 +!  \      super2-length dup 2 .r ." ," offset-super2 +!
     output-name-comment  \      inst-stream stack-in @ 1 .r ." },"
     cr ;  \      output-name-comment
   \      cr ;
   
 : output-super2-simple ( -- )  : output-super2-simple ( -- )
     prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if      prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if

Removed from v.1.146  
changed lines
  Added in v.1.153


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