[gforth] / gforth / prims2x.fs  

gforth: gforth/prims2x.fs

Diff for /gforth/prims2x.fs between version 1.67 and 1.68

version 1.67, Thu Jan 18 16:57:41 2001 UTC version 1.68, Thu Jan 18 19:43:02 2001 UTC
Line 167 
Line 167 
 2variable name-filename  2variable name-filename
 2variable last-name-filename  2variable last-name-filename
   
 variable primitive-number -10 primitive-number !  
 Variable function-number 0 function-number !  Variable function-number 0 function-number !
   
 \ for several reasons stack items of a word are stored in a wordlist  \ for several reasons stack items of a word are stored in a wordlist
Line 486 
Line 485 
  ." NAME(" quote forth-name 2@ type quote ." )" cr \ debugging   ." NAME(" quote forth-name 2@ type quote ." )" cr \ debugging
  ." {" cr   ." {" cr
  ." DEF_CA" cr   ." DEF_CA" cr
  declarations  
  compute-offsets \ for everything else  
  print-declarations   print-declarations
  ." NEXT_P0;" cr   ." NEXT_P0;" cr
  flush-tos   flush-tos
Line 518 
Line 515 
     \ generate code for disassembling VM instructions      \ generate code for disassembling VM instructions
     ." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr      ." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr
     ."   fputs(" quote forth-name 2@ type quote ." , vm_out);" cr      ."   fputs(" quote forth-name 2@ type quote ." , vm_out);" cr
     ." /* " declarations ." */" cr  
     compute-offsets  
     disasm-args      disasm-args
     ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr      ."   ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr
     ." } else "      ." } else " ;
     1 function-number +! ;  
   
 : gen-arg-parm { item -- }  : gen-arg-parm { item -- }
     item item-stack @ inst-stream = if      item item-stack @ inst-stream = if
Line 545 
Line 539 
   
 : output-gen ( -- )  : output-gen ( -- )
     \ generate C code for generating VM instructions      \ generate C code for generating VM instructions
     ." /* " declarations ." */" cr  
     compute-offsets  
     ." void gen_" c-name 2@ type ." (Inst **ctp" gen-args-parm ." )" cr      ." void gen_" c-name 2@ type ." (Inst **ctp" gen-args-parm ." )" cr
     ." {" cr      ." {" cr
     ."   gen_inst(ctp, vm_prim[" function-number @ 0 .r ." ]);" cr      ."   gen_inst(ctp, vm_prim[" function-number @ 0 .r ." ]);" cr
     gen-args-gen      gen-args-gen
     ." }" cr      ." }" cr ;
     1 function-number +! ;  
   
 : stack-used? { stack -- f }  : stack-used? { stack -- f }
     stack stack-in @ stack stack-out @ or 0<> ;      stack stack-in @ stack stack-out @ or 0<> ;
   
 : output-funclabel ( -- )  : output-funclabel ( -- )
   1 function-number +!  
   ." &I_" c-name 2@ type ." ," cr ;    ." &I_" c-name 2@ type ." ," cr ;
   
 : output-forthname ( -- )  : output-forthname ( -- )
   1 function-number +!  
   '" emit forth-name 2@ type '" emit ." ," cr ;    '" emit forth-name 2@ type '" emit ." ," cr ;
   
 : output-c-func ( -- )  : output-c-func ( -- )
 \ used for word libraries  \ used for word libraries
     1 function-number +!  
     ." Cell * I_" c-name 2@ type ." (Cell *SP, Cell **FP)      /* " forth-name 2@ type      ." Cell * I_" c-name 2@ type ." (Cell *SP, Cell **FP)      /* " forth-name 2@ type
     ."  ( " stack-string 2@ type ."  ) */" cr      ."  ( " stack-string 2@ type ."  ) */" cr
     ." /* " doc 2@ type ."  */" cr      ." /* " doc 2@ type ."  */" cr
     ." NAME(" quote forth-name 2@ type quote ." )" cr      ." NAME(" quote forth-name 2@ type quote ." )" cr
     \ debugging      \ debugging
     ." {" cr      ." {" cr
     declarations  
     compute-offsets \ for everything else  
     print-declarations      print-declarations
     inst-stream  stack-used? IF ." Cell *ip=IP;" cr THEN      inst-stream  stack-used? IF ." Cell *ip=IP;" cr THEN
     data-stack   stack-used? IF ." Cell *sp=SP;" cr THEN      data-stack   stack-used? IF ." Cell *sp=SP;" cr THEN
Line 596 
Line 582 
     cr ;      cr ;
   
 : output-label ( -- )  : output-label ( -- )
     ." (Label)&&I_" c-name 2@ type ." ," cr      ." (Label)&&I_" c-name 2@ type ." ," cr ;
     -1 primitive-number +! ;  
   
 : output-alias ( -- )  : output-alias ( -- )
     ( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr      ( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr ;
     -1 primitive-number +! ;  
   
 : output-forth ( -- )  : output-forth ( -- )
     forth-code @ 0=      forth-code @ 0=
Line 611 
Line 595 
     ELSE  ." : " forth-name 2@ type ."   ( "      ELSE  ." : " forth-name 2@ type ."   ( "
         stack-string 2@ type ." )" cr          stack-string 2@ type ." )" cr
         forth-code 2@ type cr          forth-code 2@ type cr
         -1 primitive-number +!  
     THEN ;      THEN ;
   
 : output-tag-file ( -- )  : output-tag-file ( -- )
Line 811 
Line 794 
    {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl white ** )) ** {{ end c-code 2! skipsynclines on }}     {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} (( nocolonnl nonl **  nl white ** )) ** {{ end c-code 2! skipsynclines on }}
    (( ` :  white ** nl     (( ` :  white ** nl
       {{ start }} (( nonl ++  nl white ** )) ++ {{ end forth-code 2! }}        {{ start }} (( nonl ++  nl white ** )) ++ {{ end forth-code 2! }}
    )) ?? {{ printprim }}     )) ?? {{  declarations compute-offsets printprim 1 function-number +! }}
    (( nl || eof ))     (( nl || eof ))
 )) <- primitive ( -- )  )) <- primitive ( -- )
   

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help