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

Diff for /gforth/prims2x.fs between versions 1.140 and 1.143

version 1.140, 2003/08/04 20:32:35 version 1.143, 2003/08/27 12:13:49
Line 876  variable tail-nextp2 \ xt to execute for Line 876  variable tail-nextp2 \ xt to execute for
     endif      endif
     ." }" cr ;      ." }" cr ;
   
   : prim-branch? { prim -- f }
       \ true if prim is a branch or super-end
       prim prim-c-code 2@  s" SET_IP" search nip nip 0<> ;
   
 : output-superend ( -- )  : output-superend ( -- )
     \ output flag specifying whether the current word ends a dynamic superinst      \ output flag specifying whether the current word ends a dynamic superinst
     prim prim-c-code 2@  s" SET_IP"    search nip nip      prim prim-branch?
     prim prim-c-code 2@  s" SUPER_END" search nip nip or 0<>      prim prim-c-code 2@  s" SUPER_END" search nip nip 0<> or
     prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and      prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and
     negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;      negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;
   
Line 953  variable tail-nextp2 \ xt to execute for Line 957  variable tail-nextp2 \ xt to execute for
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;      ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
   
 : output-c-prim-num ( -- )  : output-c-prim-num ( -- )
     ." #define N_" prim prim-c-name 2@ type prim prim-num @ 8 + 4 .r cr ;      ." N_" prim prim-c-name 2@ type ." ," cr ;
   
 : output-forth ( -- )    : output-forth ( -- )  
     prim prim-forth-code @ 0=      prim prim-forth-code @ 0=
Line 1173  variable tail-nextp2 \ xt to execute for Line 1177  variable tail-nextp2 \ xt to execute for
 : print-item { n stack -- }  : print-item { n stack -- }
     \ print nth stack item name      \ print nth stack item name
     stack stack-type @ type-c-name 2@ type space      stack stack-type @ type-c-name 2@ type space
     ." _" stack stack-pointer 2@ type n 0 .r ;      ." MAYBE_UNUSED _" stack stack-pointer 2@ type n 0 .r ;
   
 : print-declarations-combined ( -- )  : print-declarations-combined ( -- )
     max-stacks 0 ?do      max-stacks 0 ?do
Line 1309  variable tail-nextp2 \ xt to execute for Line 1313  variable tail-nextp2 \ xt to execute for
     loop ;      loop ;
   
 : output-num-part ( p -- )  : output-num-part ( p -- )
     prim-num @ 4 .r ." ," ;      ." N_" prim-c-name 2@ type ." ," ;
       \ prim-num @ 4 .r ." ," ;
   
 : output-name-comment ( -- )  : output-name-comment ( -- )
     ."  /* " prim prim-name 2@ type ."  */" ;      ."  /* " prim prim-name 2@ type ."  */" ;
   
 variable offset-super2  0 offset-super2 ! \ offset into the super2 table  variable offset-super2  0 offset-super2 ! \ offset into the super2 table
   
   : output-costs-prefix ( -- )
       ." {" prim compute-costs
       rot 2 .r ." ," swap 2 .r ." ," 2 .r ." , "
       prim prim-branch? negate . ." ," ;
   
   : output-costs-gforth-simple ( -- )
       output-costs-prefix
       prim output-num-part
       1 2 .r ." },"
       output-name-comment
       cr ;
   
   : output-costs-gforth-combined ( -- )
       output-costs-prefix
       ." N_START_SUPER+" offset-super2 @ 5 .r ." ,"
       super2-length dup 2 .r ." }," offset-super2 +!
       output-name-comment
       cr ;
   
 : output-costs ( -- )  : output-costs ( -- )
     \ description of superinstructions and simple instructions      \ description of superinstructions and simple instructions
     ." {" prim compute-costs      ." {" prim compute-costs
Removed from v.1.140  
changed lines
  Added in v.1.143

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