Diff for /gforth/prims2x.fs between versions 1.98 and 1.105

version 1.98, 2001/06/16 22:53:36 version 1.105, 2002/06/02 10:31:28
Line 423  wordlist constant prefixes Line 423  wordlist constant prefixes
     stack r@ type-stack !      stack r@ type-stack !
     rdrop ;      rdrop ;
   
 : type-prefix ( xt1 xt2 n stack "prefix" -- )  : type-prefix ( addr u xt1 xt2 n stack "prefix" -- )
     get-current >r prefixes set-current      get-current >r prefixes set-current
     create-type r> set-current      create-type r> set-current
 does> ( item -- )  does> ( item -- )
Line 647  stack inst-stream IP Cell Line 647  stack inst-stream IP Cell
     2drop type ;      2drop type ;
   
 : print-entry ( -- )  : print-entry ( -- )
     ." I_" 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 ." ) */" cr
Line 693  stack inst-stream IP Cell Line 693  stack inst-stream IP Cell
 : output-profile ( -- )  : output-profile ( -- )
     \ generate code for postprocessing the VM block profile stuff      \ generate code for postprocessing the VM block profile stuff
     ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr      ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
     ."   add_inst(b, " quote  prim prim-name 2@ type quote ." );" cr      ."   add_inst(b, " quote prim prim-name 2@ type quote ." );" cr
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr      ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
     prim prim-c-code 2@  s" SET_IP"    search nip nip      prim prim-c-code 2@  s" SET_IP"    search nip nip
     prim prim-c-code 2@  s" SUPER_END" search nip nip or if      prim prim-c-code 2@  s" SUPER_END" search nip nip or if
Line 703  stack inst-stream IP Cell Line 703  stack inst-stream IP Cell
     endif      endif
     ." }" cr ;      ." }" cr ;
   
   : output-profile-combined ( -- )
       \ generate code for postprocessing the VM block profile stuff
       ." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr
       num-combined @ 0 +do
           ."   add_inst(b, " quote
           combined-prims i th @ prim-name 2@ type
           quote ." );" cr
       loop
       ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
       combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SET_IP"    search nip nip
       combined-prims num-combined @ 1- th @ prim-c-code 2@  s" SUPER_END" search nip nip or if
           ."   return;" cr
       else
           ."   goto _endif_;" cr
       endif
       ." }" cr ;
   
   : output-superend ( -- )
       \ output flag specifying whether the current word ends a dynamic superinst
       prim prim-c-code 2@  s" SET_IP"    search nip nip
       prim prim-c-code 2@  s" SUPER_END" search nip nip or 0<>
       prim prim-c-code 2@  s" SUPER_CONTINUE" search nip nip 0= and
       negate 0 .r ." , /* " prim prim-name 2@ type ."  */" cr ;
   
 : gen-arg-parm { item -- }  : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if      item item-stack @ inst-stream = if
         ." , " item item-type @ type-c-name 2@ type space          ." , " item item-type @ type-c-name 2@ type space
Line 767  stack inst-stream IP Cell Line 791  stack inst-stream IP Cell
 \      cr ;  \      cr ;
   
 : output-label ( -- )    : output-label ( -- )  
     ." (Label)&&I_" prim prim-c-name 2@ type ." ," cr ;      ." INST_ADDR(" prim prim-c-name 2@ type ." )," cr ;
   
 : output-alias ( -- )   : output-alias ( -- ) 
     ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;      ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ;
Line 799  stack inst-stream IP Cell Line 823  stack inst-stream IP Cell
     name-line @ 0 .r      name-line @ 0 .r
     ." ,0" cr ;      ." ,0" cr ;
   
   : output-vi-tag ( -- )
       name-filename 2@ type #tab emit
       prim prim-name 2@ type #tab emit
       ." /^" prim prim-name 2@ type ."  *(/" cr ;
   
 [IFDEF] documentation  [IFDEF] documentation
 : register-doc ( -- )  : register-doc ( -- )
     prim prim-name 2@ documentation ['] create insert-wordlist      prim prim-name 2@ documentation ['] create insert-wordlist
Line 1216  Variable c-flag Line 1245  Variable c-flag
       line @ name-line ! filename 2@ name-filename 2!        line @ name-line ! filename 2@ name-filename 2!
       function-number @ prim prim-num !        function-number @ prim prim-num !
       start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }}  white ++        start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }}  white ++
      (( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ??
    (( simple-primitive || combined-primitive )) {{ 1 function-number +! }}     (( simple-primitive || combined-primitive )) {{ 1 function-number +! }}
 )) <- primitive ( -- )  )) <- primitive ( -- )
   

Removed from v.1.98  
changed lines
  Added in v.1.105


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